pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

ExCtrls: Support ImageList for dropdown button.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8144 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2021-11-05 21:56:09 +00:00
parent 9f9b980645
commit 8f89ccc7f4
3 changed files with 293 additions and 13 deletions
Download Patch File Download Diff File Expand all files Collapse all files

74
components/exctrls/examples/CheckComboBoxEx/main.lfm
View File

@ -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

27
components/exctrls/examples/CheckComboBoxEx/main.pas
View File

@ -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.

197
components/exctrls/source/excheckcombo.pas
View File

@ -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,8 +397,76 @@ 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;
@ -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;