ExCtrls: Support ImageList for dropdown button.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8144 8e941d3f-bd1b-0410-a28a-d453659cc2b4

components/exctrls/examples/CheckComboBoxEx/main.lfm

@@ -92,5 +92,79 @@ object MainForm: TMainForm
       OnClick = Button1Click
       TabOrder = 2
     end
+    object CheckBox1: TCheckBox
+      Left = 16
+      Height = 19
+      Top = 244
+      Width = 149
+      Caption = 'Custom dropdown icons'
+      OnChange = CheckBox1Change
+      TabOrder = 3
+    end
+  end
+  object ImageList1: TImageList
+    Left = 80
+    Top = 184
+    Bitmap = {
+      4C7A040000001000000010000000720100000000000078DAED95B16EC2301086
+      0F6624B60C4C480C6C8881850721132411435F81356D96B4D4A44B5F838DB7A8
+      541107A94C0CCC6C202648FF438914A400695CB190933E293EFF673BCAF90F51
+      113FAFC3DA7C3CD0B2EA59CB35F1D8F78CAE9C986B3919746ED5CAB1D10A84B9
+      E29A38F7ED597529CC0DD8611DFD622DE64E1A68B9E66CEECD6C202FC1311096
+      1BDA76399E0B432AF9C21861EE80BD97F38F61336DFDC567AF02CD14845218B3
+      2FF7A99A96BBF67EBCAFFF6E3A7C0E5F9801737A462E79A65BE10BAB87BA2DD8
+      63DF7E9EEFBAF0AC3653747811F7EE9FBCFDAB727F54EEAF8A7FA8FA97AA7FAA
+      FA77118F1D36510D687FD06B5C138F5F88BA18AF4127436D0BACB82691AB830D
+      D801FD4AAD1E69587BF6FF77881AC84970042E487A45E9996884DC012CA16D5E
+      58BF02A636DB10D1CC25AAA6E56EBC5F1938D13982886394CBFCFFC7797BD06F
+      C11EF4737ED73653747811F7EE9FBCFDAB727F54EEAF8A7FA8FAD73FF8A7927F
+      3F72FC020B624FB8
+    }
+    BitmapAdv = {
+      4C69020000004C7A040000001800000018000000590200000000000078DAED58
+      3D4B2B4114BD4104799D1636165A69A1BF401BCBD8BD268DF276562356FE8174
+      7E3C5070777D6D4AADD4BF6067294262367E148AA58285904682847DE7EAA8F3
+      747D71377B11640E1CB2CCDC7B667676E6DE3B21B2B0E81CB5B5E9DE28A25CA7
+      3AACC15AEFF47DB710FAEECE5179E1475AEDAB25B727F4D5166BC5EBAB28F454
+      E5D42B0E26D5AE06CE00FC0F59234EFF2470F38FFA4FBCA96FAA89CF6AB32DFB
+      3CFBB356AC9DE7CCA3BFA9ED9A61A08A6DBF9BA766607BAF7D1E6A81B3F83FFB
+      D09F1D87DDF5F35CEA812AE39B74BFB5DBDB2B74D57D77DD78E7DB70C39D4CBA
+      968F63F8EAE078E357FFEB5A16FBF09DF65FB59D6A65D31D4ABC170267DB98DF
+      25C6183BFE3337127ACEF94BBBA776D3EE39DECBD028812DADD7D08C745B298B
+      3353F39C2968DD19EFD2A879EECF2CCF77D57786A17B065E9C046A542A86C49D
+      7D0B0B0B8BEF502349C537C9F82C955F24F3A3647E97AC4F24EB2BC9FA50BABE
+      95AECFC5EF17C2F7230B0B0B8BAFC21A11C7A45C065239ADF50F96890A4B443B
+      60EAF80CDF1E708BB53ED08FC0CA6FA2C4F9053E03F03D648D387DB4E7B53EF3
+      6685E8D3F9916DD9C7F0CF7FF07EF36053DB34318FB6F91D3633B0BDD73E0FE0
+      629B351C07AF8DB994CB44EFEB13A22EF4AD1B76B7E064D2B5D43C00FB8D39F4
+      81FB467F151C4AB117B60D8D4B706C956804BFE746FB6E077B2E87F52DC1BFA5
+      B51A9AFCDCE2BE2CCE0C74A6A07767CC99C7C8F4FF1FE80D8367E005F6E3A854
+      0C893BFB16161616DFA146928A6F92F15930BF88E547C9FC2E599F48D65792F5
+      A1747D2B5D9F4BDF2FA4EF47161669F01754B290874C7A040000002000000020
+      000000F40200000000000078DAED593D4F1B41101DA0409140D05050A4828296
+      267474FC04230AEC3B5218092912B8A1BD7CCA24BE43584A4949E3024401A2A4
+      324D4824FB1C05A5A2A041820E096184F3363A27C792B3E3F5D983C43C69AA9D
+      796F6EE7766F778E48201008886A8ED3CBA9E17BA9A572CE4E764ABBEC59B325
+      37B518358EB14CD9B5EE7CD7CEC63917B51AF5807B55712B8D26FA3565BE67ED
+      7FC9A687DAD5AE7C4E0C806FA7CEDB503F67ADD4FD02AB54BCF971636DC42A8E
+      30A7D288F2FFB1F672B0E45ABB5A0E977827665AD586CE3462CFEF73D907DFD6
+      EDE166B5829FA36A158ABD55F56B413B8D981BED39360A8544DFFF72F89E3D87
+      98AB3087EFA6B68A5EE25954CCCFFCABFEB29BDAD474AFB1AE2CA3FAB9A949C4
+      9F6A7CC76577E1B9EEFB7D7D7E146347F76AED5A67152FF5A29DF7F76B7E6104
+      F5387CC0FB2939D530CF9C555439C5B17EA3E6B5E4DAB6499D4C817D6919FC55
+      2D8FB055954F27F7EF7FAFABDF7661B24E8DF6F18FD618DE01FFEF7C5B27A59C
+      3DD1CD6F65B0AF6EE3BDD88B639F36FD9676E39B2D100804028140F018CE1F9C
+      E72FCEF327E7F99BEBFEC179FFE2BC7F72DEBFB9FA0F9CFD17EEFE1377FF8DBD
+      FFC8DC7FE5EE3F73F7DF0502814020103C3D3844BD9C1A185B7A4D94ECA0F62C
+      F8171B8C676077B06CCC73D103DDD5803BD344BF16D87E96682886671E80ED84
+      7823F591E34AC84F590536DE86F678C0F187536944F9AF110DC26757CBE11231
+      3306DAD3B0738DEB0036DCAC56F071825AD5E36E55FD5AD04EC36E34ED8D0251
+      5F0B1C73B02B8D63CB238ABC7FE789FAE1B3A9C55C2377A3FFFF6F8826117FAA
+      F11DBF237AD07F784F348AB123CDF70CD6D6FFFF0F4423E038D47991DB54933C
+      8B2AA738166FD4BCC26C933AB5B19E9661554D2B6C6AACA3FFFF23D695B20B93
+      756A82B74463D0F343DA27B0AEFEFF0FF6D56DD85E1CFBB4E9B7B41BDF6C8140
+      2010080482C770FEE03C7F719E3F39CFDF5CF70FCEFB17E7FD93F3FECDD87F60
+      EBBF70F79FB8FB6F0E73FFD1E1EFBF72F79F59FBEF0281E069E117F1D4372F
+    }
   end
 end

