hide list, configure dropdown appearance, DrawItem and Change event

bccombobox.pas

@@ -15,36 +15,66 @@ type
   TBCComboBox = class(TCustomControl)
   private
     FButton: TBCButton;
+    FDropDownBorderSize: integer;
+    FDropDownCount: integer;
+    FDropDownFontColor: TColor;
+    FDropDownFontHighlight: TColor;
+    FDropDownHighlight: TColor;
     FForm: TForm;
+    FFormHideDate: TDateTime;
     FHoverItem: integer;
+    FItemHeight: integer;
     FListBox: TListBox;
+    FDropDownBorderColor: TColor;
+    FOnDrawItem: TDrawItemEvent;
+    FOnChange: TNotifyEvent;
     procedure ButtonClick(Sender: TObject);
+    procedure FormDeactivate(Sender: TObject);
+    procedure FormHide(Sender: TObject);
+    function GetItemText: string;
+    function GetDropDownBorderStyle: TBorderStyle;
+    function GetDropDownColor: TColor;
     function GetItemIndex: integer;
     function GetItems: TStrings;
-    procedure ListBoxClick(Sender: TObject);
+    procedure ListBoxMouseUp({%H-}Sender: TObject; {%H-}Button: TMouseButton;
+                          {%H-}Shift: TShiftState; {%H-}X, {%H-}Y: Integer);
     procedure ListBoxMouseLeave(Sender: TObject);
