1 // SPDX-License-Identifier: LGPL-3.0-only (modified to allow linking)
2 unit BCComboBox;
3 
4 {$mode delphi}
5 
6 interface
7 
8 uses
9   Classes, SysUtils, LResources, Forms, Controls, ExtCtrls, Graphics, Dialogs, BCButton,
10   StdCtrls, BCTypes, BCBaseCtrls, BGRABitmap, BGRABitmapTypes, LMessages, LCLType;
11 
12 type
13 
14   { TBCComboBox }
15 
16   TBCComboBox = class(TBCStyleCustomControl)
17   private
18     FButton: TBCButton;
19     FCanvasScaleMode: TBCCanvasScaleMode;
20     FDropDownBorderSize: integer;
21     FDropDownCount: integer;
22     FDropDownColor: TColor;
23     FDropDownFontColor: TColor;
24     FDropDownFontHighlight: TColor;
25     FDropDownHighlight: TColor;
26     FFocusBorderColor: TColor;
27     FFocusBorderOpacity: byte;
28     FItems: TStringList;
29     FItemIndex: integer;
30     FForm: TForm;
31     FFormHideDate: TDateTime;
32     FHoverItem: integer;
33     FItemHeight: integer;
34     FListBox: TListBox;
35     FDropDownBorderColor: TColor;
36     FOnDrawItem: TDrawItemEvent;
37     FOnDrawSelectedItem: TOnAfterRenderBCButton;
38     FOnChange: TNotifyEvent;
39     FOnDropDown: TNotifyEvent;
40     FDrawingDropDown: boolean;
41     FTimerCheckFormHide: TTimer;
42     FQueryFormHide: boolean;
43     procedure ButtonClick(Sender: TObject);
44     procedure FormDeactivate(Sender: TObject);
45     procedure FormHide(Sender: TObject);
GetArrowFlipnull46     function GetArrowFlip: boolean;
GetComboCanvasnull47     function GetComboCanvas: TCanvas;
GetArrowSizenull48     function GetArrowSize: integer;
GetArrowWidthnull49     function GetArrowWidth: integer;
GetGlobalOpacitynull50     function GetGlobalOpacity: byte;
GetItemTextnull51     function GetItemText: string;
GetDropDownColornull52     function GetDropDownColor: TColor;
GetItemIndexnull53     function GetItemIndex: integer;
GetItemsnull54     function GetItems: TStrings;
GetMemoryUsagenull55     function GetMemoryUsage: TBCButtonMemoryUsage;
GetOnDrawSelectedItemnull56     function GetOnDrawSelectedItem: TOnAfterRenderBCButton;
GetRoundingnull57     function GetRounding: TBCRounding;
GetStateClickednull58     function GetStateClicked: TBCButtonState;
GetStateHovernull59     function GetStateHover: TBCButtonState;
GetStateNormalnull60     function GetStateNormal: TBCButtonState;
GetStaticButtonnull61     function GetStaticButton: boolean;
62     procedure ListBoxKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState
63       );
64     procedure ListBoxMouseUp({%H-}Sender: TObject; {%H-}Button: TMouseButton;
65                           {%H-}Shift: TShiftState; {%H-}X, {%H-}Y: Integer);
66     procedure ListBoxMouseLeave(Sender: TObject);
67     procedure ListBoxMouseMove(Sender: TObject; {%H-}Shift: TShiftState; X,
68       Y: Integer);
69     procedure ListBoxSelectionChange(Sender: TObject; {%H-}User: boolean);
70     procedure ListBoxDrawItem(Control: TWinControl; Index: Integer;
71       ARect: TRect; State: TOwnerDrawState);
72     procedure OnAfterRenderButton(Sender: TObject; const ABGRA: TBGRABitmap;
73       AState: TBCButtonState; ARect: TRect);
74     procedure OnTimerCheckFormHide(Sender: TObject);
75     procedure SetArrowFlip(AValue: boolean);
76     procedure SetArrowSize(AValue: integer);
77     procedure SetArrowWidth(AValue: integer);
78     procedure SetCanvasScaleMode(AValue: TBCCanvasScaleMode);
79     procedure SetDropDownColor(AValue: TColor);
80     procedure SetGlobalOpacity(AValue: byte);
81     procedure SetItemIndex(AValue: integer);
82     procedure SetItems(AValue: TStrings);
83     procedure SetMemoryUsage(AValue: TBCButtonMemoryUsage);
84     procedure SetOnDrawSelectedItem(AValue: TOnAfterRenderBCButton);
85     procedure SetRounding(AValue: TBCRounding);
86     procedure SetStateClicked(AValue: TBCButtonState);
87     procedure SetStateHover(AValue: TBCButtonState);
88     procedure SetStateNormal(AValue: TBCButtonState);
89     procedure SetStaticButton(AValue: boolean);
90   protected
GetStyleExtensionnull91     function GetStyleExtension: String; override;
92     procedure WMSetFocus(var Message: {$IFDEF FPC}TLMSetFocus{$ELSE}TWMSetFocus{$ENDIF}); message {$IFDEF FPC}LM_SETFOCUS{$ELSE}WM_SETFOCUS{$ENDIF};
93     procedure WMKillFocus(var Message: {$IFDEF FPC}TLMKillFocus{$ELSE}TWMKillFocus{$ENDIF}); message {$IFDEF FPC}LM_KILLFOCUS{$ELSE}WM_KILLFOCUS{$ENDIF};
94     procedure UpdateFocus(AFocused: boolean);
95     procedure KeyDown(var Key: Word; Shift: TShiftState); override;
96     procedure UTF8KeyPress(var UTF8Key: TUTF8Char); override;
97     procedure CreateForm;
98     procedure FreeForm;
GetListBoxnull99     function GetListBox: TListBox;
100     procedure UpdateButtonCanvasScaleMode;
101   public
102     constructor Create(AOwner: TComponent); override;
103     destructor Destroy; override;
104     { Assign the properties from Source to this instance }
105     procedure Assign(Source: TPersistent); override;
106     procedure Clear;
107     property HoverItem: integer read FHoverItem;
108     property Button: TBCButton read FButton write FButton;
109     property ListBox: TListBox read GetListBox;
110     property Text: string read GetItemText;
111   published
112     property Anchors;
113     property Canvas: TCanvas read GetComboCanvas;
114     property CanvasScaleMode: TBCCanvasScaleMode read FCanvasScaleMode write SetCanvasScaleMode default csmAuto;
115     property Items: TStrings read GetItems write SetItems;
116     property ItemIndex: integer read GetItemIndex write SetItemIndex;
117     property ItemHeight: integer read FItemHeight write FItemHeight default 0;
118     property ArrowSize: integer read GetArrowSize write SetArrowSize;
119     property ArrowWidth: integer read GetArrowWidth write SetArrowWidth;
120     property ArrowFlip: boolean read GetArrowFlip write SetArrowFlip default false;
121     property FocusBorderColor: TColor read FFocusBorderColor write FFocusBorderColor default clBlack;
122     property FocusBorderOpacity: byte read FFocusBorderOpacity write FFocusBorderOpacity default 255;
123     property DropDownBorderColor: TColor read FDropDownBorderColor write FDropDownBorderColor default clWindowText;
124     property DropDownBorderSize: integer read FDropDownBorderSize write FDropDownBorderSize default 1;
125     property DropDownColor: TColor read GetDropDownColor write SetDropDownColor default clWindow;
126     property DropDownFontColor: TColor read FDropDownFontColor write FDropDownFontColor default clWindowText;
127     property DropDownCount: integer read FDropDownCount write FDropDownCount default 8;
128     property DropDownHighlight: TColor read FDropDownHighlight write FDropDownHighlight default clHighlight;
129     property DropDownFontHighlight: TColor read FDropDownFontHighlight write FDropDownFontHighlight default clHighlightText;
130     property GlobalOpacity: byte read GetGlobalOpacity write SetGlobalOpacity;
131     property MemoryUsage: TBCButtonMemoryUsage read GetMemoryUsage write SetMemoryUsage;
132     property Rounding: TBCRounding read GetRounding write SetRounding;
133     property StateClicked: TBCButtonState read GetStateClicked write SetStateClicked;
134     property StateHover: TBCButtonState read GetStateHover write SetStateHover;
135     property StateNormal: TBCButtonState read GetStateNormal write SetStateNormal;
136     property StaticButton: boolean read GetStaticButton write SetStaticButton;
137     property OnDropDown: TNotifyEvent read FOnDropDown write FOnDropDown;
138     property OnDrawItem: TDrawItemEvent read FOnDrawItem write FOnDrawItem;
139     property OnDrawSelectedItem: TOnAfterRenderBCButton read GetOnDrawSelectedItem write SetOnDrawSelectedItem;
140     property OnChange: TNotifyEvent read FOnChange write FOnChange;
141     property TabStop;
142     property TabOrder;
143   end;
144 
145 procedure Register;
146 
147 implementation
148 
149 uses math, PropEdits, BGRAText;
150 
151 procedure Register;
152 begin
153   RegisterComponents('BGRA Controls', [TBCComboBox]);
154 end;
155 
156 { TBCComboBox }
157 
158 procedure TBCComboBox.ButtonClick(Sender: TObject);
159 const MinDelayReopen = 500/(1000*60*60*24);
160 var
161   p: TPoint;
162   h: Integer;
163   s: TSize;
164 begin
165   {$IFDEF DARWIN}
166   if Assigned(FForm) and not FForm.Visible then FreeForm;
167   {$ENDIF}
168 
169   CreateForm;
170 
171   if FForm.Visible then
172     FForm.Visible := false
173   else
174   if Now > FFormHideDate+MinDelayReopen then
175   begin
176     p := ControlToScreen(Point(FButton.Left, FButton.Top + FButton.Height));
177     FForm.Left := p.X;
178     FForm.Top := p.Y;
179     FForm.Color := FDropDownBorderColor;
180     FListBox.Font.Name := Button.StateNormal.FontEx.Name;
181     FListBox.Font.Style := Button.StateNormal.FontEx.Style;
182     FListBox.Font.Height := FontEmHeightSign*Button.StateNormal.FontEx.Height;
183     self.Canvas.Font.Assign(FListBox.Font);
184     if Assigned(FOnDrawItem) and (FItemHeight <> 0) then
185       h := FItemHeight else h := self.Canvas.GetTextHeight('Hg');
186     {$IFDEF WINDOWS}inc(h,6);{$ENDIF}
187     FListBox.ItemHeight := h;
188     {$IFDEF LINUX}inc(h,6);{$ENDIF}
189     {$IFDEF DARWIN}inc(h,2);{$ENDIF}
190     s := TSize.Create(FButton.Width, h*min(Items.Count, FDropDownCount) + 2*FDropDownBorderSize);
191     FForm.ClientWidth := s.cx;
192     FForm.ClientHeight := s.cy;
193     FListBox.SetBounds(FDropDownBorderSize,FDropDownBorderSize,
194       s.cx - 2*FDropDownBorderSize,
195       s.cy - 2*FDropDownBorderSize);
196     if FForm.Top + FForm.Height > Screen.WorkAreaTop + Screen.WorkAreaHeight then
197       FForm.Top := FForm.Top - FForm.Height - Self.Height;
198     if Assigned(FOnDropDown) then FOnDropDown(self);
199     FForm.Visible := True;
200     if FListBox.CanSetFocus then
201       FListBox.SetFocus;
202     FTimerCheckFormHide.Enabled:= true;
203     FQueryFormHide := false;
204   end;
205 end;
206 
207 procedure TBCComboBox.FormDeactivate(Sender: TObject);
208 begin
209   FQueryFormHide := true;
210 end;
211 
212 procedure TBCComboBox.FormHide(Sender: TObject);
213 begin
214   FFormHideDate := Now;
215 end;
216 
GetArrowFlipnull217 function TBCComboBox.GetArrowFlip: boolean;
218 begin
219   result := Button.FlipArrow;
220 end;
221 
TBCComboBox.GetComboCanvasnull222 function TBCComboBox.GetComboCanvas: TCanvas;
223 begin
224   if FDrawingDropDown then
225     result := ListBox.Canvas
226   else
227     result := inherited Canvas;
228 end;
229 
GetArrowSizenull230 function TBCComboBox.GetArrowSize: integer;
231 begin
232   result := Button.DropDownArrowSize;
233 end;
234 
GetArrowWidthnull235 function TBCComboBox.GetArrowWidth: integer;
236 begin
237   result := Button.DropDownWidth;
238 end;
239 
GetGlobalOpacitynull240 function TBCComboBox.GetGlobalOpacity: byte;
241 begin
242   result := Button.GlobalOpacity;
243 end;
244 
GetItemTextnull245 function TBCComboBox.GetItemText: string;
246 begin
247   if ItemIndex<>-1 then
248     result := Items[ItemIndex]
249   else
250     result := '';
251 end;
252 
TBCComboBox.GetDropDownColornull253 function TBCComboBox.GetDropDownColor: TColor;
254 begin
255   if Assigned(FListBox) then
256     result := FListBox.Color
257     else result := FDropDownColor;
258 end;
259 
GetItemIndexnull260 function TBCComboBox.GetItemIndex: integer;
261 begin
262   if Assigned(FListBox) then
263     result := FListBox.ItemIndex
264     else
265     begin
266       if FItemIndex >= Items.Count then
267         FItemIndex := -1;
268       result := FItemIndex;
269     end;
270 end;
271 
TBCComboBox.GetItemsnull272 function TBCComboBox.GetItems: TStrings;
273 begin
274   if Assigned(FListBox) then
275     Result := FListBox.Items
276     else Result := FItems;
277 end;
278 
GetMemoryUsagenull279 function TBCComboBox.GetMemoryUsage: TBCButtonMemoryUsage;
280 begin
281   result := Button.MemoryUsage;
282 end;
283 
GetOnDrawSelectedItemnull284 function TBCComboBox.GetOnDrawSelectedItem: TOnAfterRenderBCButton;
285 begin
286   result := FOnDrawSelectedItem;
287 end;
288 
TBCComboBox.GetRoundingnull289 function TBCComboBox.GetRounding: TBCRounding;
290 begin
291   result := Button.Rounding;
292 end;
293 
TBCComboBox.GetStateClickednull294 function TBCComboBox.GetStateClicked: TBCButtonState;
295 begin
296   result := Button.StateClicked;
297 end;
298 
TBCComboBox.GetStateHovernull299 function TBCComboBox.GetStateHover: TBCButtonState;
300 begin
301   result := Button.StateHover;
302 end;
303 
GetStateNormalnull304 function TBCComboBox.GetStateNormal: TBCButtonState;
305 begin
306   result := Button.StateNormal;
307 end;
308 
GetStaticButtonnull309 function TBCComboBox.GetStaticButton: boolean;
310 begin
311   result := Button.StaticButton;
312 end;
313 
314 procedure TBCComboBox.ListBoxKeyDown(Sender: TObject; var Key: Word;
315   Shift: TShiftState);
316 begin
317   if (Key = VK_RETURN) or (Key = VK_ESCAPE) then
318   begin
319     ButtonClick(nil);
320     Key := 0;
321   end;
322 end;
323 
324 procedure TBCComboBox.ListBoxMouseUp(Sender: TObject; Button: TMouseButton;
325                           Shift: TShiftState; X, Y: Integer);
326 begin
327   FQueryFormHide := true;
328 end;
329 
330 procedure TBCComboBox.ListBoxMouseLeave(Sender: TObject);
331 begin
332   FHoverItem := -1;
333   FListBox.Repaint;
334 end;
335 
336 procedure TBCComboBox.ListBoxMouseMove(Sender: TObject; Shift: TShiftState; X,
337   Y: Integer);
338 var
339   TempItem: integer;
340 begin
341   TempItem := FListBox.ItemAtPos(Point(x, y), True);
342 
343   if TempItem <> FHoverItem then
344   begin
345     FHoverItem := TempItem;
346     if (FHoverItem<>-1) and ([ssLeft,ssRight]*Shift <> []) then
347       FListBox.ItemIndex := FHoverItem;
348     FListBox.Repaint;
349   end;
350 end;
351 
352 procedure TBCComboBox.ListBoxSelectionChange(Sender: TObject; User: boolean);
353 begin
354   Button.Caption := GetItemText;
355   if User and Assigned(FOnChange) then FOnChange(self);
356 end;
357 
358 procedure TBCComboBox.ListBoxDrawItem(Control: TWinControl; Index: Integer;
359   ARect: TRect; State: TOwnerDrawState);
360 var
361   aCanvas: TCanvas;
362 begin
363   if Assigned(FOnDrawItem) then
364   begin
365     FDrawingDropDown := true;
366     Exclude(State, odSelected);
367     if Index = HoverItem then Include(State, odSelected);
368     if Index = ItemIndex then Include(State, odChecked);
369     try
370       FOnDrawItem(Control, Index, ARect, State);
371     finally
372       FDrawingDropDown := false;
373     end;
374     exit;
375   end;
376 
377   aCanvas := TListBox(Control).Canvas;
378   if Index = HoverItem then
379   begin
380     aCanvas.Brush.Color := DropDownHighlight;
381     aCanvas.Font.Color := DropDownFontHighlight;
382   end
383   else
384   begin
385     aCanvas.Brush.Color := DropDownColor;
386     aCanvas.Font.Color := DropDownFontColor;
387   end;
388   aCanvas.Pen.Style := psClear;
389   aCanvas.FillRect(ARect);
390   aCanvas.TextRect(ARect, ARect.Left+4, ARect.Top +
391     (ARect.Height - aCanvas.GetTextHeight(Items[Index])) div 2,
392     Items[Index]);
393 end;
394 
395 procedure TBCComboBox.OnAfterRenderButton(Sender: TObject;
396   const ABGRA: TBGRABitmap; AState: TBCButtonState; ARect: TRect);
397 var
398   focusMargin: integer;
399 begin
400   if Assigned(FOnDrawSelectedItem) then
401     FOnDrawSelectedItem(self, ABGRA, AState, ARect);
402   if Focused then
403   begin
404     focusMargin := round(2 * Button.CanvasScale);
405     ABGRA.RectangleAntialias(ARect.Left + focusMargin, ARect.Top + focusMargin,
406       ARect.Right - focusMargin - 1, ARect.Bottom - focusMargin - 1,
407       ColorToBGRA(FocusBorderColor, FocusBorderOpacity),
408       Button.CanvasScale);
409   end;
410 end;
411 
412 procedure TBCComboBox.OnTimerCheckFormHide(Sender: TObject);
413 begin
414   if Assigned(FForm) and FForm.Visible and
415     ({$IFDEF DARWIN}not FForm.Active or {$ENDIF}FQueryFormHide) then
416   begin
417     FForm.Visible := false;
418     FQueryFormHide := false;
419     FTimerCheckFormHide.Enabled := false;
420   end;
421 end;
422 
423 procedure TBCComboBox.SetArrowFlip(AValue: boolean);
424 begin
425   Button.FlipArrow:= AValue;
426 end;
427 
428 procedure TBCComboBox.SetArrowSize(AValue: integer);
429 begin
430   Button.DropDownArrowSize:= AValue;
431 end;
432 
433 procedure TBCComboBox.SetArrowWidth(AValue: integer);
434 begin
435   Button.DropDownWidth:= AValue;
436 end;
437 
438 procedure TBCComboBox.SetCanvasScaleMode(AValue: TBCCanvasScaleMode);
439 begin
440   if FCanvasScaleMode=AValue then Exit;
441   FCanvasScaleMode:=AValue;
442   UpdateButtonCanvasScaleMode;
443 end;
444 
445 procedure TBCComboBox.SetDropDownColor(AValue: TColor);
446 begin
447   if Assigned(FListBox) then
448     FListBox.Color := AValue
449     else FDropDownColor:= AValue;
450 end;
451 
452 procedure TBCComboBox.SetGlobalOpacity(AValue: byte);
453 begin
454   Button.GlobalOpacity := AValue;
455 end;
456 
457 procedure TBCComboBox.SetItemIndex(AValue: integer);
458 begin
459   if Assigned(FListBox) then
460     FListBox.ItemIndex := AValue
461     else
462     begin
463       if AValue <> FItemIndex then
464       begin
465         FItemIndex := AValue;
466         Button.Caption := GetItemText;
467       end;
468     end;
469 end;
470 
471 procedure TBCComboBox.SetItems(AValue: TStrings);
472 begin
473   if Assigned(FListBox) then
474     FListBox.Items.Assign(AValue)
475     else FItems.Assign(AValue);
476 end;
477 
478 procedure TBCComboBox.SetMemoryUsage(AValue: TBCButtonMemoryUsage);
479 begin
480   Button.MemoryUsage := AValue;
481 end;
482 
483 procedure TBCComboBox.SetOnDrawSelectedItem(AValue: TOnAfterRenderBCButton);
484 begin
485   if @FOnDrawSelectedItem = @AValue then Exit;
486   FOnDrawSelectedItem:= AValue;
487   FButton.ShowCaption := not Assigned(AValue);
488   UpdateButtonCanvasScaleMode;
489 end;
490 
491 procedure TBCComboBox.SetRounding(AValue: TBCRounding);
492 begin
493   Button.Rounding := AValue;
494 end;
495 
496 procedure TBCComboBox.SetStateClicked(AValue: TBCButtonState);
497 begin
498   Button.StateClicked := AValue;
499 end;
500 
501 procedure TBCComboBox.SetStateHover(AValue: TBCButtonState);
502 begin
503   Button.StateHover := AValue;
504 end;
505 
506 procedure TBCComboBox.SetStateNormal(AValue: TBCButtonState);
507 begin
508   Button.StateNormal := AValue;
509 end;
510 
511 procedure TBCComboBox.SetStaticButton(AValue: boolean);
512 begin
513   Button.StaticButton:= AValue;
514 end;
515 
TBCComboBox.GetStyleExtensionnull516 function TBCComboBox.GetStyleExtension: String;
517 begin
518   result := 'bccombo';
519 end;
520 
521 procedure TBCComboBox.WMSetFocus(var Message: TLMSetFocus);
522 begin
523   UpdateFocus(True);
524 end;
525 
526 procedure TBCComboBox.WMKillFocus(var Message: TLMKillFocus);
527 begin
528   if Message.FocusedWnd <> Handle then
529     UpdateFocus(False);
530 end;
531 
532 procedure TBCComboBox.UpdateFocus(AFocused: boolean);
533 var
534   lForm: TCustomForm;
535   oldCaption: string;
536 begin
537   lForm := GetParentForm(Self);
538   if lForm = nil then
539     exit;
540 
541   {$IFDEF FPC}//#
542   if AFocused then
543     ActiveDefaultControlChanged(lForm.ActiveControl)
544   else
545     ActiveDefaultControlChanged(nil);
546   {$ENDIF}
547 
548   oldCaption := FButton.Caption;
549   FButton.Caption := FButton.Caption + '1';
550   FButton.Caption := oldCaption;
551 
552   Invalidate;
553 end;
554 
555 procedure TBCComboBox.KeyDown(var Key: Word; Shift: TShiftState);
556 begin
557   if Key = VK_RETURN then
558   begin
559     ButtonClick(nil);
560     Key := 0;
561   end
562   else if Key = VK_DOWN then
563   begin
564     if ItemIndex + 1 < Items.Count then
565     begin
566       ItemIndex := ItemIndex + 1;
567       Button.Caption := GetItemText;
568       if Assigned(FOnChange) then
569         FOnChange(Self);
570     end;
571     Key := 0;
572   end
573   else if Key = VK_UP then
574   begin
575     if ItemIndex - 1 >= 0 then
576     begin
577       ItemIndex := ItemIndex - 1;
578       Button.Caption := GetItemText;
579       if Assigned(FOnChange) then
580         FOnChange(Self);
581     end;
582     Key := 0;
583   end;
584 end;
585 
586 procedure TBCComboBox.UTF8KeyPress(var UTF8Key: TUTF8Char);
587 var
588   i: integer;
589 begin
590   for i:=0 to Items.Count-1 do
591   begin
592     if (Items[i] <> '') and Items[i].ToLower.StartsWith(LowerCase(UTF8Key)) then
593     begin
594       if ItemIndex <> i then
595       begin
596         ItemIndex := i;
597         Button.Caption := GetItemText;
598         if Assigned(FOnChange) then
599           FOnChange(Self);
600         break;
601       end;
602     end;
603   end;
604 end;
605 
606 procedure TBCComboBox.CreateForm;
607 begin
608   if FForm = nil then
609   begin
610     FForm := TForm.Create(Self);
611     FForm.Visible := False;
612     FForm.ShowInTaskBar:= stNever;
613     FForm.BorderStyle := bsNone;
614     FForm.OnDeactivate:= FormDeactivate;
615     FForm.OnHide:=FormHide;
616     FForm.FormStyle := fsStayOnTop;
617   end;
618 
619   if FListBox = nil then
620   begin
621     FListBox := TListBox.Create(self);
622     FListBox.Parent := FForm;
623     FListBox.BorderStyle := bsNone;
624     FListBox.OnSelectionChange := ListBoxSelectionChange;
625     FListBox.OnMouseLeave:=ListBoxMouseLeave;
626     FListBox.OnMouseMove:=ListBoxMouseMove;
627     FListBox.OnMouseUp:= ListBoxMouseUp;
628     FListBox.Style := lbOwnerDrawFixed;
629     FListBox.OnDrawItem:= ListBoxDrawItem;
630     FListBox.Options := []; // do not draw focus rect
631     FListBox.OnKeyDown:=ListBoxKeyDown;
632     if Assigned(FItems) then
633     begin
634       FListBox.Items.Assign(FItems);
635       FreeAndNil(FItems);
636     end;
637     FListBox.ItemIndex := FItemIndex;
638     FListBox.Color := FDropDownColor;
639   end;
640 end;
641 
642 procedure TBCComboBox.FreeForm;
643 begin
644   if Assigned(FListBox) then
645   begin
646     if FListBox.LCLRefCount > 0 then exit;
647     if FItems = nil then
648       FItems := TStringList.Create;
649     FItems.Assign(FListBox.Items);
650     FItemIndex := FListBox.ItemIndex;
651     FDropDownColor:= FListBox.Color;
652     FreeAndNil(FListBox);
653   end;
654   FreeAndNil(FForm);
655 end;
656 
GetListBoxnull657 function TBCComboBox.GetListBox: TListBox;
658 begin
659   CreateForm;
660   result := FListBox;
661 end;
662 
663 procedure TBCComboBox.UpdateButtonCanvasScaleMode;
664 begin
665   if (CanvasScaleMode = csmFullResolution) or
666      ((CanvasScaleMode = csmAuto) and not Assigned(FOnDrawSelectedItem)) then
667      FButton.CanvasScaleMode:= csmFullResolution
668      else FButton.CanvasScaleMode:= csmScaleBitmap;
669 end;
670 
671 constructor TBCComboBox.Create(AOwner: TComponent);
672 begin
673   inherited Create(AOwner);
674   FButton := TBCButton.Create(Self);
675   FButton.Align := alClient;
676   FButton.Parent := Self;
677   FButton.OnClick := ButtonClick;
678   FButton.DropDownArrow := True;
679   FButton.OnAfterRenderBCButton := OnAfterRenderButton;
680   UpdateButtonCanvasScaleMode;
681 
682   FItems := TStringList.Create;
683   FHoverItem := -1;
684   FItemIndex := -1;
685 
686   DropDownBorderSize := 1;
687   DropDownColor := clWindow;
688   DropDownBorderColor := clWindowText;
689   DropDownCount := 8;
690   DropDownFontColor := clWindowText;
691   DropDownHighlight := clHighlight;
692   DropDownFontHighlight := clHighlightText;
693 
694   FTimerCheckFormHide := TTimer.Create(self);
695   FTimerCheckFormHide.Interval:= 30;
696   FTimerCheckFormHide.OnTimer:= OnTimerCheckFormHide;
697 end;
698 
699 destructor TBCComboBox.Destroy;
700 begin
701   FreeAndNil(FItems);
702   inherited Destroy;
703 end;
704 
705 procedure TBCComboBox.Assign(Source: TPersistent);
706 var
707   src: TBCComboBox;
708 begin
709   if Source is TBCComboBox then
710   begin
711     src := TBCComboBox(Source);
712     Button.Assign(src.Button);
713     Items.Assign(src.Items);
714     ItemIndex := src.ItemIndex;
715     DropDownBorderColor := src.DropDownBorderColor;
716     DropDownBorderSize := src.DropDownBorderSize;
717     DropDownColor := src.DropDownColor;
718     DropDownFontColor := src.DropDownFontColor;
719     DropDownCount := src.DropDownCount;
720     DropDownHighlight := src.DropDownHighlight;
721     DropDownFontHighlight := src.DropDownFontHighlight;
722   end else
723     inherited Assign(Source);
724 end;
725 
726 procedure TBCComboBox.Clear;
727 begin
728   Items.Clear;
729 end;
730 
731 end.
732