You've already forked lazarus-ccr
ExCtrls: Initial commit of TCheckComboBoxEx
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8119 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
87
components/exctrls/examples/CheckComboBoxEx/demo.lpi
Normal file
87
components/exctrls/examples/CheckComboBoxEx/demo.lpi
Normal file
@ -0,0 +1,87 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<CONFIG>
|
||||
<ProjectOptions>
|
||||
<Version Value="12"/>
|
||||
<PathDelim Value="\"/>
|
||||
<General>
|
||||
<SessionStorage Value="InProjectDir"/>
|
||||
<Title Value="demo"/>
|
||||
<Scaled Value="True"/>
|
||||
<ResourceType Value="res"/>
|
||||
<UseXPManifest Value="True"/>
|
||||
<XPManifest>
|
||||
<DpiAware Value="True"/>
|
||||
</XPManifest>
|
||||
<Icon Value="0"/>
|
||||
</General>
|
||||
<BuildModes>
|
||||
<Item Name="Default" Default="True"/>
|
||||
</BuildModes>
|
||||
<PublishOptions>
|
||||
<Version Value="2"/>
|
||||
<UseFileFilters Value="True"/>
|
||||
</PublishOptions>
|
||||
<RunParams>
|
||||
<FormatVersion Value="2"/>
|
||||
</RunParams>
|
||||
<RequiredPackages>
|
||||
<Item>
|
||||
<PackageName Value="RunTimeTypeInfoControls"/>
|
||||
</Item>
|
||||
<Item>
|
||||
<PackageName Value="ExCtrlsPkg"/>
|
||||
</Item>
|
||||
<Item>
|
||||
<PackageName Value="LCL"/>
|
||||
</Item>
|
||||
</RequiredPackages>
|
||||
<Units>
|
||||
<Unit>
|
||||
<Filename Value="demo.lpr"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit>
|
||||
<Unit>
|
||||
<Filename Value="main.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<ComponentName Value="MainForm"/>
|
||||
<HasResources Value="True"/>
|
||||
<ResourceBaseClass Value="Form"/>
|
||||
<UnitName Value="Main"/>
|
||||
</Unit>
|
||||
</Units>
|
||||
</ProjectOptions>
|
||||
<CompilerOptions>
|
||||
<Version Value="11"/>
|
||||
<PathDelim Value="\"/>
|
||||
<Target>
|
||||
<Filename Value="demo"/>
|
||||
</Target>
|
||||
<SearchPaths>
|
||||
<IncludeFiles Value="$(ProjOutDir)"/>
|
||||
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
|
||||
</SearchPaths>
|
||||
<Linking>
|
||||
<Debugging>
|
||||
<DebugInfoType Value="dsDwarf2Set"/>
|
||||
</Debugging>
|
||||
<Options>
|
||||
<Win32>
|
||||
<GraphicApplication Value="True"/>
|
||||
</Win32>
|
||||
</Options>
|
||||
</Linking>
|
||||
</CompilerOptions>
|
||||
<Debugging>
|
||||
<Exceptions>
|
||||
<Item>
|
||||
<Name Value="EAbort"/>
|
||||
</Item>
|
||||
<Item>
|
||||
<Name Value="ECodetoolError"/>
|
||||
</Item>
|
||||
<Item>
|
||||
<Name Value="EFOpenError"/>
|
||||
</Item>
|
||||
</Exceptions>
|
||||
</Debugging>
|
||||
</CONFIG>
|
||||
25
components/exctrls/examples/CheckComboBoxEx/demo.lpr
Normal file
25
components/exctrls/examples/CheckComboBoxEx/demo.lpr
Normal file
@ -0,0 +1,25 @@
|
||||
program demo;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
uses
|
||||
{$IFDEF UNIX}
|
||||
cthreads,
|
||||
{$ENDIF}
|
||||
{$IFDEF HASAMIGA}
|
||||
athreads,
|
||||
{$ENDIF}
|
||||
Interfaces, // this includes the LCL widgetset
|
||||
Forms, runtimetypeinfocontrols, Main
|
||||
{ you can add units after this };
|
||||
|
||||
{$R *.res}
|
||||
|
||||
begin
|
||||
RequireDerivedFormResource:=True;
|
||||
Application.Scaled:=True;
|
||||
Application.Initialize;
|
||||
Application.CreateForm(TMainForm, MainForm);
|
||||
Application.Run;
|
||||
end.
|
||||
|
||||
96
components/exctrls/examples/CheckComboBoxEx/main.lfm
Normal file
96
components/exctrls/examples/CheckComboBoxEx/main.lfm
Normal file
@ -0,0 +1,96 @@
|
||||
object MainForm: TMainForm
|
||||
Left = 261
|
||||
Height = 335
|
||||
Top = 139
|
||||
Width = 706
|
||||
Caption = 'CheckComboBoxEx Demonstration'
|
||||
ClientHeight = 335
|
||||
ClientWidth = 706
|
||||
OnCreate = FormCreate
|
||||
LCLVersion = '2.3.0.0'
|
||||
object Memo1: TMemo
|
||||
Left = 196
|
||||
Height = 323
|
||||
Top = 6
|
||||
Width = 279
|
||||
Align = alRight
|
||||
BorderSpacing.Around = 6
|
||||
ScrollBars = ssAutoVertical
|
||||
TabOrder = 0
|
||||
end
|
||||
object TIPropertyGrid1: TTIPropertyGrid
|
||||
Left = 492
|
||||
Height = 323
|
||||
Top = 6
|
||||
Width = 208
|
||||
Align = alRight
|
||||
BackgroundColor = clWindow
|
||||
BorderSpacing.Around = 6
|
||||
CheckboxForBoolean = True
|
||||
DefaultValueFont.Color = clWindowText
|
||||
Filter = [tkInteger, tkChar, tkEnumeration, tkFloat, tkSet, tkMethod, tkSString, tkLString, tkAString, tkWString, tkVariant, tkArray, tkRecord, tkInterface, tkClass, tkObject, tkWChar, tkBool, tkInt64, tkQWord, tkDynArray, tkInterfaceRaw, tkProcVar, tkUString, tkUChar, tkHelper, tkFile, tkClassRef, tkPointer]
|
||||
Indent = 16
|
||||
NameFont.Color = clWindowText
|
||||
ValueFont.Color = clMaroon
|
||||
end
|
||||
object Splitter1: TSplitter
|
||||
Left = 185
|
||||
Height = 335
|
||||
Top = 0
|
||||
Width = 5
|
||||
Align = alRight
|
||||
ResizeAnchor = akRight
|
||||
end
|
||||
object Splitter2: TSplitter
|
||||
Left = 481
|
||||
Height = 335
|
||||
Top = 0
|
||||
Width = 5
|
||||
Align = alRight
|
||||
ResizeAnchor = akRight
|
||||
end
|
||||
object Panel1: TPanel
|
||||
Left = 0
|
||||
Height = 335
|
||||
Top = 0
|
||||
Width = 185
|
||||
Align = alClient
|
||||
BevelOuter = bvNone
|
||||
ClientHeight = 335
|
||||
ClientWidth = 185
|
||||
TabOrder = 4
|
||||
object Button4: TButton
|
||||
Left = 16
|
||||
Height = 25
|
||||
Top = 269
|
||||
Width = 74
|
||||
Anchors = [akLeft, akBottom]
|
||||
AutoSize = True
|
||||
Caption = 'Check all'
|
||||
OnClick = Button4Click
|
||||
TabOrder = 0
|
||||
end
|
||||
object Button5: TButton
|
||||
Left = 96
|
||||
Height = 25
|
||||
Top = 269
|
||||
Width = 87
|
||||
Anchors = [akLeft, akBottom]
|
||||
AutoSize = True
|
||||
Caption = 'Uncheck all'
|
||||
OnClick = Button5Click
|
||||
TabOrder = 1
|
||||
end
|
||||
object Button1: TButton
|
||||
Left = 16
|
||||
Height = 25
|
||||
Top = 301
|
||||
Width = 108
|
||||
Anchors = [akLeft, akBottom]
|
||||
AutoSize = True
|
||||
Caption = 'Toggle "Item 1"'
|
||||
OnClick = Button1Click
|
||||
TabOrder = 2
|
||||
end
|
||||
end
|
||||
end
|
||||
102
components/exctrls/examples/CheckComboBoxEx/main.pas
Normal file
102
components/exctrls/examples/CheckComboBoxEx/main.pas
Normal file
@ -0,0 +1,102 @@
|
||||
unit Main;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, EditBtn, CheckLst,
|
||||
StdCtrls, ExtCtrls, RTTIGrids, ExCheckCombo, PropEdits, ObjectInspector;
|
||||
|
||||
type
|
||||
|
||||
{ TMainForm }
|
||||
|
||||
TMainForm = class(TForm)
|
||||
Button1: TButton;
|
||||
Button4: TButton;
|
||||
Button5: TButton;
|
||||
Memo1: TMemo;
|
||||
Panel1: TPanel;
|
||||
Splitter1: TSplitter;
|
||||
Splitter2: TSplitter;
|
||||
TIPropertyGrid1: TTIPropertyGrid;
|
||||
procedure Button1Click(Sender: TObject);
|
||||
procedure Button4Click(Sender: TObject);
|
||||
procedure Button5Click(Sender: TObject);
|
||||
procedure FormCreate(Sender: TObject);
|
||||
private
|
||||
FCombo: TCheckComboBoxEx;
|
||||
procedure CheckComboChange(Sender: TObject);
|
||||
procedure CheckComboItemChange(Sender: TObject; Index: Integer);
|
||||
procedure CheckComboItemClick(Sender: TObject; Index: Integer);
|
||||
|
||||
public
|
||||
|
||||
end;
|
||||
|
||||
var
|
||||
MainForm: TMainForm;
|
||||
|
||||
implementation
|
||||
|
||||
{$R *.lfm}
|
||||
|
||||
{ TMainForm }
|
||||
|
||||
procedure TMainForm.FormCreate(Sender: TObject);
|
||||
begin
|
||||
FCombo := TCheckComboBoxEx.Create(self);
|
||||
FCombo.Align := alTop;
|
||||
FCombo.BorderSpacing.Around := 6;
|
||||
FCombo.AutoDropDown := true;
|
||||
FCombo.Items.Add('Item 1');
|
||||
FCombo.Items.Add('Item 2');
|
||||
FCombo.Items.Add('Item 3');
|
||||
FCombo.AddItem('Item 4', true);
|
||||
FCombo.AddItem('Item 5', true, false);
|
||||
FCombo.AddItem('Item 0');
|
||||
FCombo.Parent := Panel1;
|
||||
FCombo.Hint := 'Default hint';
|
||||
FCombo.TextHint := 'Check items, please...';
|
||||
FCombo.OnChange := @CheckComboChange;
|
||||
FCombo.OnItemChange := @CheckComboItemChange;
|
||||
FCombo.OnItemClick := @CheckComboItemClick;
|
||||
|
||||
TIPropertyGrid1.TIObject := FCombo;
|
||||
|
||||
ActiveControl := FCombo;
|
||||
end;
|
||||
|
||||
procedure TMainForm.CheckComboChange(Sender: TObject);
|
||||
begin
|
||||
Memo1.Lines.Add('CheckComboBoxEx.OnChange');
|
||||
end;
|
||||
|
||||
procedure TMainForm.CheckComboItemChange(Sender: TObject; Index: Integer);
|
||||
begin
|
||||
Memo1.Lines.Add('CheckComboBoxEx.OnItemChange, Index ' + Index.ToString);
|
||||
end;
|
||||
|
||||
procedure TMainForm.CheckComboItemClick(Sender: TObject; Index: Integer);
|
||||
begin
|
||||
Memo1.Lines.Add('CheckComboBoxEx.OnItemClick, Index ' + Index.ToString);
|
||||
end;
|
||||
|
||||
procedure TMainForm.Button1Click(Sender: TObject);
|
||||
begin
|
||||
FCombo.Checked[0] := not FCombo.Checked[0];
|
||||
end;
|
||||
|
||||
procedure TMainForm.Button4Click(Sender: TObject);
|
||||
begin
|
||||
FCombo.CheckAll(cbChecked);;
|
||||
end;
|
||||
|
||||
procedure TMainForm.Button5Click(Sender: TObject);
|
||||
begin
|
||||
FCombo.CheckAll(cbUnchecked);
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
@ -9,6 +9,7 @@
|
||||
<Version Value="11"/>
|
||||
<PathDelim Value="\"/>
|
||||
<SearchPaths>
|
||||
<IncludeFiles Value="source"/>
|
||||
<OtherUnitFiles Value="source"/>
|
||||
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
|
||||
</SearchPaths>
|
||||
@ -18,7 +19,7 @@
|
||||
- TRadioButton, TCheckbox, TRadioGroup and TCheckGroup: drawn by ThemeServices/Canvas, not by widgetset, button/text layout, wordwrap, user-provided check images
|
||||
- TColumnComboBoxEx"/>
|
||||
<License Value="LGPL with linking exception (like Lazarus LCL)."/>
|
||||
<Files Count="5">
|
||||
<Files Count="6">
|
||||
<Item1>
|
||||
<Filename Value="source\excheckctrls.pas"/>
|
||||
<UnitName Value="ExCheckCtrls"/>
|
||||
@ -40,6 +41,10 @@
|
||||
<Filename Value="source\excombo.pas"/>
|
||||
<UnitName Value="ExCombo"/>
|
||||
</Item5>
|
||||
<Item6>
|
||||
<Filename Value="source\excheckcombo.pas"/>
|
||||
<UnitName Value="ExCheckCombo"/>
|
||||
</Item6>
|
||||
</Files>
|
||||
<CompatibilityMode Value="True"/>
|
||||
<LazDoc Paths="fpdoc"/>
|
||||
|
||||
@ -8,7 +8,8 @@ unit ExCtrlsPkg;
|
||||
interface
|
||||
|
||||
uses
|
||||
ExCheckCtrls, ExEditCtrls, ExCtrlsReg, ExButtons, ExCombo, LazarusPackageIntf;
|
||||
ExCheckCtrls, ExEditCtrls, ExCtrlsReg, ExButtons, ExCombo, ExCheckCombo,
|
||||
LazarusPackageIntf;
|
||||
|
||||
implementation
|
||||
|
||||
|
||||
@ -22,3 +22,6 @@ tfloatsispineditex_200.png
|
||||
tcolumncomboboxex.png
|
||||
tcolumncomboboxex_150.png
|
||||
tcolumncomboboxex_200.png
|
||||
tcheckcomboboxex.png
|
||||
tcheckcomboboxex_150.png
|
||||
tcheckcomboboxex_200.png
|
||||
|
||||
645
components/exctrls/source/excheckcombo.pas
Normal file
645
components/exctrls/source/excheckcombo.pas
Normal file
@ -0,0 +1,645 @@
|
||||
unit ExCheckCombo;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
LCLIntf, LCLType, LMessages,
|
||||
Classes, SysUtils, Controls, StdCtrls, GroupedEdit, EditBtn, CheckLst, Forms;
|
||||
|
||||
type
|
||||
{ TCheckComboBoxEx }
|
||||
|
||||
TCheckItemChange = procedure(Sender: TObject; AIndex: Integer) of object;
|
||||
TCheckComboBoxHintMode = (cbhmDefault, cbhmItems);
|
||||
|
||||
TCheckComboBoxEx = class(TEditButton)
|
||||
private
|
||||
FAutoDropDown: Boolean;
|
||||
FCheckListBox: TCheckListBox;
|
||||
FDelimiter: Char;
|
||||
FDropDownCount: Integer;
|
||||
FDropDownForm: TForm;
|
||||
FDroppedDown: Boolean;
|
||||
FEscCancels: Boolean;
|
||||
FItemIndex: Integer;
|
||||
FItemWidth: Integer;
|
||||
FHintMode: TCheckComboBoxHintMode;
|
||||
FSavedChecks: array of Integer;
|
||||
FOnChange: TNotifyEvent;
|
||||
FOnCloseUp: TNotifyEvent;
|
||||
FOnDropDown: TNotifyEvent;
|
||||
FOnItemChange: TCheckItemChange;
|
||||
FOnItemClick: TCheckListClicked;
|
||||
procedure CloseUpHandler(Sender: TObject);
|
||||
function GetAllowGrayed: Boolean;
|
||||
function GetChecked(AIndex: Integer): Boolean;
|
||||
function GetItemEnabled(AIndex: Integer): Boolean;
|
||||
function GetItemIndex: Integer;
|
||||
function GetItems: TStrings;
|
||||
function GetSorted: Boolean;
|
||||
function GetState(AIndex: Integer): TCheckBoxState;
|
||||
procedure ItemClickHandler(Sender: TObject; AIndex: Integer);
|
||||
procedure SetAllowGrayed(AValue: Boolean);
|
||||
procedure SetChecked(AIndex: Integer; const AValue: Boolean);
|
||||
procedure SetDelimiter(AValue: Char);
|
||||
procedure SetDropDownCount(AValue: Integer);
|
||||
procedure SetItemEnabled(AIndex: Integer; const AValue: Boolean);
|
||||
procedure SetItemIndex(AValue: Integer);
|
||||
procedure SetItems(const AValue: TStrings);
|
||||
procedure SetItemWidth(AValue: Integer);
|
||||
procedure SetSorted(AValue: Boolean);
|
||||
procedure SetState(AIndex: Integer; const AValue: TCheckboxState);
|
||||
protected
|
||||
procedure ButtonClick; override;
|
||||
procedure CloseUp;
|
||||
procedure DoEnter; override;
|
||||
procedure DoChange; virtual;
|
||||
procedure DoItemChange(AIndex: Integer); virtual;
|
||||
procedure DoCloseUp; virtual;
|
||||
procedure DoDropDown; virtual;
|
||||
procedure DoItemClick(AIndex: Integer); virtual;
|
||||
procedure DoOnShowHint(HintInfo: PHintInfo); override;
|
||||
procedure EditKeyDown(var Key: Word; Shift: TShiftState); override;
|
||||
function GetBuddyClassType: TControlClass; override;
|
||||
function GetEditorClassType: TGEEditClass; override;
|
||||
procedure RestoreInitialChecks;
|
||||
procedure SaveInitialChecks;
|
||||
procedure SetBiDiMode(AValue: TBiDiMode); override;
|
||||
procedure ShowPopup;
|
||||
procedure UpdateCaption;
|
||||
public
|
||||
constructor Create(AOwner: TComponent); override;
|
||||
destructor Destroy; override;
|
||||
function AddItem(AText: String; AChecked: Boolean = false; AEnabled: Boolean = true): Integer;
|
||||
procedure CheckAll(AState: TCheckBoxState; aAllowGrayed: Boolean = true; aAllowDisabled: Boolean = true);
|
||||
procedure Clear;
|
||||
procedure Toggle(AIndex: Integer);
|
||||
// public properties
|
||||
property Checked[AIndex: Integer]: Boolean read GetChecked write SetChecked;
|
||||
property DroppedDown: Boolean read FDroppedDown;
|
||||
property ItemEnabled[AIndex: Integer]: Boolean read GetItemEnabled write SetItemEnabled;
|
||||
property Text;
|
||||
published
|
||||
property AllowGrayed: Boolean read GetAllowGrayed write SetAllowGrayed default false;
|
||||
property AutoDropDown: Boolean read FAutoDropDown write FAutoDropDown default false;
|
||||
property Delimiter: char read FDelimiter write SetDelimiter default ';';
|
||||
property DropDownCount: Integer read FDropDownCount write SetDropDownCount default 8;
|
||||
property EscCancels: Boolean read FEscCancels write FEscCancels default true;
|
||||
property HintMode: TCheckComboBoxHintMode read FHintMode write FHintMode default cbhmDefault;
|
||||
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;
|
||||
property Sorted: Boolean read GetSorted write SetSorted default false;
|
||||
property OnChange: TNotifyEvent read FOnChange write FOnChange;
|
||||
property OnCloseUp: TNotifyEvent read FOnCloseUp write FOnCloseUp;
|
||||
property OnDropDown: TNotifyEvent read FOnDropDown write FOnDropDown;
|
||||
property OnItemChange: TCheckItemChange read FOnItemChange write FOnItemChange;
|
||||
property OnItemClick: TCheckListClicked read FOnItemClick write FOnItemClick;
|
||||
// inherited properties
|
||||
property Align;
|
||||
property Anchors;
|
||||
property AutoSize;
|
||||
property BiDiMode;
|
||||
property BorderSpacing;
|
||||
property Color;
|
||||
property Constraints;
|
||||
property DragCursor;
|
||||
property DragKind;
|
||||
property DragMode;
|
||||
property Enabled;
|
||||
property Font;
|
||||
property Hint;
|
||||
property ParentBidiMode;
|
||||
property ParentColor;
|
||||
property ParentFont;
|
||||
property ParentShowHint;
|
||||
property PopupMenu;
|
||||
property ShowHint;
|
||||
property Spacing default 0;
|
||||
property TabOrder;
|
||||
property TabStop;
|
||||
property TextHint;
|
||||
property Visible;
|
||||
// inherited events
|
||||
property OnChangeBounds;
|
||||
property OnClick;
|
||||
property OnContextPopup;
|
||||
property OnDblClick;
|
||||
property OnDragDrop;
|
||||
property OnDragOver;
|
||||
property OnEndDrag;
|
||||
property OnEnter;
|
||||
property OnExit;
|
||||
property OnKeyDown;
|
||||
property OnKeyPress;
|
||||
property OnKeyUp;
|
||||
property OnMouseDown;
|
||||
property OnMouseEnter;
|
||||
property OnMouseLeave;
|
||||
property OnMouseMove;
|
||||
property OnMouseUp;
|
||||
property OnStartDrag;
|
||||
end;
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
Buttons, Themes, WSForms;
|
||||
|
||||
{ TCCBEdit } // CCB = CheckComboBox
|
||||
type
|
||||
TCCBEdit = class(TEbEdit)
|
||||
protected
|
||||
procedure DoOnShowHint(HintInfo: PHintInfo); override;
|
||||
end;
|
||||
|
||||
procedure TCCBEdit.DoOnShowHint(HintInfo: PHintInfo);
|
||||
begin
|
||||
(Parent as TCheckComboBoxEx).DoOnShowHint(HintInfo);
|
||||
end;
|
||||
|
||||
|
||||
{ TCCBButton }
|
||||
type
|
||||
TCCBButton = class(TSpeedButton)
|
||||
protected
|
||||
procedure DoOnShowHint(HintInfo: PHintInfo); override;
|
||||
procedure Paint; override;
|
||||
end;
|
||||
|
||||
procedure TCCBButton.DoOnShowHint(HintInfo: PHintInfo);
|
||||
begin
|
||||
(Parent as TCheckComboBoxEx).DoOnShowHint(HintInfo);
|
||||
end;
|
||||
|
||||
procedure TCCBButton.Paint;
|
||||
const
|
||||
DETAILS: array[TButtonState] of TThemedComboBox = (
|
||||
tcDropDownButtonNormal, // bsUp = button is up
|
||||
tcDropDownButtonDisabled, // bsDisabled = button is disabled
|
||||
tcDropDownButtonPressed, // bsPressed = button is down
|
||||
tcDropDownButtonPressed, // (not used)
|
||||
tcDropDownButtonHot // bsHot = mouse is under mouse
|
||||
);
|
||||
var
|
||||
detail: TThemedElementDetails;
|
||||
begin
|
||||
inherited Paint;
|
||||
detail := ThemeServices.GetElementDetails(DETAILS[FState]);
|
||||
ThemeServices.DrawElement(Canvas.Handle, detail, ClientRect);
|
||||
end;
|
||||
|
||||
|
||||
{ TCheckComboBoxForm }
|
||||
type
|
||||
TCheckComboBoxForm = class(TForm)
|
||||
private
|
||||
FCaller: TControl;
|
||||
FCheckListBox: TCheckListBox;
|
||||
FDropDownCount: Integer;
|
||||
protected
|
||||
procedure ActivateDoubleBuffered;
|
||||
procedure DblClickHandler(Sender: TObject);
|
||||
procedure Deactivate; override;
|
||||
procedure KeepInView(APopupOrigin: TPoint);
|
||||
procedure KeyDownHandler(Sender: TObject; var Key: Word; Shift: TShiftState);
|
||||
procedure MeasureHeight(out AHeight: Integer);
|
||||
public
|
||||
constructor CreateNew(AOwner: TComponent; Num: Integer = 0); override;
|
||||
procedure Initialize(ADropdownCount: Integer; APosition: TPoint; AWidth: Integer);
|
||||
end;
|
||||
|
||||
constructor TCheckComboBoxForm.CreateNew(AOwner: TComponent; Num: Integer = 0);
|
||||
begin
|
||||
inherited CreateNew(AOwner, Num);
|
||||
BorderStyle := bsNone;
|
||||
FCheckListbox := TCheckListbox.Create(self);
|
||||
FCheckListbox.Align := alClient;
|
||||
FCheckListbox.Parent := self;
|
||||
FCheckListbox.OnDblClick := @DblClickHandler;
|
||||
FCheckListbox.OnKeyDown := @KeyDownHandler;
|
||||
FDropDownCount := 8;
|
||||
end;
|
||||
|
||||
procedure TCheckComboBoxForm.ActivateDoubleBuffered;
|
||||
begin
|
||||
DoubleBuffered := TWSCustomFormClass(WidgetSetClass).GetDefaultDoubleBuffered;
|
||||
end;
|
||||
|
||||
procedure TCheckComboBoxForm.Deactivate;
|
||||
begin
|
||||
Close;
|
||||
end;
|
||||
|
||||
procedure TCheckComboboxForm.DblClickHandler(Sender: TObject);
|
||||
begin
|
||||
Close;
|
||||
end;
|
||||
|
||||
procedure TCheckComboBoxForm.Initialize(ADropDownCount: Integer;
|
||||
APosition: TPoint; AWidth: Integer);
|
||||
var
|
||||
h: Integer;
|
||||
begin
|
||||
FDropDownCount := ADropDownCount;
|
||||
MeasureHeight(h);
|
||||
SetBounds(APosition.X, APosition.Y, AWidth, h);
|
||||
KeepInView(APosition);
|
||||
AutoScroll := FCheckListBox.Items.Count > FDropDownCount;
|
||||
end;
|
||||
|
||||
procedure TCheckComboBoxForm.KeepInView(APopupOrigin: TPoint);
|
||||
var
|
||||
R: TRect;
|
||||
begin
|
||||
R := Screen.MonitorFromPoint(APopupOrigin).WorkAreaRect; // take care of taskbar
|
||||
|
||||
if APopupOrigin.X + Width > R.Right then
|
||||
Left := R.Right - Width
|
||||
else if APopupOrigin.X < R.Left then
|
||||
Left := R.Left
|
||||
else
|
||||
Left := APopupOrigin.X;
|
||||
|
||||
if APopupOrigin.Y + Height > R.Bottom then
|
||||
begin
|
||||
if Assigned(FCaller) then
|
||||
Top := APopupOrigin.Y - FCaller.Height - Height
|
||||
else
|
||||
Top := R.Bottom - Height;
|
||||
end else if APopupOrigin.Y < R.Top then
|
||||
Top := R.Top
|
||||
else
|
||||
Top := APopupOrigin.Y;
|
||||
|
||||
if Left < R.Left then Left := 0;
|
||||
if Top < R.Top then Top := 0;
|
||||
end;
|
||||
|
||||
procedure TCheckComboBoxForm.KeyDownHandler(Sender: TObject; var Key: Word;
|
||||
Shift: TShiftState);
|
||||
begin
|
||||
inherited;
|
||||
if (Key = VK_ESCAPE) and TCheckComboBoxEx(FCaller).EscCancels then
|
||||
TCheckComboBoxEx(FCaller).RestoreInitialChecks;
|
||||
if (Key = VK_ESCAPE) or (Key = VK_TAB) or (Key = VK_RETURN) or
|
||||
(((Key = VK_UP) or (Key = VK_DOWN)) and (Shift = [ssAlt]))
|
||||
then
|
||||
Close;
|
||||
end;
|
||||
|
||||
procedure TCheckComboBoxForm.MeasureHeight(out AHeight: Integer);
|
||||
var
|
||||
i: Integer;
|
||||
h: Integer;
|
||||
begin
|
||||
AHeight := 0;
|
||||
for i := 0 to FCheckListbox.Items.Count-1 do
|
||||
if i < FDropDownCount then
|
||||
begin
|
||||
FCheckListbox.MeasureItem(i, h);
|
||||
inc(AHeight,h);
|
||||
end;
|
||||
inc(AHeight, 6);
|
||||
end;
|
||||
|
||||
|
||||
{ TCheckComboBoxEx }
|
||||
|
||||
constructor TCheckComboBoxEx.Create(AOwner: TComponent);
|
||||
begin
|
||||
inherited Create(AOwner);
|
||||
Spacing := 0;
|
||||
Button.Flat := true;
|
||||
Button.Width := GetSystemMetrics(SM_CXVSCROLL);
|
||||
FDelimiter := ';';
|
||||
FDropDownCount := 8;
|
||||
FDropDownForm := TCheckComboBoxForm.CreateNew(Self);
|
||||
with TCheckComboBoxForm(FDropDownForm) do
|
||||
begin
|
||||
Self.FCheckListbox := FCheckListbox;
|
||||
FCaller := self;
|
||||
OnHide := @CloseUpHandler;
|
||||
FCheckListbox.OnItemClick := @ItemClickHandler;
|
||||
end;
|
||||
FEscCancels := true;
|
||||
end;
|
||||
|
||||
destructor TCheckComboBoxEx.Destroy;
|
||||
begin
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
function TCheckComboBoxEx.AddItem(AText: String; AChecked: Boolean = false;
|
||||
AEnabled: Boolean = true): Integer;
|
||||
begin
|
||||
with FCheckListBox do
|
||||
begin
|
||||
Result := Items.Add(AText);
|
||||
Checked[Result] := AChecked;
|
||||
ItemEnabled[Result] := AEnabled;
|
||||
end;
|
||||
UpdateCaption;
|
||||
end;
|
||||
|
||||
procedure TCheckComboBoxEx.ButtonClick;
|
||||
begin
|
||||
ShowPopup;
|
||||
end;
|
||||
|
||||
procedure TCheckComboBoxEx.CheckAll(AState: TCheckBoxState;
|
||||
AAllowGrayed: Boolean = true; AAllowDisabled: Boolean = true);
|
||||
begin
|
||||
with FCheckListBox do
|
||||
CheckAll(AState, AAllowGrayed, AAllowDisabled);
|
||||
UpdateCaption;
|
||||
DoChange;
|
||||
end;
|
||||
|
||||
procedure TCheckComboBoxEx.Clear;
|
||||
begin
|
||||
FCheckListBox.Clear;
|
||||
UpdateCaption;
|
||||
DoChange;
|
||||
end;
|
||||
|
||||
procedure TCheckComboBoxEx.CloseUp;
|
||||
begin
|
||||
FDroppedDown := false;
|
||||
UpdateCaption;
|
||||
DoCloseUp;
|
||||
end;
|
||||
|
||||
procedure TCheckComboBoxEx.CloseUpHandler(Sender: TObject);
|
||||
begin
|
||||
CloseUp;
|
||||
end;
|
||||
|
||||
procedure TCheckComboBoxEx.DoChange;
|
||||
begin
|
||||
if Assigned(FOnChange) then FOnChange(self);
|
||||
end;
|
||||
|
||||
procedure TCheckComboBoxEx.DoCloseUp;
|
||||
begin
|
||||
if Assigned(FOnCloseUp) then FOnCloseUp(self);
|
||||
end;
|
||||
|
||||
procedure TCheckComboBoxEx.DoDropDown;
|
||||
begin
|
||||
if Assigned(FOnDropDown) then FOnDropDown(self);
|
||||
end;
|
||||
|
||||
procedure TCheckComboBoxEx.DoEnter;
|
||||
begin
|
||||
inherited;
|
||||
if FAutoDropDown then ShowPopup;
|
||||
end;
|
||||
|
||||
procedure TCheckComboBoxEx.DoItemChange(AIndex: Integer);
|
||||
begin
|
||||
if Assigned(FOnItemChange) then
|
||||
FOnItemChange(self, AIndex);
|
||||
end;
|
||||
|
||||
procedure TCheckComboBoxEx.DoItemClick(AIndex: Integer);
|
||||
begin
|
||||
if Assigned(FOnItemClick) then
|
||||
FOnItemClick(self, AIndex);
|
||||
end;
|
||||
|
||||
procedure TCheckComboBoxEx.DoOnShowHint(HintInfo: PHintInfo);
|
||||
begin
|
||||
if FHintMode = cbhmItems then
|
||||
HintInfo^.HintStr := StringReplace(Text, FDelimiter+' ', LineEnding, [rfReplaceAll]);
|
||||
inherited;
|
||||
end;
|
||||
|
||||
procedure TCheckComboBoxEx.EditKeyDown(var Key: Word; Shift: TShiftState);
|
||||
begin
|
||||
if (Key = VK_TAB) then
|
||||
begin
|
||||
inherited;
|
||||
exit;
|
||||
end;
|
||||
|
||||
if (Key = VK_RETURN) or (Key = VK_SPACE) or
|
||||
(((Key = VK_DOWN) or (Key = VK_UP)) and (Shift = [ssAlt]))
|
||||
then
|
||||
ShowPopup;
|
||||
|
||||
// Kill all other keys
|
||||
Key := 0;
|
||||
end;
|
||||
|
||||
function TCheckComboBoxEx.GetAllowGrayed: Boolean;
|
||||
begin
|
||||
Result := FCheckListbox.AllowGrayed;
|
||||
end;
|
||||
|
||||
function TCheckComboBoxEx.GetBuddyClassType: TControlClass;
|
||||
begin
|
||||
Result := TCCBButton;
|
||||
end;
|
||||
|
||||
function TCheckComboBoxEx.GetChecked(AIndex: Integer): Boolean;
|
||||
begin
|
||||
Result := FCheckListBox.Checked[AIndex];
|
||||
end;
|
||||
|
||||
function TCheckComboBoxEx.GetEditorClassType: TGEEditClass;
|
||||
begin
|
||||
Result := TCCBEdit;
|
||||
end;
|
||||
|
||||
function TCheckComboBoxEx.GetItemEnabled(AIndex: Integer): Boolean;
|
||||
begin
|
||||
Result := FCheckListbox.ItemEnabled[AIndex];
|
||||
end;
|
||||
|
||||
function TCheckComboBoxEx.GetItemIndex: Integer;
|
||||
begin
|
||||
Result := TCheckComboBoxForm(FDropDownForm).FCheckListBox.ItemIndex;
|
||||
end;
|
||||
|
||||
function TCheckComboBoxEx.GetItems: TStrings;
|
||||
begin
|
||||
Result := FCheckListBox.Items;
|
||||
end;
|
||||
|
||||
function TCheckComboBoxEx.GetSorted: Boolean;
|
||||
begin
|
||||
Result := FCheckListbox.Sorted;
|
||||
end;
|
||||
|
||||
function TCheckComboBoxEx.GetState(AIndex: Integer): TCheckboxState;
|
||||
begin
|
||||
Result := FCheckListBox.State[AIndex];
|
||||
end;
|
||||
|
||||
procedure TCheckComboBoxEx.ItemClickHandler(Sender: TObject; AIndex: Integer);
|
||||
begin
|
||||
UpdateCaption;
|
||||
DoChange;
|
||||
DoItemChange(AIndex);
|
||||
DoItemClick(AIndex);
|
||||
end;
|
||||
|
||||
procedure TCheckComboBoxEx.RestoreInitialChecks;
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
for i := 0 to FCheckListbox.Items.Count-1 do
|
||||
FCheckListbox.Checked[i] := false;
|
||||
for i := 0 to High(FSavedChecks) do
|
||||
FCheckListbox.Checked[FSavedChecks[i]] := true;
|
||||
end;
|
||||
|
||||
procedure TCheckComboBoxEx.SaveInitialChecks;
|
||||
var
|
||||
i, n: Integer;
|
||||
begin
|
||||
SetLength(FSavedChecks, FCheckListbox.Items.Count);
|
||||
n := 0;
|
||||
for i := 0 to FCheckListbox.Items.Count-1 do
|
||||
if FCheckListbox.Checked[i] then
|
||||
begin
|
||||
FSavedChecks[n] := i;
|
||||
inc(n);
|
||||
end;
|
||||
SetLength(FSavedChecks, n);
|
||||
end;
|
||||
|
||||
procedure TCheckComboBoxEx.SetAllowGrayed(AValue: Boolean);
|
||||
begin
|
||||
if GetAllowGrayed = AValue then exit;
|
||||
FCheckListBox.AllowGrayed := AValue;
|
||||
end;
|
||||
|
||||
procedure TCheckComboBoxEx.SetBiDiMode(AValue: TBiDiMode);
|
||||
begin
|
||||
if AValue = BiDiMode then exit;
|
||||
inherited SetBiDiMode(AValue);
|
||||
FDropDownForm.BiDiMode := AValue;
|
||||
if IsRightToLeft then
|
||||
Buddy.Align := alLeft
|
||||
else
|
||||
Buddy.Align := alRight;
|
||||
UpdateCaption;
|
||||
end;
|
||||
|
||||
procedure TCheckComboBoxEx.SetChecked(AIndex: Integer; const AValue: Boolean);
|
||||
begin
|
||||
if GetChecked(AIndex) = AValue then
|
||||
exit;
|
||||
FCheckListBox.Checked[AIndex] := AValue;
|
||||
UpdateCaption;
|
||||
DoChange;
|
||||
DoItemChange(AIndex);
|
||||
end;
|
||||
|
||||
procedure TCheckComboBoxEx.SetDelimiter(AValue: Char);
|
||||
begin
|
||||
if FDelimiter = AValue then exit;
|
||||
FDelimiter := AValue;
|
||||
UpdateCaption;
|
||||
end;
|
||||
|
||||
procedure TCheckComboBoxEx.SetDropDownCount(AValue: Integer);
|
||||
begin
|
||||
if (FDropDownCount = AValue) or (AValue <= 0) then exit;
|
||||
FDropDownCount := AValue;
|
||||
end;
|
||||
|
||||
procedure TCheckComboBoxEx.SetItemEnabled(AIndex: Integer; const AValue: Boolean);
|
||||
begin
|
||||
if GetItemEnabled(AIndex) = AValue then exit;
|
||||
FCheckListbox.ItemEnabled[AIndex] := AValue;
|
||||
end;
|
||||
|
||||
procedure TCheckComboBoxEx.SetItemIndex(AValue: Integer);
|
||||
begin
|
||||
if GetItemIndex() = AValue then exit;
|
||||
FCheckListBox.ItemIndex := AValue;
|
||||
// todo: scroll in view
|
||||
end;
|
||||
|
||||
procedure TCheckComboBoxEx.SetItems(const AValue: TStrings);
|
||||
begin
|
||||
FCheckListBox.Items.Assign(AValue);
|
||||
end;
|
||||
|
||||
procedure TCheckComboBoxEx.SetItemWidth(AValue: Integer);
|
||||
begin
|
||||
if FItemWidth = AValue then exit;
|
||||
if AValue < 0 then
|
||||
FItemWidth := 0
|
||||
else
|
||||
FItemWidth := AValue;
|
||||
end;
|
||||
|
||||
procedure TCheckComboBoxEx.SetSorted(AValue: Boolean);
|
||||
begin
|
||||
FCheckListbox.Sorted := AValue;
|
||||
UpdateCaption;
|
||||
end;
|
||||
|
||||
procedure TCheckComboBoxEx.SetState(AIndex: Integer; const AValue: TCheckBoxState);
|
||||
begin
|
||||
FCheckListbox.State[AIndex] := AValue;
|
||||
DoChange;
|
||||
DoItemChange(AIndex);
|
||||
end;
|
||||
|
||||
procedure TCheckComboBoxEx.ShowPopup;
|
||||
var
|
||||
PopupOrigin: TPoint;
|
||||
PopupWidth: Integer;
|
||||
begin
|
||||
if DoubleBuffered then
|
||||
TCheckComboBoxForm(FDropDownForm).ActivateDoubleBuffered;
|
||||
PopupOrigin := ControlToScreen(Point(0, Height));
|
||||
if FItemWidth > 0 then
|
||||
PopupWidth := FItemWidth
|
||||
else
|
||||
PopupWidth := Self.Width;
|
||||
TCheckComboBoxForm(FDropDownForm).Initialize(FDropDownCount, PopupOrigin, PopupWidth);
|
||||
SaveInitialChecks;
|
||||
FDropDownForm.Show;
|
||||
FDroppedDown := true;
|
||||
DoDropDown;
|
||||
end;
|
||||
|
||||
procedure TCheckComboBoxEx.Toggle(AIndex: Integer);
|
||||
begin
|
||||
SetChecked(AIndex, not GetChecked(AIndex));
|
||||
end;
|
||||
|
||||
procedure TCheckComboBoxEx.UpdateCaption;
|
||||
var
|
||||
i: Integer;
|
||||
s: String;
|
||||
begin
|
||||
s := '';
|
||||
if IsRightToLeft then
|
||||
begin
|
||||
for i := FCheckListBox.Count-1 downto 0 do
|
||||
if FCheckListbox.Checked[i] then
|
||||
s := s + FCheckListbox.items[i] + FDelimiter + ' '
|
||||
end else
|
||||
begin
|
||||
for i := 0 to FCheckListbox.Count-1 do
|
||||
if FCheckListbox.Checked[i] then
|
||||
s := s + FCheckListbox.Items[i] + FDelimiter + ' ';
|
||||
end;
|
||||
if s <> '' then
|
||||
SetLength(s, Length(s)-2);
|
||||
Text := s;
|
||||
end;
|
||||
|
||||
|
||||
end.
|
||||
|
||||
@ -150,148 +150,6 @@ type
|
||||
end;
|
||||
|
||||
|
||||
{ TCustomCheckComboBoxEx }
|
||||
|
||||
TCheckComboItemState = class
|
||||
public
|
||||
State: TCheckBoxState;
|
||||
Enabled: Boolean;
|
||||
Data: TObject;
|
||||
end;
|
||||
TCheckItemChange = procedure(Sender: TObject; AIndex: Integer) of object;
|
||||
|
||||
TCustomCheckComboBoxEx = class(TCustomComboBox)
|
||||
private
|
||||
FAllowGrayed: Boolean;
|
||||
FOnItemChange: TCheckItemChange;
|
||||
procedure AsyncCheckItemStates(Data: PtrInt);
|
||||
function GetChecked(AIndex: Integer): Boolean;
|
||||
function GetCount: Integer;
|
||||
function GetItemEnabled(AIndex: Integer): Boolean;
|
||||
function GetObject(AIndex: Integer): TObject;
|
||||
function GetState(AIndex: Integer): TCheckBoxState;
|
||||
procedure SetChecked(AIndex: Integer; AValue: Boolean);
|
||||
procedure SetItemEnabled(AIndex: Integer; AValue: Boolean);
|
||||
procedure SetObject(AIndex: Integer; AValue: TObject);
|
||||
procedure SetState(AIndex: Integer; AValue: TCheckBoxState);
|
||||
protected
|
||||
FCheckHighlight: Boolean;
|
||||
FCheckSize: TSize;
|
||||
FDropped: Boolean;
|
||||
FHilightedIndex: Integer;
|
||||
FHiLiteLeft: Integer;
|
||||
FHiLiteRight: Integer;
|
||||
FNeedMeasure: Boolean;
|
||||
FRejectDropDown: Boolean;
|
||||
FRejectToggleOnSelect: Boolean;
|
||||
FRightToLeft: Boolean;
|
||||
FTextHeight: SmallInt;
|
||||
procedure CMBiDiModeChanged(var Message: TLMessage); message CM_BIDIMODECHANGED;
|
||||
procedure ClearItemStates;
|
||||
procedure CloseUp; override;
|
||||
procedure DrawItem(Index: Integer; ARect: TRect; State: TOwnerDrawState); override;
|
||||
procedure DropDown; override;
|
||||
procedure FontChanged(Sender: TObject); override;
|
||||
procedure InitializeWnd; override;
|
||||
procedure InitItemStates;
|
||||
procedure CheckItemStates;
|
||||
procedure QueueCheckItemStates;
|
||||
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
|
||||
procedure Loaded; override;
|
||||
procedure MouseLeave; override;
|
||||
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
|
||||
procedure SetItemHeight(const AValue: Integer); override;
|
||||
procedure SetItems(const Value: TStrings); override;
|
||||
procedure Select; override;
|
||||
public
|
||||
constructor Create(AOwner: TComponent); override;
|
||||
destructor Destroy; override;
|
||||
procedure AddItem(const AItem: string; AState: TCheckBoxState; AEnabled: Boolean = True); reintroduce;
|
||||
procedure AssignItems(AItems: TStrings);
|
||||
procedure Clear; override;
|
||||
procedure DeleteItem(AIndex: Integer);
|
||||
procedure CheckAll(AState: TCheckBoxState; AAllowGrayed: Boolean = True; AAllowDisabled: Boolean = True);
|
||||
procedure Toggle(AIndex: Integer);
|
||||
property AllowGrayed: Boolean read FAllowGrayed write FAllowGrayed default False;
|
||||
property Count: Integer read GetCount;
|
||||
property Checked[AIndex: Integer]: Boolean read GetChecked write SetChecked;
|
||||
property ItemEnabled[AIndex: Integer]: Boolean read GetItemEnabled write SetItemEnabled;
|
||||
property Objects[AIndex: Integer]: TObject read GetObject write SetObject;
|
||||
property State[AIndex: Integer]: TCheckBoxState read GetState write SetState;
|
||||
property OnItemChange: TCheckItemChange read FOnItemChange write FOnItemChange;
|
||||
end;
|
||||
|
||||
{ TCheckComboBox }
|
||||
TCheckComboBoxEx = class(TCustomCheckComboBoxEx)
|
||||
published
|
||||
property Align;
|
||||
property AllowGrayed;
|
||||
property Anchors;
|
||||
property ArrowKeysTraverseList;
|
||||
property AutoDropDown;
|
||||
property AutoSize;
|
||||
property BidiMode;
|
||||
property BorderSpacing;
|
||||
property BorderStyle;
|
||||
property Color;
|
||||
property Constraints;
|
||||
property Count;
|
||||
property DragCursor;
|
||||
property DragKind;
|
||||
property DragMode;
|
||||
property DropDownCount;
|
||||
property Enabled;
|
||||
property Font;
|
||||
property ItemHeight;
|
||||
property ItemIndex;
|
||||
property Items;
|
||||
property ItemWidth;
|
||||
property MaxLength;
|
||||
property OnChange;
|
||||
property OnChangeBounds;
|
||||
property OnClick;
|
||||
property OnCloseUp;
|
||||
property OnContextPopup;
|
||||
property OnDblClick;
|
||||
property OnDragDrop;
|
||||
property OnDragOver;
|
||||
property OnEndDrag;
|
||||
property OnDropDown;
|
||||
property OnEditingDone;
|
||||
property OnEnter;
|
||||
property OnExit;
|
||||
property OnGetItems;
|
||||
property OnItemChange;
|
||||
property OnKeyDown;
|
||||
property OnKeyPress;
|
||||
property OnKeyUp;
|
||||
property OnMouseDown;
|
||||
property OnMouseEnter;
|
||||
property OnMouseLeave;
|
||||
property OnMouseMove;
|
||||
property OnMouseUp;
|
||||
property OnMouseWheel;
|
||||
property OnMouseWheelDown;
|
||||
property OnMouseWheelUp;
|
||||
property OnStartDrag;
|
||||
property OnSelect;
|
||||
property OnUTF8KeyPress;
|
||||
property ParentBidiMode;
|
||||
property ParentColor;
|
||||
property ParentFont;
|
||||
property ParentShowHint;
|
||||
property PopupMenu;
|
||||
property ShowHint;
|
||||
property Sorted;
|
||||
property TabOrder;
|
||||
property TabStop;
|
||||
property Text;
|
||||
property TextHint;
|
||||
property Visible;
|
||||
end;
|
||||
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
@ -614,423 +472,5 @@ begin
|
||||
inherited SetStyle(AValue);
|
||||
end;
|
||||
|
||||
|
||||
{ TCustomCheckComboBoxEx }
|
||||
|
||||
constructor TCustomCheckComboBoxEx.Create(AOwner: TComponent);
|
||||
begin
|
||||
inherited Create(AOwner);
|
||||
TStringList(Items).Duplicates:=dupIgnore;
|
||||
Style:=csOwnerDrawFixed;
|
||||
FNeedMeasure:=True;
|
||||
FRejectToggleOnSelect:=True;
|
||||
end;
|
||||
|
||||
destructor TCustomCheckComboBoxEx.Destroy;
|
||||
begin
|
||||
ClearItemStates;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TCustomCheckComboBoxEx.AddItem(const AItem: string; AState: TCheckBoxState; AEnabled: Boolean);
|
||||
var pItemState: TCheckComboItemState;
|
||||
begin
|
||||
pItemState:=TCheckComboItemState.Create;
|
||||
pItemState.State:=aState;
|
||||
pItemState.Enabled:=AEnabled;
|
||||
pItemState.Data:=nil;
|
||||
inherited AddItem(AItem, pItemState);
|
||||
end;
|
||||
|
||||
procedure TCustomCheckComboBoxEx.AssignItems(AItems: TStrings);
|
||||
begin
|
||||
ClearItemStates;
|
||||
Items.Assign(AItems);
|
||||
InitItemStates;
|
||||
end;
|
||||
|
||||
procedure TCustomCheckComboBoxEx.CheckAll(AState: TCheckBoxState; AAllowGrayed: Boolean;
|
||||
AAllowDisabled: Boolean);
|
||||
var i: Integer;
|
||||
begin
|
||||
for i:=0 to Items.Count-1 do
|
||||
begin
|
||||
if (AAllowGrayed or (State[i]<>cbGrayed)) and (AAllowDisabled or ItemEnabled[i])
|
||||
then State[i]:=AState;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCustomCheckComboBoxEx.Clear;
|
||||
begin
|
||||
ClearItemStates;
|
||||
inherited Clear;
|
||||
end;
|
||||
|
||||
procedure TCustomCheckComboBoxEx.ClearItemStates;
|
||||
var i: Integer;
|
||||
begin
|
||||
for i:=0 to Items.Count-1 do
|
||||
begin
|
||||
Items.Objects[i].Free;
|
||||
Items.Objects[i]:=nil;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCustomCheckComboBoxEx.CloseUp;
|
||||
begin
|
||||
FDropped:=False;
|
||||
if FRejectDropDown then
|
||||
begin
|
||||
FRejectDropDown:=False;
|
||||
Update;
|
||||
end else
|
||||
inherited CloseUp;
|
||||
end;
|
||||
|
||||
procedure TCustomCheckComboBoxEx.CMBiDiModeChanged(var Message: TLMessage);
|
||||
begin
|
||||
inherited CMBiDiModeChanged(Message);
|
||||
FRightToLeft:=IsRightToLeft;
|
||||
FNeedMeasure:=True;
|
||||
Invalidate;
|
||||
end;
|
||||
|
||||
procedure TCustomCheckComboBoxEx.DeleteItem(AIndex: Integer);
|
||||
begin
|
||||
if (AIndex>=0) and (AIndex<Items.Count) then
|
||||
begin
|
||||
Items.Objects[AIndex].Free;
|
||||
Items.Delete(AIndex);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCustomCheckComboBoxEx.DrawItem(Index: Integer; ARect: TRect; State: TOwnerDrawState);
|
||||
{ Enabled, State, Highlighted }
|
||||
const caCheckThemes: array [Boolean, TCheckBoxState, Boolean] of TThemedButton =
|
||||
{ normal, highlighted }
|
||||
(((tbCheckBoxUncheckedDisabled, tbCheckBoxUncheckedDisabled), { disabled, unchecked }
|
||||
(tbCheckBoxCheckedDisabled, tbCheckBoxCheckedDisabled), { disabled, checked }
|
||||
(tbCheckBoxMixedDisabled, tbCheckBoxMixedDisabled)), { disabled, greyed }
|
||||
((tbCheckBoxUncheckedNormal, tbCheckBoxUncheckedHot), { enabled, unchecked }
|
||||
(tbCheckBoxCheckedNormal, tbCheckBoxCheckedHot), { enabled, checked }
|
||||
(tbCheckBoxMixedNormal, tbCheckBoxMixedHot))); { enabled, greyed }
|
||||
cCheckIndent: SmallInt = 2;
|
||||
cTextIndent: SmallInt = 5;
|
||||
var aDetail: TThemedElementDetails;
|
||||
aDropped: Boolean;
|
||||
aEnabled: Boolean;
|
||||
aFlags: Cardinal;
|
||||
aFocusedEditableMainItemNoDD: Boolean; { combo has edit-like line edit in csDropDownList (Win) and is closed (not DroppedDown }
|
||||
aGray: Byte;
|
||||
anyRect: TRect;
|
||||
aState: TCheckBoxState;
|
||||
ItemState: TCheckComboItemState;
|
||||
begin { do not call inherited ! }
|
||||
ItemState:=TCheckComboItemState(Items.Objects[Index]);
|
||||
if not (ItemState is TCheckComboItemState) then
|
||||
QueueCheckItemStates;
|
||||
aDropped:=DroppedDown;
|
||||
if aDropped and FRejectDropDown then
|
||||
begin
|
||||
DroppedDown:=False;
|
||||
exit; { Exit! }
|
||||
end;
|
||||
aEnabled:=IsEnabled;
|
||||
if not (csDesigning in ComponentState) then
|
||||
aEnabled:= (aEnabled and ItemState.Enabled);
|
||||
{$IF DEFINED(LCLWin32) or DEFINED(LCLWin64)}
|
||||
aFocusedEditableMainItemNoDD := (Focused and (ARect.Left>0) and not aDropped);
|
||||
{$ELSE}
|
||||
aFocusedEditableMainItemNoDD := False;
|
||||
{$ENDIF}
|
||||
if (ARect.Left=0) or aFocusedEditableMainItemNoDD then
|
||||
begin
|
||||
if odSelected in State then
|
||||
begin
|
||||
if not aEnabled then
|
||||
begin
|
||||
aGray:=ColorToGray(Canvas.Brush.Color);
|
||||
Canvas.Brush.Color:=RGBToColor(aGray, aGray, aGray);
|
||||
end;
|
||||
end else
|
||||
Canvas.Brush.Color:=clWindow;
|
||||
Canvas.Brush.Style:=bsSolid;
|
||||
Canvas.FillRect(ARect);
|
||||
end;
|
||||
if not (csDesigning in ComponentState)
|
||||
then aState:=ItemState.State
|
||||
else aState:=cbUnchecked;
|
||||
aDetail:=ThemeServices.GetElementDetails(caCheckThemes
|
||||
[aEnabled, aState, not aDropped and FCheckHighlight]);
|
||||
if FNeedMeasure then
|
||||
begin
|
||||
FCheckSize:=ThemeServices.GetDetailSize(aDetail);
|
||||
FTextHeight:=Canvas.TextHeight('ŠjÁÇ');
|
||||
if not aDropped then
|
||||
begin
|
||||
if not FRightToLeft then
|
||||
begin
|
||||
FHiLiteLeft:=-1;
|
||||
FHiLiteRight:=ARect.Right;
|
||||
end else
|
||||
begin
|
||||
FHiLiteLeft:=ARect.Left;
|
||||
FHiLiteRight:=ARect.Right;
|
||||
end;
|
||||
FNeedMeasure := False;
|
||||
end;
|
||||
end;
|
||||
if not FRightToLeft
|
||||
then anyRect.Left:=ARect.Left+cCheckIndent
|
||||
else anyRect.Left:=ARect.Right-cCheckIndent-FCheckSize.cx;
|
||||
anyRect.Right:=anyRect.Left+FCheckSize.cx;
|
||||
anyRect.Top:=(ARect.Bottom+ARect.Top-FCheckSize.cy) div 2;
|
||||
anyRect.Bottom:=anyRect.Top+FCheckSize.cy;
|
||||
ThemeServices.DrawElement(Canvas.Handle, aDetail, anyRect);
|
||||
Canvas.Brush.Style:=bsClear;
|
||||
if (not (odSelected in State) or not aDropped) and not aFocusedEditableMainItemNoDD
|
||||
then Canvas.Font.Color:=clWindowText
|
||||
else begin
|
||||
Canvas.Font.Color:=clHighlightText;
|
||||
FHilightedIndex:=Index;
|
||||
end;
|
||||
if aFocusedEditableMainItemNoDD then
|
||||
begin
|
||||
LCLIntf.SetBkColor(Canvas.Handle, ColorToRGB(clBtnFace));
|
||||
LCLIntf.DrawFocusRect(Canvas.Handle, aRect);
|
||||
end;
|
||||
aFlags:=DT_END_ELLIPSIS+DT_VCENTER+DT_SINGLELINE+DT_NOPREFIX;
|
||||
if not FRightToLeft then
|
||||
begin
|
||||
anyRect.Left:=ARect.Left+cCheckIndent+FCheckSize.cx+cTextIndent;
|
||||
anyRect.Right:=ARect.Right;
|
||||
end else
|
||||
begin
|
||||
anyRect.Right:=anyRect.Left-cTextIndent;
|
||||
anyRect.Left:=ARect.Left;
|
||||
aFlags:=aFlags or DT_RIGHT or DT_RTLREADING;
|
||||
end;
|
||||
anyRect.Top:=(ARect.Top+ARect.Bottom-FTextHeight) div 2;
|
||||
anyRect.Bottom:=anyRect.Top+FTextHeight;
|
||||
DrawText(Canvas.Handle, PChar(Items[Index]), Length(Items[Index]), anyRect, aFlags);
|
||||
end;
|
||||
|
||||
procedure TCustomCheckComboBoxEx.DropDown;
|
||||
{$IF DEFINED(LCLWin32) or DEFINED(LCLWin64)}
|
||||
{$ELSE}
|
||||
var aCursorPos: TPoint;
|
||||
aRect: TRect;
|
||||
{$ENDIF}
|
||||
begin
|
||||
{$IF DEFINED(LCLWin32) or DEFINED(LCLWin64)}
|
||||
FRejectDropDown:=False;
|
||||
{$ELSE}
|
||||
aCursorPos:=ScreenToControl(Mouse.CursorPos);
|
||||
aRect:=Rect(FHiLiteLeft, 0, FHiLiteRight, Height);
|
||||
FRejectDropDown:=PtInRect(aRect, aCursorPos);
|
||||
{$ENDIF}
|
||||
FDropped:=True;
|
||||
if not FRejectDropDown then
|
||||
begin
|
||||
inherited DropDown;
|
||||
FRejectToggleOnSelect:=False;
|
||||
end else
|
||||
if (ItemIndex>=0) and ItemEnabled[ItemIndex] then Toggle(ItemIndex);
|
||||
end;
|
||||
|
||||
procedure TCustomCheckComboBoxEx.FontChanged(Sender: TObject);
|
||||
begin
|
||||
FNeedMeasure:=True;
|
||||
inherited FontChanged(Sender);
|
||||
end;
|
||||
|
||||
procedure TCustomCheckComboBoxEx.InitializeWnd;
|
||||
begin
|
||||
InitItemStates;
|
||||
inherited InitializeWnd;
|
||||
CheckItemStates;
|
||||
FRightToLeft:=IsRightToLeft;
|
||||
end;
|
||||
|
||||
procedure TCustomCheckComboBoxEx.InitItemStates;
|
||||
var i: Integer;
|
||||
pItemState: TCheckComboItemState;
|
||||
begin
|
||||
for i:=0 to Items.Count-1 do
|
||||
if Items.Objects[i]=nil then begin
|
||||
pItemState:=TCheckComboItemState.Create;
|
||||
pItemState.Enabled:=True;
|
||||
pItemState.State:=cbUnchecked;
|
||||
pItemState.Data:=nil;
|
||||
Items.Objects[i]:=pItemState;
|
||||
end else if not (Items.Objects[i] is TCheckComboItemState) then
|
||||
raise Exception.Create(DbgSName(Self)+': Item '+IntToStr(i)+' is not a TCheckComboItemState');
|
||||
end;
|
||||
|
||||
procedure TCustomCheckComboBoxEx.CheckItemStates;
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
for i:=0 to Items.Count-1 do
|
||||
if not (Items.Objects[i] is TCheckComboItemState) then
|
||||
raise Exception.Create(DbgSName(Self)+': Item '+IntToStr(i)+' is not a TCheckComboItemState');
|
||||
end;
|
||||
|
||||
procedure TCustomCheckComboBoxEx.QueueCheckItemStates;
|
||||
begin
|
||||
Application.QueueAsyncCall(@AsyncCheckItemStates,0);
|
||||
end;
|
||||
|
||||
procedure TCustomCheckComboBoxEx.KeyDown(var Key: Word; Shift: TShiftState);
|
||||
begin
|
||||
case Key of
|
||||
VK_RETURN:
|
||||
if FDropped then
|
||||
if (ItemIndex=FHilightedIndex) and ItemEnabled[ItemIndex] then Toggle(ItemIndex);
|
||||
VK_SPACE:
|
||||
if DroppedDown then
|
||||
if (ItemIndex>=0) and ItemEnabled[ItemIndex] then
|
||||
begin
|
||||
if ItemIndex<>FHilightedIndex then
|
||||
begin
|
||||
ItemIndex:=FHilightedIndex;
|
||||
inherited Select;
|
||||
end;
|
||||
Toggle(ItemIndex);
|
||||
DroppedDown:=False;
|
||||
end;
|
||||
end;
|
||||
inherited KeyDown(Key, Shift);
|
||||
end;
|
||||
|
||||
procedure TCustomCheckComboBoxEx.Loaded;
|
||||
begin
|
||||
inherited Loaded;
|
||||
InitItemStates;
|
||||
end;
|
||||
|
||||
procedure TCustomCheckComboBoxEx.MouseLeave;
|
||||
begin
|
||||
FCheckHighlight:=False;
|
||||
inherited MouseLeave;
|
||||
end;
|
||||
|
||||
procedure TCustomCheckComboBoxEx.MouseMove(Shift: TShiftState; X, Y: Integer);
|
||||
var aHighlight: Boolean;
|
||||
begin
|
||||
inherited MouseMove(Shift, X, Y);
|
||||
aHighlight:=((X>FHiLiteLeft) and (X<FHiLiteRight));
|
||||
if aHighlight<>FCheckHighlight then
|
||||
begin
|
||||
FCheckHighlight:=aHighlight;
|
||||
Invalidate;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCustomCheckComboBoxEx.Select;
|
||||
begin
|
||||
inherited Select;
|
||||
{$IF DEFINED(LCLWin32) or DEFINED(LCLWin64)}
|
||||
if DroppedDown then FRejectToggleOnSelect:=True;
|
||||
{$ENDIF}
|
||||
if not FRejectToggleOnSelect then
|
||||
begin
|
||||
if (ItemIndex >= 0) and ItemEnabled[ItemIndex] then Toggle(ItemIndex);
|
||||
FRejectToggleOnSelect:=True;
|
||||
end;
|
||||
FDropped:=False;
|
||||
end;
|
||||
|
||||
procedure TCustomCheckComboBoxEx.SetItemHeight(const AValue: Integer);
|
||||
begin
|
||||
inherited SetItemHeight(AValue);
|
||||
FNeedMeasure:=True;
|
||||
end;
|
||||
|
||||
procedure TCustomCheckComboBoxEx.SetItems(const Value: TStrings);
|
||||
begin
|
||||
ClearItemStates;
|
||||
inherited SetItems(Value);
|
||||
InitItemStates;
|
||||
end;
|
||||
|
||||
procedure TCustomCheckComboBoxEx.Toggle(AIndex: Integer);
|
||||
const caNewStateMap: array [TCheckBoxState, Boolean] of TCheckBoxState =
|
||||
{ False (AllowGrayed) True }
|
||||
((cbChecked, cbGrayed), { cbUnchecked }
|
||||
(cbUnChecked, cbUnChecked), { cbChecked }
|
||||
(cbChecked, cbChecked)); { cbGrayed }
|
||||
begin
|
||||
State[AIndex]:=caNewStateMap[State[AIndex], AllowGrayed];
|
||||
end;
|
||||
|
||||
{ TCustomCheckCombo.Getters and Setters }
|
||||
|
||||
function TCustomCheckComboBoxEx.GetChecked(AIndex: Integer): Boolean;
|
||||
begin
|
||||
Result:=(TCheckComboItemState(Items.Objects[AIndex]).State=cbChecked);
|
||||
end;
|
||||
|
||||
procedure TCustomCheckComboBoxEx.AsyncCheckItemStates(Data: PtrInt);
|
||||
begin
|
||||
CheckItemStates;
|
||||
end;
|
||||
|
||||
function TCustomCheckComboBoxEx.GetCount: Integer;
|
||||
begin
|
||||
Result:=Items.Count;
|
||||
end;
|
||||
|
||||
function TCustomCheckComboBoxEx.GetItemEnabled(AIndex: Integer): Boolean;
|
||||
begin
|
||||
Result:=TCheckComboItemState(Items.Objects[AIndex]).Enabled;
|
||||
end;
|
||||
|
||||
function TCustomCheckComboBoxEx.GetObject(AIndex: Integer): TObject;
|
||||
begin
|
||||
Result:=TCheckComboItemState(Items.Objects[AIndex]).Data;
|
||||
end;
|
||||
|
||||
function TCustomCheckComboBoxEx.GetState(AIndex: Integer): TCheckBoxState;
|
||||
begin
|
||||
Result:=TCheckComboItemState(Items.Objects[AIndex]).State;
|
||||
end;
|
||||
|
||||
procedure TCustomCheckComboBoxEx.SetChecked(AIndex: Integer; AValue: Boolean);
|
||||
begin
|
||||
if AValue=(TCheckComboItemState(Items.Objects[AIndex]).State=cbChecked) then exit;
|
||||
if AValue
|
||||
then TCheckComboItemState(Items.Objects[AIndex]).State:=cbChecked
|
||||
else TCheckComboItemState(Items.Objects[AIndex]).State:=cbUnchecked;
|
||||
if Assigned(FOnItemChange) then
|
||||
FOnItemChange(Self, AIndex);
|
||||
if AIndex=ItemIndex then
|
||||
Invalidate;
|
||||
end;
|
||||
|
||||
procedure TCustomCheckComboBoxEx.SetItemEnabled(AIndex: Integer; AValue: Boolean);
|
||||
begin
|
||||
if TCheckComboItemState(Items.Objects[AIndex]).Enabled=AValue then exit;
|
||||
TCheckComboItemState(Items.Objects[AIndex]).Enabled:=AValue;
|
||||
if AIndex=ItemIndex then
|
||||
Invalidate;
|
||||
end;
|
||||
|
||||
procedure TCustomCheckComboBoxEx.SetObject(AIndex: Integer; AValue: TObject);
|
||||
begin
|
||||
TCheckComboItemState(Items.Objects[AIndex]).Data:=AValue;
|
||||
end;
|
||||
|
||||
procedure TCustomCheckComboBoxEx.SetState(AIndex: Integer; AValue: TCheckBoxState);
|
||||
begin
|
||||
if TCheckComboItemState(Items.Objects[AIndex]).State=AValue then exit;
|
||||
TCheckComboItemState(Items.Objects[AIndex]).State:=AValue;
|
||||
if Assigned(FOnItemChange) then
|
||||
FOnItemChange(self, AIndex);
|
||||
if AIndex=ItemIndex then
|
||||
Invalidate;
|
||||
end;
|
||||
|
||||
|
||||
end.
|
||||
|
||||
|
||||
@ -12,7 +12,7 @@ procedure Register;
|
||||
implementation
|
||||
|
||||
uses
|
||||
ExButtons, ExCheckCtrls, ExEditCtrls, ExCombo;
|
||||
ExButtons, ExCheckCtrls, ExEditCtrls, ExCombo, ExCheckCombo;
|
||||
|
||||
{$R exctrlsreg.res}
|
||||
|
||||
|
||||
Binary file not shown.
Reference in New Issue
Block a user