From 98884e4cad18ec84493e86038f352a283d04f4ae Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Mon, 11 Oct 2021 20:33:15 +0000 Subject: [PATCH] ExCtrls: Temporarily add LCL's TCheckComboBox as TCheckCombobBoxEx git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8117 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- components/exctrls/source/excombo.pas | 563 ++++++++++++++++++++++- components/exctrls/source/exctrlsreg.pas | 2 +- 2 files changed, 563 insertions(+), 2 deletions(-) diff --git a/components/exctrls/source/excombo.pas b/components/exctrls/source/excombo.pas index 50c350455..f8f928e2b 100644 --- a/components/exctrls/source/excombo.pas +++ b/components/exctrls/source/excombo.pas @@ -30,6 +30,7 @@ unit ExCombo; interface uses + LCLIntf, LCLType, LMessages, LazLoggerBase, Classes, SysUtils, Graphics, Types, StdCtrls, Controls, Forms; @@ -149,10 +150,152 @@ 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 - LCLType, LCLIntf; + GraphUtil, Themes; const DEFAULT_COLUMN_MARGIN = 4; @@ -471,5 +614,423 @@ 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 (AIndex0) 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 (XFCheckHighlight 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. diff --git a/components/exctrls/source/exctrlsreg.pas b/components/exctrls/source/exctrlsreg.pas index 2dba6b81d..c3c0ec69d 100644 --- a/components/exctrls/source/exctrlsreg.pas +++ b/components/exctrls/source/exctrlsreg.pas @@ -21,7 +21,7 @@ begin RegisterComponents('ExCtrls', [ TButtonEx, TCheckboxEx, TRadioButtonEx, TCheckGroupEx, TRadioGroupEx, TFloatSISpinEditEx, TCurrSpinEditEx, - TColumnComboBoxEx + TColumnComboBoxEx, TCheckComboBoxEx ]); end;