components/exctrls/examples/CheckComboBoxEx/main.pas

@@ -16,6 +16,8 @@ type
     Button1: TButton;
     Button4: TButton;
     Button5: TButton;
+    CheckBox1: TCheckBox;
+    ImageList1: TImageList;
     Memo1: TMemo;
     Panel1: TPanel;
     Splitter1: TSplitter;
@@ -24,6 +26,7 @@ type
     procedure Button1Click(Sender: TObject);
     procedure Button4Click(Sender: TObject);
     procedure Button5Click(Sender: TObject);
+    procedure CheckBox1Change(Sender: TObject);
     procedure FormCreate(Sender: TObject);
   private
     FCombo: TCheckComboBoxEx;
@@ -49,7 +52,7 @@ begin
   FCombo := TCheckComboBoxEx.Create(self);
   FCombo.Align := alTop;
   FCombo.BorderSpacing.Around := 6;
-  FCombo.AutoDropDown := true;
+  //FCombo.AutoDropDown := true;
   FCombo.Items.Add('Item 1');
   FCombo.Items.Add('Item 2');
   FCombo.Items.Add('Item 3');
@@ -63,6 +66,13 @@ begin
   FCombo.OnItemChange := @CheckComboItemChange;
   FCombo.OnItemClick := @CheckComboItemClick;
   
