98884e4cad
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8117 8e941d3f-bd1b-0410-a28a-d453659cc2b4
1037 lines
29 KiB
ObjectPascal
1037 lines
29 KiB
ObjectPascal
{ TColumnCombo is a text-only combobox that displays its dropdown items list in
|
|
single phrase columns, which are parsed according to the (Char) Delimiter
|
|
property.
|
|
Column width in the dropdown is adjusted automatically to accomomodate the
|
|
longest word/phrase in each column.
|
|
The number of columns shown depends entirely on the number of delimiters found
|
|
in each listed item, hence is an unpublished read-only property.
|
|
The default delimiter is the comma.
|
|
There is a display property -- commented out -- ShowColSeparators (False by
|
|
default) which displays vertical lines between the listed columns. It seems ugly to me,
|
|
so I disabled it, but you can re-enable it if you want.
|
|
The ColumnMargin property allows for adjustment of all column widths by a fixed amount.
|
|
|
|
H Page-Clark 2013
|
|
|
|
|
|
License:
|
|
|
|
This library is free software; you can redistribute it and/or modify it
|
|
under the same terms as the Lazarus Component Library (LCL)
|
|
|
|
See the file COPYING.modifiedLGPL.txt, included in the Lazarus distribution,
|
|
for details about the license.
|
|
}
|
|
|
|
unit ExCombo;
|
|
|
|
{$mode objfpc}{$H+}
|
|
|
|
interface
|
|
|
|
uses
|
|
LCLIntf, LCLType, LMessages, LazLoggerBase,
|
|
Classes, SysUtils, Graphics, Types,
|
|
StdCtrls, Controls, Forms;
|
|
|
|
type
|
|
|
|
TColumnComboBoxEx = class(TCustomComboBox)
|
|
private
|
|
FColumnCount: Integer;
|
|
FColumnMargin: Integer;
|
|
FDelimiter: AnsiChar;
|
|
FOffsets: TIntegerDynArray;
|
|
FParser: TStringList;
|
|
FColSeparatorColor: TColor;
|
|
FShowColSeparators: Boolean;
|
|
FSelectedColor: TColor;
|
|
FSelectedTextColor: TColor;
|
|
FTextHeight: Integer;
|
|
function ColumnMarginStored: Boolean;
|
|
function GetTextSize(const aText: String): TSize;
|
|
function GetColumnCount: Integer;
|
|
function GetDelimiteds(const aLine: String): TStringArray;
|
|
procedure SetColSeparatorColor(AValue: TColor);
|
|
procedure SetColumnMargin(aValue: Integer);
|
|
procedure SetDelimiter(aValue: AnsiChar);
|
|
procedure SetOffsets;
|
|
procedure SetShowColSeparators(aValue: Boolean);
|
|
procedure SetSelectedColor(AValue: TColor);
|
|
procedure SetSelectedTextColor(AValue: TColor);
|
|
protected
|
|
procedure CreateHandle; override;
|
|
procedure DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy;
|
|
const AXProportion, AYProportion: Double); override;
|
|
procedure DrawItem(Index: Integer; ARect: TRect; State: TOwnerDrawState); override;
|
|
class function GetControlClassDefaultSize: TSize; override;
|
|
procedure GetItems; override;
|
|
procedure InitializeWnd; override;
|
|
procedure FontChanged(Sender: TObject); override;
|
|
procedure SetItems(const Value: TStrings); override;
|
|
procedure SetStyle(AValue: TComboBoxStyle); override;
|
|
public
|
|
constructor Create(TheOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
property ColumnCount: Integer read FColumnCount;
|
|
published
|
|
// new properties
|
|
property ColumnMargin: Integer read FColumnMargin write SetColumnMargin stored ColumnMarginStored;
|
|
property ColSeparatorColor: TColor read FColSeparatorColor write SetColSeparatorColor default clSilver;
|
|
property Delimiter: AnsiChar read FDelimiter write SetDelimiter default ',';
|
|
property SelectedColor: TColor read FSelectedColor write SetSelectedColor default clHighlight;
|
|
property SelectedTextColor: TColor read FSelectedTextColor write SetSelectedTextColor default clHighlightText;
|
|
property ShowColSeparators: Boolean read FShowColSeparators write SetShowColSeparators default False;
|
|
// inherited comboBox properties
|
|
property Align;
|
|
property Anchors;
|
|
property ArrowKeysTraverseList;
|
|
property AutoComplete;
|
|
property AutoCompleteText;
|
|
property AutoDropDown;
|
|
property AutoSelect;
|
|
property AutoSize;
|
|
property BidiMode;
|
|
property BorderSpacing;
|
|
property BorderStyle;
|
|
property CharCase;
|
|
property Color default clWindow;
|
|
property Constraints;
|
|
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 OnDrawItem;
|
|
property OnEndDrag;
|
|
property OnDropDown;
|
|
property OnEditingDone;
|
|
property OnEnter;
|
|
property OnExit;
|
|
property OnGetItems;
|
|
property OnKeyDown;
|
|
property OnKeyPress;
|
|
property OnKeyUp;
|
|
property OnMeasureItem;
|
|
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 Style default csOwnerDrawFixed;
|
|
property TabOrder;
|
|
property TabStop;
|
|
property Text;
|
|
property Visible;
|
|
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
|
|
GraphUtil, Themes;
|
|
|
|
const
|
|
DEFAULT_COLUMN_MARGIN = 4;
|
|
|
|
{ TColumnCombo }
|
|
|
|
constructor TColumnComboBoxEx.Create(TheOwner: TComponent);
|
|
begin
|
|
inherited Create(TheOwner);
|
|
Color := clWindow;
|
|
|
|
FParser := TStringList.Create;
|
|
FColumnMargin := DEFAULT_COLUMN_MARGIN;
|
|
FColumnCount := 0;
|
|
FColSeparatorColor := clSilver;
|
|
FDelimiter := ',';
|
|
FShowColSeparators := False;
|
|
FSelectedColor := clHighlight;
|
|
FSelectedTextColor := clHighlightText;
|
|
SetStyle(csOwnerDrawFixed);
|
|
FOffsets := nil;
|
|
FColumnCount := 0;
|
|
end;
|
|
|
|
destructor TColumnComboBoxEx.Destroy;
|
|
begin
|
|
FParser.Free;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TColumnComboBoxEx.ColumnMarginStored: Boolean;
|
|
begin
|
|
Result := FColumnMargin <> Scale96ToFont(DEFAULT_COLUMN_MARGIN);
|
|
end;
|
|
|
|
procedure TColumnComboBoxEx.CreateHandle;
|
|
begin
|
|
inherited;
|
|
SetOffsets;
|
|
end;
|
|
|
|
procedure TColumnComboBoxEx.DoAutoAdjustLayout(
|
|
const AMode: TLayoutAdjustmentPolicy; const AXProportion, AYProportion: Double
|
|
);
|
|
begin
|
|
inherited DoAutoAdjustLayout(AMode, AXProportion, AYProportion);
|
|
|
|
if AMode in [lapAutoAdjustWithoutHorizontalScrolling, lapAutoAdjustForDPI] then
|
|
begin
|
|
if ColumnMarginStored then
|
|
FColumnMargin := Round(FColumnMargin * AXProportion);
|
|
Invalidate;
|
|
end;
|
|
end;
|
|
|
|
procedure TColumnComboBoxEx.DrawItem(Index: Integer; ARect: TRect; State: TOwnerDrawState);
|
|
var
|
|
i, y, xl: Integer;
|
|
txt: String;
|
|
savedColor, savedFontColor: TColor;
|
|
begin
|
|
if Assigned(OnDrawItem) then
|
|
begin
|
|
OnDrawItem(Self, Index, ARect, State);
|
|
exit;
|
|
end;
|
|
|
|
savedColor := Canvas.Brush.Color;
|
|
savedFontColor := Canvas.Font.Color;
|
|
|
|
if DroppedDown then
|
|
begin
|
|
if (odSelected in State) then
|
|
begin
|
|
Canvas.Brush.Color := FSelectedColor;
|
|
Canvas.Font.Color := FSelectedTextColor;
|
|
end else
|
|
if (Canvas.Brush.Color <> Color) then
|
|
Canvas.Brush.Color := Color;
|
|
Canvas.Brush.Style := bsSolid;
|
|
Canvas.FillRect(ARect);
|
|
end else
|
|
Canvas.Font.Color := clWindowText;
|
|
|
|
if Index < 0 then
|
|
txt := ''
|
|
else
|
|
txt := Items[Index];
|
|
|
|
FParser.StrictDelimiter := FDelimiter <> ' ';
|
|
FParser.Delimiter := FDelimiter;
|
|
FParser.DelimitedText := txt;
|
|
|
|
y := ARect.Top + (ARect.Height - FTextHeight) shr 1;
|
|
Canvas.Brush.Style := bsClear; // transparent text background
|
|
if Assigned(FOffsets) then
|
|
begin
|
|
for i := 0 to FParser.Count-1 do
|
|
begin
|
|
xl := ARect.Left + FOffsets[i];
|
|
Canvas.TextOut(xl, y, FParser[i]);
|
|
end;
|
|
if FShowColSeparators then
|
|
begin
|
|
Canvas.Pen.Color := FColSeparatorColor;
|
|
for i := 1 to High(FOffsets) do
|
|
begin
|
|
xl := FOffsets[i];
|
|
Dec(xl, FColumnMargin);
|
|
Canvas.Line(xl, ARect.Top, xl, ARect.Bottom);
|
|
end;
|
|
end;
|
|
end
|
|
else
|
|
Canvas.TextOut(xl, y, txt);
|
|
|
|
Canvas.Brush.Color := savedColor;
|
|
Canvas.Font.Color := savedFontColor;
|
|
end;
|
|
|
|
|
|
procedure TColumnComboBoxEx.FontChanged(Sender: TObject);
|
|
begin
|
|
inherited FontChanged(Sender);
|
|
FTextHeight := Canvas.TextHeight('ŢÜ');
|
|
end;
|
|
|
|
function TColumnComboBoxEx.GetColumnCount: Integer;
|
|
var
|
|
i, tmp: Integer;
|
|
s: String;
|
|
|
|
function GetDelimCount: Integer;
|
|
var
|
|
p: Integer;
|
|
begin
|
|
Result := 0;
|
|
for p := 1 to Length(s) do
|
|
if s[p] = FDelimiter then
|
|
Inc(Result);
|
|
end;
|
|
|
|
begin
|
|
Result := 0;
|
|
for i := 0 to Items.Count-1 do
|
|
begin
|
|
s := Items[i];
|
|
tmp := GetDelimCount;
|
|
if Result < tmp then
|
|
Result := tmp;
|
|
end;
|
|
Inc(Result);
|
|
end;
|
|
|
|
class function TColumnComboBoxEx.GetControlClassDefaultSize: TSize;
|
|
begin
|
|
Result := inherited GetControlClassDefaultSize;
|
|
Result.cx := 200;
|
|
end;
|
|
|
|
function TColumnComboBoxEx.GetDelimiteds(const aLine: String): TStringArray;
|
|
var
|
|
p, start, resultIdx: Integer;
|
|
begin
|
|
Result := Nil;
|
|
SetLength(Result, FColumnCount);
|
|
start := 1;
|
|
resultIdx := 0;
|
|
for p := 1 to Length(aLine) do
|
|
begin
|
|
case (aLine[p] = FDelimiter) of
|
|
True: begin
|
|
Result[resultIdx] := Copy(aLine, start, p - start);
|
|
start := Succ(p);
|
|
Inc(resultIdx);
|
|
end;
|
|
False: ;
|
|
end;
|
|
end;
|
|
Result[resultIdx] := Copy(aLine, start, Length(aLine));
|
|
end;
|
|
|
|
procedure TColumnComboBoxEx.GetItems;
|
|
begin
|
|
inherited GetItems;
|
|
// SetOffsets;
|
|
end;
|
|
|
|
function TColumnComboBoxEx.GetTextSize(const aText: String): TSize;
|
|
var
|
|
drawFlags: LongWord = DT_CALCRECT or DT_NOPREFIX or DT_SINGLELINE;
|
|
r: TRect;
|
|
dc: HDC;
|
|
begin
|
|
r.Left := 0;
|
|
r.Top := 0;
|
|
dc := GetDC(GetParentForm(Self).Handle);
|
|
try
|
|
r.Right := 1000;
|
|
r.Bottom := 100;
|
|
DrawText(dc, PChar(aText), Length(aText), r, drawFlags);
|
|
if r.Right = 1000 then
|
|
r.Right := 0;
|
|
if r.Bottom = 100 then
|
|
r.Bottom := 0;
|
|
Result.Create(r.Width, r.Height);
|
|
finally
|
|
ReleaseDC(Parent.Handle, dc);
|
|
end;
|
|
end;
|
|
|
|
procedure TColumnComboBoxEx.InitializeWnd;
|
|
begin
|
|
inherited;
|
|
SetOffsets;
|
|
end;
|
|
|
|
procedure TColumnComboBoxEx.SetColSeparatorColor(AValue: TColor);
|
|
begin
|
|
if FColSeparatorColor <> AValue then
|
|
begin
|
|
FColSeparatorColor := AValue;
|
|
Invalidate;
|
|
end;
|
|
end;
|
|
|
|
procedure TColumnComboBoxEx.SetColumnMargin(aValue: Integer);
|
|
begin
|
|
if FColumnMargin <> aValue then
|
|
begin
|
|
FColumnMargin := aValue;
|
|
Invalidate;
|
|
end;
|
|
end;
|
|
|
|
procedure TColumnComboBoxEx.SetDelimiter(aValue: AnsiChar);
|
|
begin
|
|
if FDelimiter <> aValue then
|
|
begin
|
|
FDelimiter := aValue;
|
|
FColumnCount := GetColumnCount;
|
|
end;
|
|
end;
|
|
|
|
procedure TColumnComboBoxEx.SetItems(const Value: TStrings);
|
|
begin
|
|
inherited SetItems(Value);
|
|
SetOffsets;
|
|
end;
|
|
|
|
procedure TColumnComboBoxEx.SetOffsets;
|
|
var
|
|
widths: TIntegerDynArray;
|
|
i, j: Integer;
|
|
sa: TStringArray;
|
|
sz: TSize;
|
|
begin
|
|
if not Assigned(Parent) or (Items.Count = 0) then
|
|
Exit;
|
|
|
|
FColumnCount := GetColumnCount;
|
|
|
|
SetLength({%H-}widths, FColumnCount);
|
|
for i := 0 to Items.Count-1 do
|
|
begin
|
|
sa := GetDelimiteds(Items[i]);
|
|
FTextHeight := GetTextSize('ŢÜ').cy;
|
|
for j := 0 to High(sa) do
|
|
begin
|
|
sz := GetTextSize(sa[j]);
|
|
if widths[j] < sz.cx then
|
|
widths[j] := sz.cx;
|
|
end;
|
|
end;
|
|
SetLength(FOffsets, FColumnCount);
|
|
for j := 0 to High(FOffsets) do
|
|
case j of
|
|
0: FOffsets[j] := FColumnMargin;
|
|
else
|
|
FOffsets[j] := FOffsets[Pred(j)] + widths[Pred(j)] + FColumnMargin shl 1;
|
|
end;
|
|
end;
|
|
|
|
procedure TColumnComboBoxEx.SetSelectedColor(AValue: TColor);
|
|
begin
|
|
if FSelectedColor <> AValue then
|
|
begin
|
|
FSelectedColor := AValue;
|
|
Invalidate;
|
|
end;
|
|
end;
|
|
|
|
procedure TColumnComboBoxEx.SetSelectedTextColor(AValue: TColor);
|
|
begin
|
|
if FSelectedTextColor <> AValue then
|
|
begin
|
|
FSelectedTextColor := AValue;
|
|
Invalidate;
|
|
end;
|
|
end;
|
|
|
|
procedure TColumnComboBoxEx.SetShowColSeparators(aValue: Boolean);
|
|
begin
|
|
if FShowColSeparators <> aValue then
|
|
begin
|
|
FShowColSeparators := aValue;
|
|
Invalidate;
|
|
end;
|
|
end;
|
|
|
|
procedure TColumnComboBoxEx.SetStyle(AValue: TComboBoxStyle);
|
|
begin
|
|
if (AValue in [csSimple, csDropDown, csDropDownList]) then
|
|
raise Exception.Create('Only owner-draw styles allowed.');
|
|
|
|
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.
|
|
|