-    procedure ListBoxMouseMove(Sender: TObject; Shift: TShiftState; X,
+    procedure ListBoxMouseMove(Sender: TObject; {%H-}Shift: TShiftState; X,
       Y: Integer);
-    procedure ListBoxSelectionChange(Sender: TObject; User: boolean);
+    procedure ListBoxSelectionChange(Sender: TObject; {%H-}User: boolean);
+    procedure ListBoxDrawItem(Control: TWinControl; Index: Integer;
+      ARect: TRect; State: TOwnerDrawState);
+    procedure SetDropDownBorderStyle(AValue: TBorderStyle);
+    procedure SetDropDownColor(AValue: TColor);
     procedure SetItemIndex(AValue: integer);
     procedure SetItems(AValue: TStrings);
-  protected
-    procedure UpdateCaption;
   public
     constructor Create(AOwner: TComponent); override;
     property HoverItem: integer read FHoverItem;
     property Button: TBCButton read FButton write FButton;
     property ListBox: TListBox read FListBox write FListBox;
+    property Text: string read GetItemText;
+  published
     property Items: TStrings read GetItems write SetItems;
     property ItemIndex: integer read GetItemIndex write SetItemIndex;
-  published
-
+    property ItemHeight: integer read FItemHeight write FItemHeight default 0;
+    property DropDownBorderColor: TColor read FDropDownBorderColor write FDropDownBorderColor default clWindowText;
+    property DropDownBorderSize: integer read FDropDownBorderSize write FDropDownBorderSize default 1;
+    property DropDownColor: TColor read GetDropDownColor write SetDropDownColor default clWindow;
+    property DropDownFontColor: TColor read FDropDownFontColor write FDropDownFontColor default clWindowText;
+    property DropDownCount: integer read FDropDownCount write FDropDownCount default 8;
+    property DropDownHighlight: TColor read FDropDownHighlight write FDropDownHighlight default clHighlight;
+    property DropDownFontHighlight: TColor read FDropDownFontHighlight write FDropDownFontHighlight default clHighlightText;
+    property OnDrawItem: TDrawItemEvent read FOnDrawItem write FOnDrawItem;
+    property OnChange: TNotifyEvent read FOnChange write FOnChange;
   end;
 
 procedure Register;
 
 implementation
 
+uses math;
+
 procedure Register;
 begin
   RegisterComponents('BGRA Controls', [TBCComboBox]);
@@ -53,8 +83,10 @@ end;
 { TBCComboBox }
 
 procedure TBCComboBox.ButtonClick(Sender: TObject);
+const MinDelayReopen = 500/(1000*60*60*24);
 var
   p: TPoint;
+  h: Integer;
 begin
   if FForm=nil then
   begin
@@ -63,24 +95,66 @@ begin
     FForm.ShowInTaskBar:= stNever;
     FForm.FormStyle := fsStayOnTop;
     FForm.BorderStyle := bsNone;
-    FForm.AutoSize := True;
-    p := ControlToScreen(Point(FButton.Left, FButton.Top + FButton.Height));
-    FForm.Left := p.X;
-    FForm.Top := p.Y;
+    FForm.OnDeactivate:= FormDeactivate;
+    FForm.OnHide:=FormHide;
     FListBox.Parent := FForm;
   end;
 
   if FForm.Visible then
     FForm.Visible := false
   else
+  if Now > FFormHideDate+MinDelayReopen then
   begin
-    FForm.Constraints.MinWidth := FButton.Width;
+    p := ControlToScreen(Point(FButton.Left, FButton.Top + FButton.Height));
+    FForm.Left := p.X;
+    FForm.Top := p.Y;
+    FForm.Color := FDropDownBorderColor;
+    FListBox.Font.Name := Button.StateNormal.FontEx.Name;
+    FListBox.Font.Style := Button.StateNormal.FontEx.Style;
+    FListBox.Font.Height := Button.StateNormal.FontEx.Height;
+    FListBox.Canvas.Font.Assign(FListBox.Font);
+    if Assigned(FOnDrawItem) and (FItemHeight <> 0) then
+      h := FItemHeight else h := FListBox.Canvas.GetTextHeight('Hg');
+    FListBox.ItemHeight := h;
+    FForm.ClientWidth := FButton.Width;
+    FForm.ClientHeight := (h+6)*min(Items.Count, FDropDownCount) + 2*FDropDownBorderSize;
+    FListBox.SetBounds(FDropDownBorderSize,FDropDownBorderSize,
+      FForm.ClientWidth-2*FDropDownBorderSize,
+      FForm.ClientHeight-2*FDropDownBorderSize);
     FForm.Visible := True;
     if FListBox.CanSetFocus then
       FListBox.SetFocus;
   end;
 end;
 
+procedure TBCComboBox.FormDeactivate(Sender: TObject);
+begin
+  FForm.Visible:= false;
+end;
+
+procedure TBCComboBox.FormHide(Sender: TObject);
+begin
+  FFormHideDate := Now;
+end;
+
+function TBCComboBox.GetItemText: string;
+begin
+  if FListBox.ItemIndex<>-1 then
+    result := FListBox.Items[FListBox.ItemIndex]
+  else
+    result := '';
+end;
+
+function TBCComboBox.GetDropDownBorderStyle: TBorderStyle;
+begin
+  result := FListBox.BorderStyle;
+end;
+
+function TBCComboBox.GetDropDownColor: TColor;
+begin
+  result := FListBox.Color;
+end;
+
 function TBCComboBox.GetItemIndex: integer;
 begin
   result := FListBox.ItemIndex;
@@ -91,9 +165,11 @@ begin
   Result := FListBox.Items;
 end;
 
-procedure TBCComboBox.ListBoxClick(Sender: TObject);
+procedure TBCComboBox.ListBoxMouseUp(Sender: TObject; Button: TMouseButton;
+                          Shift: TShiftState; X, Y: Integer);
 begin
   FForm.Visible := false;
+  FFormHideDate := 0;
 end;
 
 procedure TBCComboBox.ListBoxMouseLeave(Sender: TObject);
@@ -112,13 +188,55 @@ begin
   if TempItem <> FHoverItem then
   begin
     FHoverItem := TempItem;
+    if (FHoverItem<>-1) and ([ssLeft,ssRight]*Shift <> []) then
+      FListBox.ItemIndex := FHoverItem;
     FListBox.Repaint;
   end;
 end;
 
 procedure TBCComboBox.ListBoxSelectionChange(Sender: TObject; User: boolean);
 begin
-  UpdateCaption;
+  Button.Caption := GetItemText;
+  if User and Assigned(FOnChange) then FOnChange(self);
+end;
+
+procedure TBCComboBox.ListBoxDrawItem(Control: TWinControl; Index: Integer;
+  ARect: TRect; State: TOwnerDrawState);
+var
+  aCanvas: TCanvas;
+begin
+  if Assigned(FOnDrawItem) then
+  begin
+    FOnDrawItem(Control, Index, ARect, State);
+    exit;
+  end;
+
+  aCanvas := TListBox(Control).Canvas;
+  if Index = HoverItem then
+  begin
+    aCanvas.Brush.Color := DropDownHighlight;
+    aCanvas.Font.Color := DropDownFontHighlight;
+  end
+  else
+  begin
+    aCanvas.Brush.Color := DropDownColor;
+    aCanvas.Font.Color := DropDownFontColor;
+  end;
+  aCanvas.Pen.Style := psClear;
+  aCanvas.FillRect(ARect);
+  aCanvas.TextRect(ARect, ARect.Left+4, ARect.Top +
+    (ARect.Height - aCanvas.GetTextHeight(Items[Index])) div 2,
+    Items[Index]);
+end;
+
+procedure TBCComboBox.SetDropDownBorderStyle(AValue: TBorderStyle);
+begin
+  FListBox.BorderStyle:= AValue;
+end;
+
+procedure TBCComboBox.SetDropDownColor(AValue: TColor);
+begin
+  FListBox.Color := AValue;
 end;
 
 procedure TBCComboBox.SetItemIndex(AValue: integer);
@@ -131,14 +249,6 @@ begin
   Items := AValue;
 end;
 
-procedure TBCComboBox.UpdateCaption;
-begin
-  if FListBox.ItemIndex<>-1 then
-    FButton.Caption := FListBox.Items[FListBox.ItemIndex]
-  else
-    FButton.Caption := '';
-end;
-
 constructor TBCComboBox.Create(AOwner: TComponent);
 begin
   inherited Create(AOwner);
@@ -149,14 +259,24 @@ begin
   FButton.DropDownArrow := True;
 
   FListBox := TListBox.Create(FForm);
-  FListBox.Align := alClient;
+  FListBox.Anchors := [akTop, akLeft, akRight, akBottom];
   FListBox.Parent := FForm;
-  FListBox.BorderStyle := bsNone;
-  FListBox.OnClick := ListBoxClick;
+  FListBox.BorderStyle:= bsNone;
   FListBox.OnSelectionChange := ListBoxSelectionChange;
   FListBox.OnMouseLeave:=ListBoxMouseLeave;
   FListBox.OnMouseMove:=ListBoxMouseMove;
+  FListBox.OnMouseUp:= ListBoxMouseUp;
+  FListBox.Style := lbOwnerDrawFixed;
+  FListBox.OnDrawItem:= ListBoxDrawItem;
+  FListBox.Options := []; // do not draw focus rect
   FHoverItem := -1;
+
+  FDropDownBorderSize := 1;
+  DropDownColor:= clWindow;
+  FDropDownCount := 8;
+  FDropDownFontColor:= clWindowText;
+  FDropDownHighlight:= clHighlight;
+  FDropDownFontHighlight:= clHighlightText;
 end;
 
 end.

test/test_bccombobox/umain.lfm

@@ -1,17 +1,66 @@
 object Form1: TForm1
   Left = 433
-  Height = 240
+  Height = 196
   Top = 119
-  Width = 320
+  Width = 400
   Caption = 'Form1'
-  ClientHeight = 240
-  ClientWidth = 320
+  ClientHeight = 196
+  ClientWidth = 400
+  DesignTimePPI = 120
   OnCreate = FormCreate
-  LCLVersion = '2.1.0.0'
+  LCLVersion = '2.0.2.0'
   object BCComboBox1: TBCComboBox
+    Left = 10
+    Height = 49
+    Top = 10
+    Width = 184
+    ItemIndex = -1
+    DropDownBorderColor = clBlack
+    OnChange = BCComboBox1Change
+  end
+  object Label1: TLabel
+    Left = 208
+    Height = 22
+    Top = 24
+    Width = 53
+    Caption = 'Waiting'
+    ParentColor = False
+  end
+  object RadioWin7: TRadioButton
+    Left = 8
+    Height = 26
+    Top = 104
+    Width = 62
+    Caption = 'Win7'
+    Checked = True
+    OnChange = RadioButtonChange
+    TabOrder = 3
+    TabStop = True
+  end
+  object RadioFlash: TRadioButton
     Left = 8
-    Height = 39
-    Top = 8
-    Width = 205
+    Height = 26
+    Top = 128
+    Width = 62
+    Caption = 'Flash'
+    OnChange = RadioButtonChange
+    TabOrder = 1
+  end
+  object RadioCustom: TRadioButton
+    Left = 8
+    Height = 26
+    Top = 152
+    Width = 79
+    Caption = 'Custom'
+    OnChange = RadioButtonChange
+    TabOrder = 2
+  end
+  object Label2: TLabel
+    Left = 13
+    Height = 22
+    Top = 85
+    Width = 41
+    Caption = 'Style :'
+    ParentColor = False
   end
 end

test/test_bccombobox/umain.pas

@@ -6,7 +6,7 @@ interface
 
 uses
   Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, BCComboBox,
-  BCListBox, LCLType, BCSamples;
+  BCListBox, LCLType, BCSamples, Types;
 
 type
 
@@ -14,11 +14,22 @@ type
 
   TForm1 = class(TForm)
     BCComboBox1: TBCComboBox;
+    Label1: TLabel;
+    Label2: TLabel;
+    RadioWin7: TRadioButton;
+    RadioFlash: TRadioButton;
+    RadioCustom: TRadioButton;
+    procedure BCComboBox1Change(Sender: TObject);
     procedure FormCreate(Sender: TObject);
+    procedure RadioButtonChange(Sender: TObject);
   private
-    procedure OnListBoxDrawItem(Control: TWinControl; Index: integer;
+    procedure OnBCComboBoxDrawItem(Control: TWinControl; Index: integer;
       ARect: TRect; State: TOwnerDrawState);
   public
+    procedure ApplyFlashStyle;
+    procedure ApplyWin7Style;
+    procedure ApplyCustomStyle;
+    procedure UpdateStyle;
 
   end;
 
@@ -41,18 +52,21 @@ begin
   // Selecting items
   BCComboBox1.ItemIndex := 0;
 
-  // Style ListBox
-  BCComboBox1.ListBox.Style := lbOwnerDrawFixed;
-  BCComboBox1.ListBox.OnDrawItem := @OnListBoxDrawItem;
-  BCComboBox1.ListBox.Color := clGray;
-  BCComboBox1.ListBox.ItemHeight := 2 * Canvas.GetTextHeight('aq');
-  BCComboBox1.ListBox.Options := []; // do not draw focus rect
+  // Style drop down
+  UpdateStyle;
+end;
 
-  // Style Button
-  StyleButtonsSample(BCComboBox1.Button, TBCSampleStyle.ssFlashPlayer);
+procedure TForm1.RadioButtonChange(Sender: TObject);
+begin
+  UpdateStyle;
+end;
+
+procedure TForm1.BCComboBox1Change(Sender: TObject);
+begin
+  Label1.Caption := 'Changed to '+BCComboBox1.Text;
 end;
 
-procedure TForm1.OnListBoxDrawItem(Control: TWinControl; Index: integer;
+procedure TForm1.OnBCComboBoxDrawItem(Control: TWinControl; Index: integer;
   ARect: TRect; State: TOwnerDrawState);
 var
   aCanvas: TCanvas;
@@ -71,14 +85,56 @@ begin
   // mouse over
   if Index = BCComboBox1.HoverItem then
   begin
+    aCanvas.Pen.Style := psSolid;
     aCanvas.Pen.Color := clRed;
     aCanvas.Rectangle(ARect);
   end;
 
   // vertically centered text
   aCanvas.TextRect(ARect, 15, ARect.Top +
-    (aCanvas.GetTextHeight(TListBox(Control).Items[Index]) div 2),
+    (ARect.Height - aCanvas.GetTextHeight(TListBox(Control).Items[Index])) div 2,
     TListBox(Control).Items[Index]);
 end;
 
+procedure TForm1.ApplyFlashStyle;
+begin
+  StyleButtonsSample(BCComboBox1.Button, TBCSampleStyle.ssFlashPlayer);
+  BCComboBox1.DropDownColor := $606060;
+  BCComboBox1.DropDownFontColor := $c0c0c0;
+  BCComboBox1.DropDownBorderSize:= 2;
+  BCComboBox1.DropDownBorderColor:= $404040;
+  BCComboBox1.DropDownHighlight := $FC992E;
+  BCComboBox1.DropDownFontHighlight := clWhite;
+  BCComboBox1.OnDrawItem := nil;
+end;
+
+procedure TForm1.ApplyWin7Style;
+begin
+  StyleButtonsSample(BCComboBox1.Button, TBCSampleStyle.ssWindows7);
+  BCComboBox1.DropDownColor := clWhite;
+  BCComboBox1.DropDownFontColor := clBlack;
+  BCComboBox1.DropDownBorderSize:= 1;
+  BCComboBox1.DropDownBorderColor:= clBlack;
+  BCComboBox1.DropDownHighlight := $FC992E;
+  BCComboBox1.DropDownFontHighlight := clWhite;
+  BCComboBox1.OnDrawItem := nil;
+end;
+
+procedure TForm1.ApplyCustomStyle;
+begin
+  StyleButtonsSample(BCComboBox1.Button, TBCSampleStyle.ssDefault);
+  BCComboBox1.DropDownColor := clGray;
+  BCComboBox1.DropDownBorderSize:= 3;
+  BCComboBox1.DropDownBorderColor:= clGreen;
+  BCComboBox1.OnDrawItem := @OnBCComboBoxDrawItem;
+  BCComboBox1.ItemHeight := 2*Canvas.GetTextHeight('aq');
+end;
+
+procedure TForm1.UpdateStyle;
+begin
+  if RadioWin7.Checked then ApplyWin7Style
+  else if RadioFlash.Checked then ApplyFlashStyle
+  else ApplyCustomStyle;
+end;
+
 end.