+  FCombo.DropDownImageIndex.NormalDown := 0;
+  FCombo.DropDownImageIndex.HotDown := 2;
+  FCombo.DropDownImageIndex.PressedDown := 2;
+  FCombo.DropDownImageIndex.NormalUp := 1;
+  FCombo.DropDownImageIndex.HotUp := 3;
+  FCombo.DropDownImageIndex.PressedUp := 3;
+  
   TIPropertyGrid1.TIObject := FCombo;
   
   ActiveControl := FCombo;
@@ -98,5 +108,20 @@ begin
   FCombo.CheckAll(cbUnchecked);
 end;
 
+procedure TMainForm.CheckBox1Change(Sender: TObject);
+begin
+  if Checkbox1.Checked then
+  begin
+    FCombo.Images := ImageList1;
+    FCombo.ButtonWidth := FCombo.Height;
+    FCombo.Spacing := 4;
+  end else
+  begin
+    FCombo.Images := nil;
+    FCombo.ButtonWidth := -1;
+    FCombo.Spacing := 0;
+  end;
+end;
+
 end.
 

components/exctrls/source/excheckcombo.pas

@@ -5,11 +5,12 @@ unit ExCheckCombo;
 interface
 
 uses
-  LCLIntf, LCLType, Classes, SysUtils, Controls, StdCtrls, 
+  LCLIntf, LCLType, Classes, SysUtils, Controls, StdCtrls, ImgList, 
   GroupedEdit, EditBtn, CheckLst, Forms;
 
 type
   { TCheckComboBoxEx }
+  TCheckComboBoxEx = class;
 
   TCheckItemChange = procedure(Sender: TObject; AIndex: Integer) of object;
   TCheckComboBoxHintMode = (cbhmDefault, cbhmItems);
@@ -39,6 +40,26 @@ type
     property State[AIndex: Integer]: TCheckboxState read GetState write SetState;
   end;
   
+  TCheckComboBoxExImageIndex = class(TPersistent)
+  private
+    FOwner: TCheckComboBoxEx;
+    FImgIndex: array[0..7] of TImageIndex;
+    function GetImgIndex(AIndex: Integer): TImageIndex;
+    procedure SetImgIndex(AIndex: Integer; AValue: TImageIndex);
+  public
+    constructor Create(AOwner: TCheckComboBoxEx);
+    property Owner: TCheckComboBoxEx read FOwner;
+  published
+    property NormalDown: TImageIndex index 0 read GetImgIndex write SetImgIndex default -1;
+    property HotDown: TImageIndex index 1 read GetImgIndex write SetImgIndex default -1;
+    property PressedDown: TImageIndex index 2 read GetImgIndex write SetImgIndex default -1;
+    property DisabledDown: TImageIndex index 3 read GetImgIndex write SetImgIndex default -1;
+    property NormalUp: TImageIndex index 4 read GetImgIndex write SetImgIndex default -1;
+    property HotUp: TImageIndex index 5 read GetImgIndex write SetImgIndex default -1;
+    property PressedUp: TImageIndex index 6 read GetImgIndex write SetImgIndex default -1;
+    property DisabledUp: TImageIndex index 7 read GetImgIndex write SetImgIndex default -1;
+  end;
+    
   TCheckComboBoxEx = class(TCustomEditButton)
   private
     FAllowGrayed: Boolean;
