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

205
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,11 +397,79 @@ var
detail: TThemedElementDetails;
begin
inherited Paint;
detail := ThemeServices.GetElementDetails(DETAILS[FState]);
ThemeServices.DrawElement(Canvas.Handle, detail, ClientRect);
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 }
type
TCheckComboBoxForm = class(TForm)
@@ -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,9 +662,12 @@ end;
procedure TCheckComboBoxEx.ButtonClick;
begin
ShowPopup;
if DroppedDown then
CloseUp
else
ShowPopup;
end;
procedure TCheckComboBoxEx.CheckAll(AState: TCheckBoxState;
AAllowGrayed: Boolean = true; AAllowDisabled: Boolean = true);
var
@@ -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;