mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-09-25 13:49:16 +02:00
New files for ComboBoxEx and CheckComboBox.
git-svn-id: trunk@46270 -
This commit is contained in:
juha
parent
c65ace9cc9
commit
e0c5aeb65b
4
.gitattributes
vendored
4
.gitattributes
vendored
@ -5693,6 +5693,7 @@ images/components/tcalculatordialog.png -text svneol=unset#image/png
|
||||
images/components/tcalendar.png -text svneol=unset#image/png
|
||||
images/components/tcalendardialog.png -text svneol=unset#image/png
|
||||
images/components/tcheckbox.png -text svneol=unset#image/png
|
||||
images/components/tcheckcombobox.png -text svneol=unset#image/png
|
||||
images/components/tcheckgroup.png -text svneol=unset#image/png
|
||||
images/components/tchecklistbox.png -text svneol=unset#image/png
|
||||
images/components/tcolorbox.png -text svneol=unset#image/png
|
||||
@ -5700,6 +5701,7 @@ images/components/tcolorbutton.png -text svneol=unset#image/png
|
||||
images/components/tcolordialog.png -text svneol=unset#image/png
|
||||
images/components/tcolorlistbox.png -text svneol=unset#image/png
|
||||
images/components/tcombobox.png -text svneol=unset#image/png
|
||||
images/components/tcomboboxex.png -text svneol=unset#image/png
|
||||
images/components/tcontrolbar.png -text svneol=unset#image/png
|
||||
images/components/tcoolbar.png -text svneol=unset#image/png
|
||||
images/components/tdatasource.png -text svneol=unset#image/png
|
||||
@ -6154,6 +6156,7 @@ lcl/calendar.pp svneol=native#text/pascal
|
||||
lcl/checklst.pas svneol=native#text/pascal
|
||||
lcl/clipbrd.pp svneol=native#text/pascal
|
||||
lcl/colorbox.pas svneol=native#text/pascal
|
||||
lcl/comboex.pas svneol=native#text/pascal
|
||||
lcl/comctrls.pp svneol=native#text/pascal
|
||||
lcl/controls.pp svneol=native#text/pascal
|
||||
lcl/cursors.res -text
|
||||
@ -6293,6 +6296,7 @@ lcl/include/canvas.inc svneol=native#text/pascal
|
||||
lcl/include/checkbox.inc svneol=native#text/pascal
|
||||
lcl/include/clipbrd.inc svneol=native#text/pascal
|
||||
lcl/include/colorbutton.inc svneol=native#text/pascal
|
||||
lcl/include/comboex.inc svneol=native#text/plain
|
||||
lcl/include/commondialog.inc svneol=native#text/pascal
|
||||
lcl/include/containedaction.inc svneol=native#text/pascal
|
||||
lcl/include/control.inc svneol=native#text/pascal
|
||||
|
||||
BIN
images/components/tcheckcombobox.png
Normal file
BIN
images/components/tcheckcombobox.png
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 643 B |
BIN
images/components/tcomboboxex.png
Normal file
BIN
images/components/tcomboboxex.png
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 705 B |
395
lcl/comboex.pas
Normal file
395
lcl/comboex.pas
Normal file
@ -0,0 +1,395 @@
|
||||
{ Visual components TComboBoxEx and TCheckComboBox
|
||||
|
||||
Copyright (C) 2014 Vojtěch Čihák, e-mail: cihakvjtch@seznam.cz
|
||||
|
||||
This library is free software; you can redistribute it and/or modify it under the terms of the
|
||||
GNU Library General Public License as published by the Free Software Foundation; either version
|
||||
2 of the License, or (at your option) any later version with the following modification:
|
||||
|
||||
As a special exception, the copyright holders of this library give you permission to link this
|
||||
library with independent modules to produce an executable, regardless of the license terms of
|
||||
these independent modules,and to copy and distribute the resulting executable under terms of
|
||||
your choice, provided that you also meet, for each linked independent module, the terms and
|
||||
conditions of the license of that module. An independent module is a module which is not derived
|
||||
from or based on this library. If you modify this library, you may extend this exception to your
|
||||
version of the library, but you are not obligated to do so. If you do not wish to do so, delete
|
||||
this exception statement from your version.
|
||||
|
||||
This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY;
|
||||
without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See
|
||||
the GNU Library General Public License for more details.
|
||||
|
||||
You should have received a copy of the GNU Library General Public License along with this
|
||||
library; if not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
|
||||
Boston, MA 02111-1307, USA.
|
||||
}
|
||||
|
||||
unit ComboEx;
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, ImgList, Controls, StdCtrls, ComCtrls, ExtCtrls, Graphics,
|
||||
GraphUtil, LCLIntf, LCLType, LMessages, LResources, Themes, types;
|
||||
|
||||
type
|
||||
{$PACKENUM 2}
|
||||
TAutoCompleteOption = (acoAutoSuggest, acoAutoAppend, acoSearch, acoFilterPrefixes,
|
||||
acoUseTab, acoUpDownKeyDropsList, acoRtlReading);
|
||||
TAutoCompleteOptions = set of TAutoCompleteOption;
|
||||
TComboBoxExStyle = (csExDropDown, csExSimple, csExDropDownList);
|
||||
TComboBoxExStyleEx = (csExCaseSensitive, csExNoEditImage, csExNoEditImageIndent,
|
||||
csExNoSizeLimit, csExPathWordBreak);
|
||||
TComboBoxExStyles = set of TComboBoxExStyleEx;
|
||||
TCustomData = Pointer;
|
||||
TListControlItems = class; { forward }
|
||||
TListItemsCompare = function (AList: TListControlItems; AItem1, AItem2: Integer): Integer;
|
||||
TListItemsSortType = TSortType;
|
||||
{ Events }
|
||||
TCheckItemChange = procedure(Sender: TObject; AIndex: Integer) of object;
|
||||
TListControlItem = class; { forward }
|
||||
TListCompareEvent = function(AList: TListControlItems; AItem1, AItem2: TListControlItem): Integer of object;
|
||||
|
||||
{ TListControlItem }
|
||||
TListControlItem = class(TCollectionItem)
|
||||
private
|
||||
FCaption: TTranslateString;
|
||||
FData: TCustomData;
|
||||
FImageIndex: SmallInt;
|
||||
procedure SetCaption(const AValue: TTranslateString);
|
||||
procedure SetImageIndex(AValue: SmallInt);
|
||||
public
|
||||
property Data: TCustomData read FData write FData;
|
||||
constructor Create(ACollection: TCollection); override;
|
||||
published
|
||||
property Caption: TTranslateString read FCaption write SetCaption;
|
||||
property ImageIndex: SmallInt read FImageIndex write SetImageIndex default -1;
|
||||
end;
|
||||
|
||||
{ TComboExItem }
|
||||
TComboExItem = class(TListControlItem)
|
||||
private
|
||||
FIndent: SmallInt;
|
||||
FOverlayImageIndex: SmallInt;
|
||||
FSelectedImageIndex: SmallInt;
|
||||
procedure SetIndent(AValue: SmallInt);
|
||||
procedure SetOverlayImageIndex(AValue: SmallInt);
|
||||
procedure SetSelectedImageIndex(AValue: SmallInt);
|
||||
protected const
|
||||
cDefCaption = 'ItemEx';
|
||||
public
|
||||
constructor Create(ACollection: TCollection); override;
|
||||
destructor Destroy; override;
|
||||
published
|
||||
property Indent: SmallInt read FIndent write SetIndent default -1;
|
||||
property OverlayImageIndex: SmallInt read FOverlayImageIndex write SetOverlayImageIndex default -1;
|
||||
property SelectedImageIndex: SmallInt read FSelectedImageIndex write SetSelectedImageIndex default -1;
|
||||
end;
|
||||
|
||||
{ TListControlItems }
|
||||
TListControlItems = class(TOwnedCollection)
|
||||
private
|
||||
FCaseSensitive: Boolean;
|
||||
FSortType: TListItemsSortType;
|
||||
FOnCompare: TListCompareEvent;
|
||||
FCompare: TListItemsCompare;
|
||||
function GetItems(AIndex: Integer): TListControlItem;
|
||||
procedure SetCaseSensitive(AValue: Boolean);
|
||||
procedure SetSortType(AValue: TListItemsSortType);
|
||||
protected
|
||||
function CompareItems(AItem1, AItem2: TListControlItem): Integer; virtual;
|
||||
function DoCustomSort(AItem1, AItem2: TListControlItem): Integer;
|
||||
function DoOnCompare(AItem1, AItem2: TListControlItem): Integer;
|
||||
procedure Update(AItem: TCollectionItem); override;
|
||||
public
|
||||
function Add: TListControlItem;
|
||||
procedure CustomSort(ACompare: TListItemsCompare);
|
||||
procedure Sort;
|
||||
property Items[AIndex: Integer]: TListControlItem read GetItems; default;
|
||||
published
|
||||
property CaseSensitive: Boolean read FCaseSensitive write SetCaseSensitive default False;
|
||||
property SortType: TListItemsSortType read FSortType write SetSortType default stNone;
|
||||
property OnCompare: TListCompareEvent read FOnCompare write FOnCompare;
|
||||
end;
|
||||
|
||||
{ TComboExItems }
|
||||
TComboExItems = class(TListControlItems)
|
||||
private
|
||||
function GetComboItems(AIndex: Integer): TComboExItem;
|
||||
protected
|
||||
FAddingOrDeletingItem: Boolean;
|
||||
procedure Notify(Item: TCollectionItem; Action: TCollectionNotification); override;
|
||||
procedure Update(Item: TCollectionItem); override;
|
||||
public
|
||||
function Add: TComboExItem; overload;
|
||||
function Add(const ACaption: string; AImageIndex: SmallInt = -1;
|
||||
AOverlayImageIndex: SmallInt = -1; ASelectedImageIndex: SmallInt = -1;
|
||||
AIndent: SmallInt = -1; AData: TCustomData = nil): TComboExItem; overload;
|
||||
function Insert(AIndex: Integer): TComboExItem;
|
||||
property ComboItems[AIndex: Integer]: TComboExItem read GetComboItems; default;
|
||||
end;
|
||||
|
||||
{ TCustomComboBoxEx }
|
||||
TCustomComboBoxEx = class(TCustomComboBox)
|
||||
private
|
||||
FAutoCompleteOptions: TAutoCompleteOptions;
|
||||
FImages: TCustomImageList;
|
||||
FItemsEx: TComboExItems;
|
||||
FStyle: TComboBoxExStyle;
|
||||
FStyleEx: TComboBoxExStyles;
|
||||
procedure SetImages(AValue: TCustomImageList);
|
||||
procedure SetStyle(AValue: TComboBoxExStyle); reintroduce;
|
||||
procedure SetStyleEx(AValue: TComboBoxExStyles);
|
||||
protected const
|
||||
cDefAutoCompOpts = [acoAutoAppend];
|
||||
cDefStyle = csExDropDown;
|
||||
protected
|
||||
FNeedMeasure: Boolean;
|
||||
FRightToLeft: Boolean;
|
||||
FTextHeight: SmallInt;
|
||||
procedure CMBiDiModeChanged(var Message: TLMessage); message CM_BIDIMODECHANGED;
|
||||
procedure DrawItem(Index: Integer; ARect: TRect; State: TOwnerDrawState); override;
|
||||
procedure FontChanged(Sender: TObject); override;
|
||||
procedure InitializeWnd; override;
|
||||
procedure SetItemHeight(const AValue: Integer); override;
|
||||
public
|
||||
constructor Create(TheOwner: TComponent); override;
|
||||
destructor Destroy; override;
|
||||
function Add: Integer; overload;
|
||||
procedure Add(const ACaption: string; AIndent: SmallInt = -1;
|
||||
AImgIdx: SmallInt = -1; AOverlayImgIdx: SmallInt = -1;
|
||||
ASelectedImgIdx: SmallInt = -1); overload;
|
||||
procedure AddItem(const Item: String; AnObject: TObject); override;
|
||||
procedure AssignItemsEx(AItems: TStrings); overload;
|
||||
procedure AssignItemsEx(AItemsEx: TComboExItems); overload;
|
||||
procedure Clear; override;
|
||||
procedure Delete(AIndex: Integer);
|
||||
procedure DeleteSelected;
|
||||
procedure Insert(AIndex: Integer; const ACaption: string; AIndent: SmallInt = -1;
|
||||
AImgIdx: SmallInt = -1; AOverlayImgIdx: SmallInt = -1;
|
||||
ASelectedImgIdx: SmallInt = -1);
|
||||
property AutoCompleteOptions: TAutoCompleteOptions read FAutoCompleteOptions
|
||||
write FAutoCompleteOptions default cDefAutoCompOpts;
|
||||
property Images: TCustomImageList read FImages write SetImages;
|
||||
property ItemsEx: TComboExItems read FItemsEx write FItemsEx;
|
||||
property Style: TComboBoxExStyle read FStyle write SetStyle default cDefStyle;
|
||||
property StyleEx: TComboBoxExStyles read FStyleEx write SetStyleEx default [];
|
||||
end;
|
||||
|
||||
{ TComboBoxEx }
|
||||
TComboBoxEx = class(TCustomComboBoxEx)
|
||||
published
|
||||
property Align;
|
||||
property Anchors;
|
||||
property ArrowKeysTraverseList;
|
||||
property AutoComplete;
|
||||
property AutoCompleteOptions;
|
||||
property AutoCompleteText;
|
||||
property AutoDropDown;
|
||||
property AutoSelect;
|
||||
property AutoSize;
|
||||
property BidiMode;
|
||||
property BorderSpacing;
|
||||
property BorderStyle;
|
||||
property CharCase;
|
||||
property Color;
|
||||
property Constraints;
|
||||
property DragCursor;
|
||||
property DragKind;
|
||||
property DragMode;
|
||||
property DropDownCount;
|
||||
property Enabled;
|
||||
property Font;
|
||||
property Images;
|
||||
property ItemHeight;
|
||||
property ItemsEx; { do not change order; ItemsEx must be before ItemIndex }
|
||||
property ItemIndex;
|
||||
property ItemWidth;
|
||||
property MaxLength;
|
||||
property OnChange;
|
||||
property OnChangeBounds;
|
||||
property OnClick;
|
||||
property OnCloseUp;
|
||||
property OnContextPopup;
|
||||
property OnDblClick;
|
||||
property OnDragDrop;
|
||||
property OnDragOver;
|
||||
property OnDropDown;
|
||||
property OnEditingDone;
|
||||
property OnEndDock;
|
||||
property OnEndDrag;
|
||||
property OnEnter;
|
||||
property OnExit;
|
||||
property OnGetItems;
|
||||
property OnKeyDown;
|
||||
property OnKeyPress;
|
||||
property OnKeyUp;
|
||||
property OnMouseDown;
|
||||
property OnMouseEnter;
|
||||
property OnMouseLeave;
|
||||
property OnMouseMove;
|
||||
property OnMouseUp;
|
||||
property OnSelect;
|
||||
property OnStartDock;
|
||||
property OnStartDrag;
|
||||
property OnUTF8KeyPress;
|
||||
property ParentBidiMode;
|
||||
property ParentColor;
|
||||
property ParentFont;
|
||||
property ParentShowHint;
|
||||
property PopupMenu;
|
||||
property ReadOnly;
|
||||
property ShowHint;
|
||||
property Style;
|
||||
property StyleEx;
|
||||
property TabOrder;
|
||||
property TabStop;
|
||||
property Text;
|
||||
property Visible;
|
||||
end;
|
||||
|
||||
{ TCheckComboItemState }
|
||||
TCheckComboItemState = record
|
||||
State: TCheckBoxState;
|
||||
Enabled: Boolean;
|
||||
Data: TObject;
|
||||
end;
|
||||
PTCheckComboItemState = ^TCheckComboItemState;
|
||||
|
||||
{ TCustomCheckCombo }
|
||||
TCustomCheckCombo = class(TCustomComboBox)
|
||||
private
|
||||
FAllowGrayed: Boolean;
|
||||
FOnItemChange: TCheckItemChange;
|
||||
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;
|
||||
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 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 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 }
|
||||
TCheckComboBox = class(TCustomCheckCombo)
|
||||
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 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 Visible;
|
||||
end;
|
||||
|
||||
procedure Register;
|
||||
|
||||
implementation
|
||||
|
||||
{$include comboex.inc}
|
||||
|
||||
procedure Register;
|
||||
begin
|
||||
{$I comboex.lrs}
|
||||
RegisterComponents('Misc', [TComboBoxEx, TCheckComboBox]);
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
|
||||
865
lcl/include/comboex.inc
Normal file
865
lcl/include/comboex.inc
Normal file
@ -0,0 +1,865 @@
|
||||
{%MainUnit comboex.pas}
|
||||
|
||||
{*****************************************************************************
|
||||
TCustomComboBoxEx, TCustomCheckComboBox
|
||||
*****************************************************************************
|
||||
|
||||
*****************************************************************************
|
||||
See the file COPYING.modifiedLGPL.txt, included in this distribution,
|
||||
for details about the license.
|
||||
*****************************************************************************
|
||||
}
|
||||
|
||||
{ TListControlItem }
|
||||
|
||||
constructor TListControlItem.Create(ACollection: TCollection);
|
||||
begin
|
||||
inherited Create(ACollection);
|
||||
FImageIndex:=-1;
|
||||
end;
|
||||
|
||||
{ TListControlItem.Setters }
|
||||
|
||||
procedure TListControlItem.SetCaption(const AValue: TTranslateString);
|
||||
begin
|
||||
if FCaption=AValue then exit;
|
||||
FCaption:=AValue;
|
||||
Changed(False);
|
||||
end;
|
||||
|
||||
procedure TListControlItem.SetImageIndex(AValue: SmallInt);
|
||||
begin
|
||||
if FImageIndex=AValue then exit;
|
||||
FImageIndex:=AValue;
|
||||
Changed(False);
|
||||
end;
|
||||
|
||||
{ TComboExItem }
|
||||
|
||||
constructor TComboExItem.Create(ACollection: TCollection);
|
||||
begin
|
||||
inherited Create(ACollection);
|
||||
FIndent:=-1;
|
||||
FOverlayImageIndex:=-1;
|
||||
FSelectedImageIndex:=-1;
|
||||
end;
|
||||
|
||||
destructor TComboExItem.Destroy;
|
||||
begin
|
||||
{ normally, Items.Count should be already MenuItems.Count-1 ATM }
|
||||
{ this solves case when item is not deleted via Collection.Delete(Index) }
|
||||
{ but directly via Item.Free (exactly what Collection Editor of IDE does) }
|
||||
{ therefore Notify must be called from here, so count of Items and MenuItems remains same }
|
||||
if assigned(Collection) and assigned(Collection.Owner) and
|
||||
not (csDestroying in (Collection.Owner as TCustomComboBoxEx).ComponentState)
|
||||
and (Collection.Count <= (Collection.Owner as TCustomComboBoxEx).Items.Count)
|
||||
then TComboExItems(Collection).Notify(self, cnDeleting);
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
{ TComboExItem.Setters }
|
||||
|
||||
procedure TComboExItem.SetIndent(AValue: SmallInt);
|
||||
begin
|
||||
if FIndent=AValue then exit;
|
||||
FIndent:=AValue;
|
||||
Changed(False);
|
||||
end;
|
||||
|
||||
procedure TComboExItem.SetOverlayImageIndex(AValue: SmallInt);
|
||||
begin
|
||||
if FOverlayImageIndex=AValue then exit;
|
||||
FOverlayImageIndex:=AValue;
|
||||
{ Changed(False); }
|
||||
end;
|
||||
|
||||
procedure TComboExItem.SetSelectedImageIndex(AValue: SmallInt);
|
||||
begin
|
||||
if FSelectedImageIndex=AValue then exit;
|
||||
FSelectedImageIndex:=AValue;
|
||||
Changed(False);
|
||||
end;
|
||||
|
||||
{ TListControlItems }
|
||||
|
||||
function TListControlItems.Add: TListControlItem;
|
||||
begin
|
||||
Result:=TListControlItem.Create(self);
|
||||
end;
|
||||
|
||||
function TListControlItems.CompareItems(AItem1, AItem2: TListControlItem): Integer;
|
||||
begin
|
||||
if CaseSensitive
|
||||
then Result:=CompareStr((AItem1 as TListControlItem).Caption,
|
||||
(AItem2 as TListControlItem).Caption)
|
||||
else Result:=CompareStr(lowercase((AItem1 as TListControlItem).Caption),
|
||||
lowercase((AItem2 as TListControlItem).Caption));
|
||||
end;
|
||||
|
||||
procedure TListControlItems.CustomSort(ACompare: TListItemsCompare);
|
||||
begin
|
||||
if assigned(ACompare) then
|
||||
begin
|
||||
FCompare:=ACompare;
|
||||
Sort;
|
||||
FCompare:=nil;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TListControlItems.DoCustomSort(AItem1, AItem2: TListControlItem): Integer;
|
||||
begin
|
||||
Result:=FCompare(self, AItem1.Index, AItem2.Index);
|
||||
end;
|
||||
|
||||
function TListControlItems.DoOnCompare(AItem1, AItem2: TListControlItem): Integer;
|
||||
begin
|
||||
Result:=OnCompare(self, AItem1, AItem2);
|
||||
end;
|
||||
|
||||
procedure TListControlItems.Sort;
|
||||
var pCompareItems: function(AItem1, AItem2: TListControlItem): Integer of object;
|
||||
|
||||
procedure QuickSort(aTop, aBottom: Integer);
|
||||
var i, j, aPivot: Integer;
|
||||
begin
|
||||
repeat
|
||||
i:=aTop;
|
||||
j:=aBottom;
|
||||
aPivot:=(aTop+aBottom) div 2;
|
||||
repeat
|
||||
while pCompareItems(Items[aPivot], Items[i])>0 do
|
||||
inc(i);
|
||||
while pCompareItems(Items[aPivot], Items[j])<0 do
|
||||
dec(j);
|
||||
if i<=j then
|
||||
begin
|
||||
if i<>j then
|
||||
if pCompareItems(Items[i], Items[j])<>0 then Exchange(i, j);
|
||||
if aPivot=i
|
||||
then aPivot:=j
|
||||
else if aPivot=j then aPivot:=i;
|
||||
inc(i);
|
||||
dec(j);
|
||||
end;
|
||||
until i>j;
|
||||
if aTop<j then QuickSort(aTop, j);
|
||||
aTop:=i;
|
||||
until i>=aBottom;
|
||||
end;
|
||||
|
||||
var aID: Integer;
|
||||
begin
|
||||
pCompareItems:=nil;
|
||||
if assigned(FCompare)
|
||||
then pCompareItems:=@DoCustomSort
|
||||
else
|
||||
case SortType of
|
||||
stData: if assigned(OnCompare) then pCompareItems:=@DoOnCompare;
|
||||
stText: pCompareItems:=@CompareItems;
|
||||
stBoth: if assigned(OnCompare)
|
||||
then pCompareItems:=@DoOnCompare
|
||||
else pCompareItems:=@CompareItems;
|
||||
end;
|
||||
aID:=Items[(Owner as TCustomComboBoxEx).ItemIndex].ID;
|
||||
BeginUpdate;
|
||||
if assigned(pCompareItems) then QuickSort(0, Count-1);
|
||||
(Owner as TCustomComboBoxEx).ItemIndex:=FindItemID(aID).Index;
|
||||
EndUpdate;
|
||||
end;
|
||||
|
||||
procedure TListControlItems.Update(AItem: TCollectionItem);
|
||||
begin
|
||||
inherited Update(AItem);
|
||||
end;
|
||||
|
||||
{ TListControlItems.Getters and Setters }
|
||||
|
||||
function TListControlItems.GetItems(AIndex: Integer): TListControlItem;
|
||||
begin
|
||||
Result:=GetItem(AIndex) as TListControlItem;
|
||||
end;
|
||||
|
||||
procedure TListControlItems.SetCaseSensitive(AValue: Boolean);
|
||||
begin
|
||||
if FCaseSensitive=AValue then exit;
|
||||
FCaseSensitive:=AValue;
|
||||
end;
|
||||
|
||||
procedure TListControlItems.SetSortType(AValue: TListItemsSortType);
|
||||
begin
|
||||
if FSortType=AValue then exit;
|
||||
FSortType:=AValue;
|
||||
Sort;
|
||||
end;
|
||||
|
||||
{ TComboExItems }
|
||||
|
||||
function TComboExItems.Add: TComboExItem;
|
||||
begin
|
||||
Result:=TComboExItem.Create(self);
|
||||
end;
|
||||
|
||||
function TComboExItems.Add(const ACaption: string; AImageIndex: SmallInt;
|
||||
AOverlayImageIndex: SmallInt; ASelectedImageIndex: SmallInt; AIndent: SmallInt; AData: TCustomData
|
||||
): TComboExItem;
|
||||
begin
|
||||
Result:=Add();
|
||||
with Result do
|
||||
begin
|
||||
Caption:=ACaption;
|
||||
Indent:=AIndent;
|
||||
ImageIndex:=AImageIndex;
|
||||
OverlayImageIndex:=AOverlayImageIndex;
|
||||
SelectedImageIndex:=ASelectedImageIndex;
|
||||
Data:=AData;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TComboExItems.Insert(AIndex: Integer): TComboExItem;
|
||||
begin
|
||||
Result:=Insert(AIndex);
|
||||
end;
|
||||
|
||||
procedure TComboExItems.Notify(Item: TCollectionItem; Action: TCollectionNotification);
|
||||
var i: Integer;
|
||||
begin
|
||||
inherited Notify(Item, Action);
|
||||
case Action of
|
||||
cnAdded:
|
||||
begin
|
||||
FAddingOrDeletingItem:=True;
|
||||
with Owner as TCustomComboBoxEx do
|
||||
begin
|
||||
Items.Add('');
|
||||
if not (csLoading in ComponentState) then
|
||||
TComboExItem(Item).FCaption:=TComboExItem.cDefCaption+inttostr(Item.ID);
|
||||
end;
|
||||
end;
|
||||
cnDeleting:
|
||||
begin
|
||||
FAddingOrDeletingItem:=True;
|
||||
with Owner as TCustomComboBoxEx do
|
||||
begin
|
||||
i:=ItemIndex;
|
||||
Items.Delete(Item.Index);
|
||||
if i<Count then ItemIndex:=i
|
||||
else if i>0 then ItemIndex:=i-1;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TComboExItems.Update(Item: TCollectionItem);
|
||||
var aItemIndex: Integer;
|
||||
begin
|
||||
inherited Update(Item);
|
||||
aItemIndex:=(Owner as TCustomComboBoxEx).ItemIndex;
|
||||
if not assigned(Item) or ((aItemIndex>=0) and
|
||||
(Item=(Owner as TCustomComboBoxEx).ItemsEx[aItemIndex]))
|
||||
then (Owner as TCustomComboBoxEx).Invalidate;
|
||||
FAddingOrDeletingItem:=False;
|
||||
end;
|
||||
|
||||
{ TComboExItems.Getters and Setters }
|
||||
|
||||
function TComboExItems.GetComboItems(AIndex: Integer): TComboExItem;
|
||||
begin
|
||||
Result:=Items[AIndex] as TComboExItem;
|
||||
end;
|
||||
|
||||
{ TCustomComboBoxEx }
|
||||
|
||||
constructor TCustomComboBoxEx.Create(TheOwner: TComponent);
|
||||
begin
|
||||
inherited Create(TheOwner);
|
||||
FAutoCompleteOptions:=cDefAutoCompOpts;
|
||||
FItemsEx:=TComboExItems.Create(self, TComboExItem);
|
||||
FNeedMeasure:=True;
|
||||
ReadOnly:=True;
|
||||
inherited Style:=csOwnerDrawFixed;
|
||||
FStyle:=cDefStyle;
|
||||
FStyleEx:=[];
|
||||
end;
|
||||
|
||||
destructor TCustomComboBoxEx.Destroy;
|
||||
begin
|
||||
FreeAndNil(FItemsEx);
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TCustomComboBoxEx.Add(const ACaption: string; AIndent: SmallInt; AImgIdx: SmallInt;
|
||||
AOverlayImgIdx: SmallInt; ASelectedImgIdx: SmallInt);
|
||||
begin
|
||||
Insert(ItemsEx.Count, ACaption, AIndent, AImgIdx, AOverlayImgIdx, ASelectedImgIdx);
|
||||
end;
|
||||
|
||||
function TCustomComboBoxEx.Add: Integer;
|
||||
begin
|
||||
Result:=ItemsEx.Count;
|
||||
Insert(Result, TComboExItem.cDefCaption);
|
||||
end;
|
||||
|
||||
procedure TCustomComboBoxEx.AddItem(const Item: String; AnObject: TObject);
|
||||
begin
|
||||
Insert(ItemsEx.Count, Item);
|
||||
ItemsEx[ItemsEx.Count].Data:=AnObject;
|
||||
end;
|
||||
|
||||
procedure TCustomComboBoxEx.AssignItemsEx(AItemsEx: TComboExItems);
|
||||
begin
|
||||
ItemsEx.Assign(AItemsEx);
|
||||
end;
|
||||
|
||||
procedure TCustomComboBoxEx.AssignItemsEx(AItems: TStrings);
|
||||
var i: Integer;
|
||||
begin
|
||||
FItemsEx.BeginUpdate;
|
||||
FItemsEx.Clear;
|
||||
for i:=0 to AItems.Count-1 do
|
||||
ItemsEx.Add(AItems[i]);
|
||||
FItemsEx.EndUpdate;
|
||||
end;
|
||||
|
||||
procedure TCustomComboBoxEx.Clear;
|
||||
begin
|
||||
FItemsEx.Clear;
|
||||
end;
|
||||
|
||||
procedure TCustomComboBoxEx.CMBiDiModeChanged(var Message: TLMessage);
|
||||
begin
|
||||
inherited CMBiDiModeChanged(Message);
|
||||
FRightToLeft:=IsRightToLeft;
|
||||
Invalidate;
|
||||
end;
|
||||
|
||||
procedure TCustomComboBoxEx.Delete(AIndex: Integer);
|
||||
begin
|
||||
ItemsEx.Delete(AIndex);
|
||||
end;
|
||||
|
||||
procedure TCustomComboBoxEx.DeleteSelected;
|
||||
begin
|
||||
if ItemIndex>=0 then Delete(ItemIndex);
|
||||
end;
|
||||
|
||||
procedure TCustomComboBoxEx.DrawItem(Index: Integer; ARect: TRect; State: TOwnerDrawState);
|
||||
const caThemes: array [Boolean] of TThemedButton = (tbPushButtonDisabled, tbPushButtonNormal);
|
||||
cItemIndent: SmallInt = 2;
|
||||
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 }
|
||||
aImgPoint: TPoint;
|
||||
aIndent: SmallInt;
|
||||
aItemIndex: SmallInt;
|
||||
aMainItem: Boolean;
|
||||
anyRect: TRect;
|
||||
begin { do not call inherited ! }
|
||||
aDropped:=DroppedDown;
|
||||
aEnabled:=IsEnabled;
|
||||
aMainItem:= (ARect.Left>0);
|
||||
{$IF DEFINED(LCLWin32) or DEFINED(LCLWin64)}
|
||||
aFocusedEditableMainItemNoDD := (Focused and aMainItem and not aDropped);
|
||||
{$ELSE}
|
||||
aFocusedEditableMainItemNoDD := False;
|
||||
{$ENDIF}
|
||||
if aDropped and not aMainItem or aFocusedEditableMainItemNoDD then
|
||||
begin
|
||||
if not (odSelected in State) then Canvas.Brush.Color:=clWindow;
|
||||
Canvas.Brush.Style:=bsSolid;
|
||||
Canvas.FillRect(ARect);
|
||||
end;
|
||||
aDetail:=ThemeServices.GetElementDetails(caThemes[aEnabled]);
|
||||
if FNeedMeasure then
|
||||
begin
|
||||
FTextHeight:=Canvas.TextHeight('ŠjÁÇ');
|
||||
FNeedMeasure := False;
|
||||
end;
|
||||
if not aMainItem
|
||||
then aIndent:=TComboExItem(ItemsEx[Index]).Indent
|
||||
else aIndent:=-1;
|
||||
if aIndent<0 then aIndent:=0;
|
||||
inc(aIndent, cItemIndent);
|
||||
if assigned(Images) then
|
||||
begin
|
||||
aItemIndex:=-1;
|
||||
if (aMainItem or (odSelected in State)) and
|
||||
((ItemsEx[Index].SelectedImageIndex>=0) and (ItemsEx[Index].SelectedImageIndex<Images.Count))
|
||||
then aItemIndex:=ItemsEx[Index].SelectedImageIndex;
|
||||
if aItemIndex<0 then aItemIndex:=ItemsEx[Index].ImageIndex;
|
||||
if aItemIndex>=0 then
|
||||
begin
|
||||
if not FRightToLeft
|
||||
then aImgPoint.X:=ARect.Left+aIndent
|
||||
else aImgPoint.X:=ARect.Right-aIndent-Images.Width;
|
||||
aImgPoint.Y:=(ARect.Bottom+ARect.Top-Images.Height) div 2;
|
||||
ThemeServices.DrawIcon(Canvas, aDetail, aImgPoint, Images, aItemIndex);
|
||||
end;
|
||||
inc(aIndent, Images.Width+2*cItemIndent);
|
||||
end;
|
||||
Canvas.Brush.Style:=bsClear;
|
||||
if (not (odSelected in State) or not aDropped) and not aFocusedEditableMainItemNoDD
|
||||
then Canvas.Font.Color:=clWindowText
|
||||
else Canvas.Font.Color:=clHighlightText;
|
||||
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+aIndent;
|
||||
anyRect.Right:=ARect.Right;
|
||||
end else
|
||||
begin
|
||||
anyRect.Right:=ARect.Right-aIndent;
|
||||
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;
|
||||
ThemeServices.DrawText(Canvas, aDetail, ItemsEx[Index].Caption, anyRect, aFlags, 0);
|
||||
end;
|
||||
|
||||
procedure TCustomComboBoxEx.FontChanged(Sender: TObject);
|
||||
begin
|
||||
FNeedMeasure:=True;
|
||||
inherited FontChanged(Sender);
|
||||
end;
|
||||
|
||||
procedure TCustomComboBoxEx.InitializeWnd;
|
||||
begin
|
||||
inherited InitializeWnd;
|
||||
FRightToLeft:=IsRightToLeft;
|
||||
end;
|
||||
|
||||
procedure TCustomComboBoxEx.Insert(AIndex: Integer; const ACaption: string; AIndent: SmallInt = -1;
|
||||
AImgIdx: SmallInt = -1; AOverlayImgIdx: SmallInt = -1; ASelectedImgIdx: SmallInt = -1);
|
||||
var aItem: TCollectionItem;
|
||||
begin
|
||||
aItem:=ItemsEx.Insert(AIndex);
|
||||
with aItem as TComboExItem do
|
||||
begin
|
||||
Caption:=ACaption;
|
||||
Indent:=AIndent;
|
||||
ImageIndex:=AImgIdx;
|
||||
OverlayImageIndex:=AOverlayImgIdx;
|
||||
SelectedImageIndex:=ASelectedImgIdx;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCustomComboBoxEx.SetItemHeight(const AValue: Integer);
|
||||
begin
|
||||
inherited SetItemHeight(AValue);
|
||||
FNeedMeasure:=True;
|
||||
end;
|
||||
|
||||
{ TCustomComboBoxEx.Setters }
|
||||
|
||||
procedure TCustomComboBoxEx.SetImages(AValue: TCustomImageList);
|
||||
begin
|
||||
if FImages=AValue then exit;
|
||||
FImages:=AValue;
|
||||
Invalidate;
|
||||
end;
|
||||
|
||||
procedure TCustomComboBoxEx.SetStyle(AValue: TComboBoxExStyle);
|
||||
begin
|
||||
if FStyle=AValue then exit;
|
||||
FStyle:=AValue;
|
||||
end;
|
||||
|
||||
procedure TCustomComboBoxEx.SetStyleEx(AValue: TComboBoxExStyles);
|
||||
begin
|
||||
if FStyleEx=AValue then exit;
|
||||
FStyleEx:=AValue;
|
||||
end;
|
||||
|
||||
{ TCustomCheckCombo }
|
||||
|
||||
constructor TCustomCheckCombo.Create(AOwner: TComponent);
|
||||
begin
|
||||
inherited Create(AOwner);
|
||||
TStringList(Items).Duplicates:=dupIgnore;
|
||||
ReadOnly:=True;
|
||||
Style:=csOwnerDrawFixed;
|
||||
FNeedMeasure:=True;
|
||||
FRejectToggleOnSelect:=True;
|
||||
end;
|
||||
|
||||
destructor TCustomCheckCombo.Destroy;
|
||||
begin
|
||||
ClearItemStates;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TCustomCheckCombo.AddItem(const AItem: string; AState: TCheckBoxState; AEnabled: Boolean);
|
||||
var pItemState: PTCheckComboItemState;
|
||||
begin
|
||||
pItemState:=new(PTCheckComboItemState);
|
||||
pItemState^.State:=aState;
|
||||
pItemState^.Enabled:=AEnabled;
|
||||
pItemState^.Data:=nil;
|
||||
inherited AddItem(AItem, TObject(pItemState));
|
||||
end;
|
||||
|
||||
procedure TCustomCheckCombo.AssignItems(AItems: TStrings);
|
||||
begin
|
||||
ClearItemStates;
|
||||
Items.Assign(AItems);
|
||||
InitItemStates;
|
||||
end;
|
||||
|
||||
procedure TCustomCheckCombo.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 TCustomCheckCombo.Clear;
|
||||
begin
|
||||
ClearItemStates;
|
||||
inherited Clear;
|
||||
end;
|
||||
|
||||
procedure TCustomCheckCombo.ClearItemStates;
|
||||
var i: Integer;
|
||||
begin
|
||||
for i:=0 to Items.Count-1 do
|
||||
begin
|
||||
dispose(PTCheckComboItemState(Items.Objects[i]));
|
||||
Items.Objects[i]:=nil;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCustomCheckCombo.CloseUp;
|
||||
begin
|
||||
if FRejectDropDown then
|
||||
begin
|
||||
FRejectDropDown:=False;
|
||||
Update;
|
||||
end else
|
||||
inherited CloseUp;
|
||||
end;
|
||||
|
||||
procedure TCustomCheckCombo.CMBiDiModeChanged(var Message: TLMessage);
|
||||
begin
|
||||
inherited CMBiDiModeChanged(Message);
|
||||
FRightToLeft:=IsRightToLeft;
|
||||
FNeedMeasure:=True;
|
||||
Invalidate;
|
||||
end;
|
||||
|
||||
procedure TCustomCheckCombo.DeleteItem(AIndex: Integer);
|
||||
begin
|
||||
if (AIndex>=0) and (AIndex<Items.Count) then
|
||||
begin
|
||||
dispose(PTCheckComboItemState(Items.Objects[AIndex]));
|
||||
Items.Delete(AIndex);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCustomCheckCombo.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;
|
||||
begin { do not call inherited ! }
|
||||
aDropped:=DroppedDown;
|
||||
if aDropped and FRejectDropDown then
|
||||
begin
|
||||
DroppedDown:=False;
|
||||
exit; { Exit! }
|
||||
end;
|
||||
aEnabled:=IsEnabled;
|
||||
if not (csDesigning in ComponentState) then
|
||||
aEnabled:= (aEnabled and PTCheckComboItemState(Items.Objects[Index])^.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:=PTCheckComboItemState(Items.Objects[Index])^.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 Canvas.Font.Color:=clHighlightText;
|
||||
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;
|
||||
ThemeServices.DrawText(Canvas, aDetail, Items[Index], anyRect, aFlags, 0);
|
||||
end;
|
||||
|
||||
procedure TCustomCheckCombo.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}
|
||||
if not FRejectDropDown then
|
||||
begin
|
||||
inherited DropDown;
|
||||
FRejectToggleOnSelect:=False;
|
||||
end else
|
||||
if ItemEnabled[ItemIndex] then Toggle(ItemIndex);
|
||||
end;
|
||||
|
||||
procedure TCustomCheckCombo.FontChanged(Sender: TObject);
|
||||
begin
|
||||
FNeedMeasure:=True;
|
||||
inherited FontChanged(Sender);
|
||||
end;
|
||||
|
||||
procedure TCustomCheckCombo.InitializeWnd;
|
||||
begin
|
||||
inherited InitializeWnd;
|
||||
FRightToLeft:=IsRightToLeft;
|
||||
end;
|
||||
|
||||
procedure TCustomCheckCombo.InitItemStates;
|
||||
var i: Integer;
|
||||
pItemState: PTCheckComboItemState;
|
||||
begin
|
||||
for i:=0 to Items.Count-1 do
|
||||
begin
|
||||
pItemState:=new(PTCheckComboItemState);
|
||||
pItemState^.Enabled:=True;
|
||||
pItemState^.State:=cbUnchecked;
|
||||
pItemState^.Data:=nil;
|
||||
Items.Objects[i]:=TObject(pItemState);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCustomCheckCombo.KeyDown(var Key: Word; Shift: TShiftState);
|
||||
begin
|
||||
case Key of
|
||||
VK_RETURN:
|
||||
begin
|
||||
if not DroppedDown then
|
||||
begin
|
||||
DroppedDown:=True;
|
||||
Key:=0;
|
||||
end else
|
||||
begin
|
||||
if (ItemIndex>=0) and ItemEnabled[ItemIndex] then
|
||||
begin
|
||||
Toggle(ItemIndex);
|
||||
Key:=0;
|
||||
DroppedDown:=False;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
VK_SPACE:
|
||||
begin
|
||||
if (ItemIndex>=0) and ItemEnabled[ItemIndex] then
|
||||
begin
|
||||
Toggle(ItemIndex);
|
||||
Key:=0;
|
||||
if DroppedDown then DroppedDown:=False;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
inherited KeyDown(Key, Shift);
|
||||
end;
|
||||
|
||||
procedure TCustomCheckCombo.Loaded;
|
||||
begin
|
||||
inherited Loaded;
|
||||
InitItemStates;
|
||||
end;
|
||||
|
||||
procedure TCustomCheckCombo.MouseLeave;
|
||||
begin
|
||||
FCheckHighlight:=False;
|
||||
inherited MouseLeave;
|
||||
end;
|
||||
|
||||
procedure TCustomCheckCombo.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 TCustomCheckCombo.Select;
|
||||
begin
|
||||
inherited Select;
|
||||
{$IF DEFINED(LCLWin32) or DEFINED(LCLWin64)}
|
||||
if DroppedDown then FRejectToggleOnSelect:=True;
|
||||
{$ENDIF}
|
||||
if not FRejectToggleOnSelect then
|
||||
begin
|
||||
if ItemEnabled[ItemIndex] then Toggle(ItemIndex);
|
||||
FRejectToggleOnSelect:=True;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCustomCheckCombo.SetItemHeight(const AValue: Integer);
|
||||
begin
|
||||
inherited SetItemHeight(AValue);
|
||||
FNeedMeasure:=True;
|
||||
end;
|
||||
|
||||
procedure TCustomCheckCombo.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 TCustomCheckCombo.GetChecked(AIndex: Integer): Boolean;
|
||||
begin
|
||||
Result:=(PTCheckComboItemState(Items.Objects[AIndex])^.State=cbChecked);
|
||||
end;
|
||||
|
||||
function TCustomCheckCombo.GetCount: Integer;
|
||||
begin
|
||||
Result:=Items.Count;
|
||||
end;
|
||||
|
||||
function TCustomCheckCombo.GetItemEnabled(AIndex: Integer): Boolean;
|
||||
begin
|
||||
Result:=PTCheckComboItemState(Items.Objects[AIndex])^.Enabled;
|
||||
end;
|
||||
|
||||
function TCustomCheckCombo.GetObject(AIndex: Integer): TObject;
|
||||
begin
|
||||
Result:=PTCheckComboItemState(Items.Objects[AIndex])^.Data;
|
||||
end;
|
||||
|
||||
function TCustomCheckCombo.GetState(AIndex: Integer): TCheckBoxState;
|
||||
begin
|
||||
Result:=PTCheckComboItemState(Items.Objects[AIndex])^.State;
|
||||
end;
|
||||
|
||||
procedure TCustomCheckCombo.SetChecked(AIndex: Integer; AValue: Boolean);
|
||||
begin
|
||||
if AValue=(PTCheckComboItemState(Items.Objects[AIndex])^.State=cbChecked) then exit;
|
||||
if AValue
|
||||
then PTCheckComboItemState(Items.Objects[AIndex])^.State:=cbChecked
|
||||
else PTCheckComboItemState(Items.Objects[AIndex])^.State:=cbUnchecked;
|
||||
if assigned(FOnItemChange) then FOnItemChange(self, AIndex);
|
||||
if AIndex=ItemIndex then Invalidate;
|
||||
end;
|
||||
|
||||
procedure TCustomCheckCombo.SetItemEnabled(AIndex: Integer; AValue: Boolean);
|
||||
begin
|
||||
if PTCheckComboItemState(Items.Objects[AIndex])^.Enabled=AValue then exit;
|
||||
PTCheckComboItemState(Items.Objects[AIndex])^.Enabled:=AValue;
|
||||
if AIndex=ItemIndex then Invalidate;
|
||||
end;
|
||||
|
||||
procedure TCustomCheckCombo.SetObject(AIndex: Integer; AValue: TObject);
|
||||
begin
|
||||
PTCheckComboItemState(Items.Objects[AIndex])^.Data:=AValue;
|
||||
end;
|
||||
|
||||
procedure TCustomCheckCombo.SetState(AIndex: Integer; AValue: TCheckBoxState);
|
||||
begin
|
||||
if PTCheckComboItemState(Items.Objects[AIndex])^.State=AValue then exit;
|
||||
PTCheckComboItemState(Items.Objects[AIndex])^.State:=AValue;
|
||||
if assigned(FOnItemChange) then FOnItemChange(self, AIndex);
|
||||
if AIndex=ItemIndex then Invalidate;
|
||||
end;
|
||||
|
||||
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user