@@ -47,6 +68,7 @@ type
     FCheckListBox: TCheckListBox;
     FDelimiter: Char;
     FDropDownCount: Integer;
+    FDropDownImageIndex: TCheckComboBoxExImageIndex;
     FDroppedDown: Boolean;
     FEscCancels: Boolean;
     FItemIndex: Integer;
@@ -63,6 +85,8 @@ type
     procedure CheckComboBoxFormCloseHandler(Sender: TObject; var CloseAction: TCloseAction);
     function GetButtonWidth: Integer;
     function GetChecked(AIndex: Integer): Boolean;
+    function GetImages: TCustomImagelist;
+    function GetImageWidth: Integer;
     function GetItemEnabled(AIndex: Integer): Boolean;
     function GetItems: TStrings;
     function GetState(AIndex: Integer): TCheckBoxState;
@@ -73,6 +97,8 @@ type
     procedure SetChecked(AIndex: Integer; const AValue: Boolean);
     procedure SetDelimiter(AValue: Char);
     procedure SetDropDownCount(AValue: Integer);
+    procedure SetImages(AValue: TCustomImageList);
+    procedure SetImageWidth(AValue: Integer);
     procedure SetItemEnabled(AIndex: Integer; const AValue: Boolean);
     procedure SetItemIndex(AValue: Integer);
     procedure SetItems(const AValue: TStrings);
@@ -95,6 +121,7 @@ type
     procedure EditKeyDown(var Key: Word; Shift: TShiftState); override;
     function GetBuddyClassType: TControlClass; override;
     function GetEditorClassType: TGEEditClass; override;
+    procedure InvalidateButton; virtual;
     procedure RestoreInitialChecks;
     procedure SaveInitialChecks;
     procedure SetBiDiMode(AValue: TBiDiMode); override;
@@ -118,8 +145,11 @@ type
     property ButtonWidth: Integer read FButtonWidth write SetButtonWidth default -1;
     property Delimiter: char read FDelimiter write SetDelimiter default ';';
     property DropDownCount: Integer read FDropDownCount write SetDropDownCount default 8;
+    property DropDownImageIndex: TCheckComboBoxExImageIndex read FDropDownImageIndex write FDropDownImageIndex;
     property EscCancels: Boolean read FEscCancels write FEscCancels default true;
     property HintMode: TCheckComboBoxHintMode read FHintMode write FHintMode default cbhmDefault;
+    property Images: TCustomImageList read GetImages write SetImages;
+    property ImageWidth: Integer read GetImageWidth write SetImageWidth default 0;
     property ItemIndex: Integer read FItemIndex write SetItemIndex default -1;
     property Items: TStrings read GetItems write SetItems;
     property ItemWidth: Integer read FItemWidth write FItemWidth default 0;
@@ -314,9 +344,19 @@ end;
 { TCCBButton }
 type
   TCCBButton = class(TSpeedButton)
+  private
+    procedure SetHotImageIndex;
+    procedure SetImageIndex(AEnabledIndex, ADisabledIndex: Integer; Up: Boolean);
+    procedure SetNormalImageIndex;
+    procedure SetPressedImageIndex;
   protected
     procedure DoOnShowHint(HintInfo: PHintInfo); override;
+    procedure MouseEnter; override;
+    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;     
+    procedure MouseLeave; override;
     procedure Paint; override;
+  public
+    procedure UpdateImageIndex;
   end;
 
 procedure TCCBButton.DoOnShowHint(HintInfo: PHintInfo); 
@@ -324,6 +364,26 @@ begin
   (Parent as TCheckComboBoxEx).DoOnShowHint(HintInfo);
 end;
   
+procedure TCCBButton.MouseEnter;
+begin
+  inherited;
+  SetHotImageIndex;
+end;
+
+procedure TCCBButton.MouseDown(Button: TMouseButton; Shift: TShiftState;
+  X,Y: Integer);
+begin
+  inherited;
+  if (Button = mbLeft) and (Shift = []) then
+    SetPressedImageIndex;
+end;
+
+procedure TCCBButton.MouseLeave;
+begin
+  inherited;
+  SetNormalImageIndex;
+end;
+
 procedure TCCBButton.Paint;
 const
   DETAILS: array[TButtonState] of TThemedComboBox = (
@@ -337,9 +397,77 @@ var
   detail: TThemedElementDetails;
 begin
   inherited Paint;
+  if Images = nil then
+  begin
     detail := ThemeServices.GetElementDetails(DETAILS[FState]);
     ThemeServices.DrawElement(Canvas.Handle, detail, ClientRect);
   end;
+end;
+  
+procedure TCCBButton.SetHotImageIndex;
+begin
+  with Parent as TCheckComboBoxEx do
+    if DroppedDown then
+      Self.SetImageIndex(DropDownImageIndex.HotUp, DropDownImageIndex.DisabledUp, true)
+    else
+      Self.SetImageIndex(DropDownImageIndex.HotDown, DropDownImageIndex.DisabledDown, false);
+end;
+
+procedure TCCBButton.SetImageIndex(AEnabledIndex, ADisabledIndex: Integer;
+  Up: Boolean);
+var
+  idx: Integer;
+begin
+  if Parent.Enabled then
+  begin
+    if AEnabledIndex > -1 then
+      ImageIndex := AEnabledIndex
+    else
+      ImageIndex := (Parent as TCheckComboBoxEx).DropDownImageIndex.NormalDown;
+  end else
+  begin
+    if ADisabledIndex > -1 then
+      ImageIndex := ADisabledIndex
+    else
+    begin
+      idx := -1;
+      if Up then
+        idx := (Parent as TCheckComboBoxEx).DropDownImageIndex.NormalUp;
+      if idx = -1 then 
+        idx := (Parent as TCheckComboBoxEx).DropDownImageIndex.NormalDown;
+      ImageIndex := idx;
+    end;
+  end;
+end;
+
+procedure TCCBButton.SetNormalImageIndex;
+begin
+  with Parent as TCheckComboBoxEx do
+    if DroppedDown then
+      Self.SetImageIndex(DropDownImageIndex.NormalUp, DropDownImageIndex.DisabledUp, true)
+    else
+      Self.SetImageIndex(DropDownImageIndex.NormalDown, DropDownImageIndex.DisabledDown, false);
+end;
+  
+procedure TCCBButton.SetPressedImageIndex;
+begin
+  with Parent as TCheckComboBoxEx do
+    if DroppedDown then
+      Self.SetImageIndex(DropDownImageIndex.PressedUp, DropDownImageIndex.DisabledUp, true)
+    else
+      Self.SetImageIndex(DropDownImageIndex.PressedDown, DropDownImageIndex.DisabledDown, false);
+end;
+
+procedure TCCBButton.UpdateImageIndex;
+var
+  P: TPoint;
+begin
+  P := ScreenToClient(Mouse.CursorPos);
+  if PtInRect(BoundsRect, P) then
+    SetHotImageIndex
+  else
+    SetNormalImageIndex;
+end;
 
 
 { TCheckComboBoxForm }
@@ -460,6 +588,32 @@ begin
 end;
     
 
+{ TCheckComboBoxExImageIndex }
+
+constructor TCheckComboBoxExImageIndex.Create(AOwner: TCheckComboBoxEx);
+var
+  i: Integer;
+begin
+  inherited Create;
+  FOwner := AOwner;
+  for i := 0 to High(FImgIndex) do
+    FImgIndex[i] := -1;
+end;
+
+function TCheckComboBoxExImageIndex.GetImgIndex(AIndex: Integer): TImageIndex;
+begin
+  Result := FImgIndex[AIndex];
+end;
+
+procedure TCheckComboBoxExImageIndex.SetImgIndex(AIndex: Integer; AValue: TImageIndex);
+begin
+  if FImgIndex[AIndex] = AValue then
+    exit;
+  FImgIndex[AIndex] := AValue;
+  TCheckComboBoxEx(FOwner).InvalidateButton;
+end;
+
+
 { TCheckComboBoxEx }
 
 constructor TCheckComboBoxEx.Create(AOwner: TComponent);
@@ -470,6 +624,8 @@ begin
   FButtonWidth := -1;
   FDelimiter := ';';
   FDropDownCount := 8;
+  FDropDownImageIndex := TCheckComboBoxExImageIndex.Create(self);
+  ImageIndex := FDropDownImageIndex.NormalDown;
   FItems := TCheckComboBoxExStrings.Create;
   FEscCancels := true;
 end;
@@ -477,6 +633,7 @@ end;
 destructor TCheckComboBoxEx.Destroy;
 begin
   FItems.Free;
+  FDropdownImageIndex.Free;
   inherited Destroy;
 end;
 
@@ -505,6 +662,9 @@ end;
 
 procedure TCheckComboBoxEx.ButtonClick;
 begin
+  if DroppedDown then
+    CloseUp
+  else
     ShowPopup;
 end;
    
@@ -557,17 +717,11 @@ end;
 procedure TCheckComboBoxEx.CloseUp;
 begin
   FDroppedDown := false;
+  InvalidateButton;
   UpdateCaption;
   DoCloseUp;
 end;
 
-{
-procedure TCheckComboBoxEx.CloseUpHandler(Sender: TObject);
-begin
-  CloseUp;
-end;
-}
-
 procedure TCheckComboBoxEx.CreateHandle;
 begin
   inherited;
@@ -668,6 +822,16 @@ begin
   Result := TCCBEdit;
 end;
 
+function TCheckComboBoxEx.GetImages: TCustomImageList;
+begin
+  Result := (Buddy as TSpeedButton).Images;
+end;
+
+function TCheckComboBoxEx.GetImageWidth: Integer;
+begin
+  Result := (Buddy as TSpeedButton).ImageWidth;
+end;
+
 function TCheckComboBoxEx.GetItemEnabled(AIndex: Integer): Boolean;
 begin
   Result := FItems.Enabled[AIndex];
@@ -683,6 +847,12 @@ begin
   Result := FItems.State[AIndex];
 end;
 
+procedure TCheckComboBoxEx.InvalidateButton;
+begin
+  with (Buddy as TCCBButton) do
+    UpdateImageIndex;
+end;
+
 procedure TCheckComboBoxEx.ItemClickHandler(Sender: TObject; AIndex: Integer);
 begin
   UpdateCaption;
@@ -802,6 +972,16 @@ begin
   FDropDownCount := AValue;
 end;
 
+procedure TCheckComboBoxEx.SetImages(AValue: TCustomImageList);
+begin
+  (Buddy as TSpeedButton).Images := AValue;
+end;
+
+procedure TCheckComboBoxEx.SetImageWidth(AValue: Integer);
+begin
+  (Buddy as TSpeedButton).ImageWidth := AValue;
+end;
+
 procedure TCheckComboBoxEx.SetItemEnabled(AIndex: Integer; const AValue: Boolean);
 begin
   if FItems.Enabled[AIndex] = AValue then exit;
@@ -888,6 +1068,7 @@ begin
   F.Show;
   FDroppedDown := true;
   FCheckListbox := F.FCheckListbox;
+  InvalidateButton;
   DoDropDown;
 end;