f119696535
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@7959 8e941d3f-bd1b-0410-a28a-d453659cc2b4
2207 lines
61 KiB
ObjectPascal
2207 lines
61 KiB
ObjectPascal
{ Extended checked controls (radiobutton, checkbox, radiogroup, checkgroup)
|
|
|
|
Copyright (C) 2020 Lazarus team
|
|
|
|
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 ExCheckCtrls;
|
|
|
|
{$mode objfpc}{$H+}
|
|
|
|
interface
|
|
|
|
uses
|
|
LCLType, LCLIntf, LCLProc, LMessages,
|
|
Graphics, Classes, SysUtils, Types, Themes, Controls,
|
|
StdCtrls, ExtCtrls, ImgList;
|
|
|
|
type
|
|
TGetImageIndexEvent = procedure (Sender: TObject; AHover, APressed, AEnabled: Boolean;
|
|
AState: TCheckboxState; var AImgIndex: Integer) of object;
|
|
|
|
{ TCustomCheckControlEx }
|
|
|
|
TCustomCheckControlEx = class(TCustomControl)
|
|
private
|
|
type
|
|
TCheckControlKind = (cckCheckbox, cckRadioButton);
|
|
private
|
|
FAlignment: TLeftRight;
|
|
FAllowGrayed: Boolean;
|
|
FThemedBtnSize: TSize;
|
|
FBtnLayout: TTextLayout;
|
|
FDistance: Integer; // between button and caption
|
|
FDrawFocusRect: Boolean;
|
|
FFocusBorder: Integer;
|
|
FGroupLock: Integer;
|
|
FHover: Boolean;
|
|
FImages: TCustomImageList;
|
|
FImagesWidth: Integer;
|
|
FKind: TCheckControlKind;
|
|
FPressed: Boolean;
|
|
FReadOnly: Boolean;
|
|
FState: TCheckBoxState;
|
|
FTextLayout: TTextLayout;
|
|
FThemedCaption: Boolean;
|
|
// FTransparent: Boolean;
|
|
FWordWrap: Boolean;
|
|
FOnChange: TNotifyEvent;
|
|
FOnGetImageIndex: TGetImageIndexEvent;
|
|
function GetCaption: TCaption;
|
|
function GetChecked: Boolean;
|
|
procedure SetAlignment(const AValue: TLeftRight);
|
|
procedure SetBtnLayout(const AValue: TTextLayout);
|
|
procedure SetCaption(const AValue: TCaption);
|
|
procedure SetChecked(const AValue: Boolean);
|
|
procedure SetDrawFocusRect(const AValue: Boolean);
|
|
procedure SetImages(const AValue: TCustomImageList);
|
|
procedure SetImagesWidth(const AValue: Integer);
|
|
procedure SetState(const AValue: TCheckBoxState);
|
|
procedure SetTextLayout(const AValue: TTextLayout);
|
|
procedure SetThemedCaption(const AValue: Boolean);
|
|
//procedure SetTransparent(const AValue: Boolean);
|
|
procedure SetWordWrap(const AValue: Boolean);
|
|
|
|
protected
|
|
procedure AfterSetState; virtual;
|
|
procedure CalculatePreferredSize(var PreferredWidth, PreferredHeight: Integer;
|
|
{%H-}WithThemeSpace: Boolean); override;
|
|
function CanExecUserChange: Boolean; virtual;
|
|
procedure Click; override;
|
|
procedure CMBiDiModeChanged(var {%H-}Message: TLMessage); message CM_BIDIMODECHANGED;
|
|
procedure CreateHandle; override;
|
|
procedure DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy;
|
|
const AXProportion, AYProportion: Double); override;
|
|
procedure DoEnter; override;
|
|
procedure DoExit; override;
|
|
procedure DrawBackground;
|
|
procedure DrawButton(AHovered, APressed, AEnabled: Boolean; AState: TCheckboxState);
|
|
procedure DrawButtonText(AHovered, APressed, AEnabled: Boolean;
|
|
AState: TCheckboxState);
|
|
function GetBtnSize: TSize; virtual;
|
|
function GetDrawTextFlags: Cardinal;
|
|
function GetTextExtent(const ACaption: String): TSize;
|
|
function GetThemedButtonDetails(AHovered, APressed, AEnabled: Boolean;
|
|
AState: TCheckboxState): TThemedElementDetails; virtual; abstract;
|
|
// procedure InitBtnSize(Scaled: Boolean);
|
|
procedure LockGroup;
|
|
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
|
|
procedure KeyUp(var Key: Word; Shift: TShiftState); override;
|
|
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
|
|
procedure MouseEnter; override;
|
|
procedure MouseLeave; override;
|
|
procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
|
|
procedure Paint; override;
|
|
procedure TextChanged; override;
|
|
procedure UnlockGroup;
|
|
procedure UserChange; virtual;
|
|
procedure WMSize(var Message: TLMSize); message LM_SIZE;
|
|
|
|
property Alignment: TLeftRight read FAlignment write SetAlignment default taRightJustify;
|
|
property AllowGrayed: Boolean read FAllowGrayed write FAllowGrayed default False;
|
|
property ButtonLayout: TTextLayout read FBtnLayout write SetBtnLayout default tlCenter;
|
|
property Caption: TCaption read GetCaption write SetCaption;
|
|
property Checked: Boolean read GetChecked write SetChecked default false;
|
|
property DrawFocusRect: Boolean read FDrawFocusRect write SetDrawFocusRect default true;
|
|
property Images: TCustomImageList read FImages write SetImages;
|
|
property ImagesWidth: Integer read FImagesWidth write SetImagesWidth default 0;
|
|
property ReadOnly: Boolean read FReadOnly write FReadOnly default false;
|
|
property State: TCheckBoxState read FState write SetState default cbUnchecked;
|
|
property TextLayout: TTextLayout read FTextLayout write SetTextLayout default tlCenter;
|
|
property ThemedCaption: Boolean read FThemedCaption write SetThemedCaption default true;
|
|
//property Transparent: Boolean read FTransparent write SetTransparent default true;
|
|
property WordWrap: Boolean read FWordWrap write SetWordWrap default false;
|
|
property OnChange: TNotifyEvent read FOnChange write FOnChange;
|
|
property OnGetImageIndex: TGetImageIndexEvent read FOnGetImageIndex write FOnGetImageIndex;
|
|
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
|
|
end;
|
|
|
|
{ TCustomCheckboxEx }
|
|
|
|
TCustomCheckboxEx = class(TCustomCheckControlEx)
|
|
private
|
|
protected
|
|
function GetThemedButtonDetails(AHovered, APressed, AEnabled: Boolean;
|
|
AState: TCheckboxState): TThemedElementDetails; override;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
end;
|
|
|
|
|
|
{ TCheckBoxEx }
|
|
|
|
TCheckBoxEx = class(TCustomCheckBoxEx)
|
|
published
|
|
//property Action;
|
|
property Align;
|
|
property Alignment;
|
|
property AllowGrayed;
|
|
property Anchors;
|
|
property AutoSize default true;
|
|
property BiDiMode;
|
|
property BorderSpacing;
|
|
property ButtonLayout;
|
|
property Caption;
|
|
property Checked;
|
|
property Color;
|
|
property Constraints;
|
|
property Cursor;
|
|
property DoubleBuffered;
|
|
property DragCursor;
|
|
property DragKind;
|
|
property DragMode;
|
|
property DrawFocusRect;
|
|
property Enabled;
|
|
property Font;
|
|
property Height;
|
|
property HelpContext;
|
|
property HelpKeyword;
|
|
property HelpType;
|
|
property Hint;
|
|
property Images;
|
|
property ImagesWidth;
|
|
property Left;
|
|
property Name;
|
|
property ParentBiDiMode;
|
|
property ParentColor;
|
|
property ParentDoubleBuffered;
|
|
property ParentFont;
|
|
property ParentShowHint;
|
|
property ReadOnly;
|
|
property ShowHint;
|
|
property State;
|
|
property TabOrder;
|
|
property TabStop;
|
|
property Tag;
|
|
property TextLayout;
|
|
property ThemedCaption;
|
|
property Top;
|
|
//property Transparent;
|
|
property Visible;
|
|
property Width;
|
|
property WordWrap;
|
|
property OnChange;
|
|
property OnChangeBounds;
|
|
property OnClick;
|
|
property OnContextPopup;
|
|
property OnDragDrop;
|
|
property OnDragOver;
|
|
property OnEditingDone;
|
|
property OnEndDrag;
|
|
property OnEnter;
|
|
property OnExit;
|
|
property OnGetImageIndex;
|
|
property OnKeyDown;
|
|
property OnKeyPress;
|
|
property OnKeyUp;
|
|
property OnMouseDown;
|
|
property OnMouseEnter;
|
|
property OnMouseLeave;
|
|
property OnMouseUp;
|
|
property OnMouseWheel;
|
|
property OnMouseWheelDown;
|
|
property OnMouseWheelUp;
|
|
property OnResize;
|
|
property OnStartDrag;
|
|
property OnUTF8KeyPress;
|
|
end;
|
|
|
|
{ TCustomRadioButtonEx }
|
|
|
|
TCustomRadioButtonEx = class(TCustomCheckControlEx)
|
|
protected
|
|
procedure AfterSetState; override;
|
|
function CanExecUserChange: Boolean; override;
|
|
function GetThemedButtonDetails(AHovered, APressed, AEnabled: Boolean;
|
|
AState: TCheckboxState): TThemedElementDetails; override;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
published
|
|
end;
|
|
|
|
{ TRadioButtonEx }
|
|
|
|
TRadioButtonEx = class(TCustomRadioButtonEx)
|
|
published
|
|
property Align;
|
|
property Alignment;
|
|
property Anchors;
|
|
property AutoSize default true;
|
|
property BiDiMode;
|
|
property BorderSpacing;
|
|
property ButtonLayout;
|
|
property Caption;
|
|
property Checked;
|
|
property Color;
|
|
property Constraints;
|
|
property Cursor;
|
|
property DoubleBuffered;
|
|
property DragCursor;
|
|
property DragKind;
|
|
property DragMode;
|
|
property DrawFocusRect;
|
|
property Enabled;
|
|
property Font;
|
|
property Height;
|
|
property HelpContext;
|
|
property HelpKeyword;
|
|
property HelpType;
|
|
property Hint;
|
|
property Images;
|
|
property ImagesWidth;
|
|
property Left;
|
|
property Name;
|
|
property ParentBiDiMode;
|
|
property ParentColor;
|
|
property ParentDoubleBuffered;
|
|
property ParentFont;
|
|
property ParentShowHint;
|
|
property PopupMenu;
|
|
property ReadOnly;
|
|
property ShowHint;
|
|
property State;
|
|
property TabOrder;
|
|
property TabStop;
|
|
property Tag;
|
|
property TextLayout;
|
|
property ThemedCaption;
|
|
//property Transparent;
|
|
property Visible;
|
|
property WordWrap;
|
|
property Width;
|
|
|
|
property OnChange;
|
|
property OnChangeBounds;
|
|
property OnClick;
|
|
property OnContextPopup;
|
|
property OnDragDrop;
|
|
property OnDragOver;
|
|
property OnEnter;
|
|
property OnExit;
|
|
property OnKeyDown;
|
|
property OnKeyPress;
|
|
property OnKeyUp;
|
|
property OnMouseDown;
|
|
property OnMouseEnter;
|
|
property OnMouseLeave;
|
|
property OnMouseUp;
|
|
property OnMouseWheel;
|
|
property OnMouseWheelDown;
|
|
property OnMouseWheelUp;
|
|
property OnResize;
|
|
property OnStartDrag;
|
|
property OnGetImageIndex;
|
|
end;
|
|
|
|
|
|
{ TCustomCheckControlGroupEx }
|
|
|
|
TCustomCheckControlGroupEx = class(TCustomGroupBox)
|
|
private
|
|
FAutoFill: Boolean;
|
|
FButtonList: TFPList;
|
|
FColumnLayout: TColumnLayout;
|
|
FColumns: integer;
|
|
FImages: TCustomImageList;
|
|
FImagesWidth: Integer;
|
|
FItems: TStrings;
|
|
FIgnoreClicks: boolean;
|
|
FReadOnly: Boolean;
|
|
FUpdatingItems: Boolean;
|
|
FOnClick: TNotifyEvent;
|
|
FOnGetImageIndex: TGetImageIndexEvent;
|
|
FOnItemEnter: TNotifyEvent;
|
|
FOnItemExit: TNotifyEvent;
|
|
FOnSelectionChanged: TNotifyEvent;
|
|
procedure ItemEnter(Sender: TObject); virtual;
|
|
procedure ItemExit(Sender: TObject); virtual;
|
|
procedure ItemKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); virtual;
|
|
procedure ItemKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); virtual;
|
|
procedure ItemKeyPress(Sender: TObject; var Key: Char); virtual;
|
|
procedure ItemUTF8KeyPress(Sender: TObject; var UTF8Key: TUTF8Char); virtual;
|
|
procedure SetAutoFill(const AValue: Boolean);
|
|
procedure SetColumnLayout(const AValue: TColumnLayout);
|
|
procedure SetColumns(const AValue: integer);
|
|
procedure SetImages(const AValue: TCustomImageList);
|
|
procedure SetImagesWidth(const AValue: Integer);
|
|
procedure SetItems(const AValue: TStrings);
|
|
procedure SetOnGetImageIndex(const AValue: TGetImageIndexEvent);
|
|
procedure SetReadOnly(const AValue: Boolean);
|
|
protected
|
|
procedure UpdateAll;
|
|
procedure UpdateControlsPerLine;
|
|
procedure UpdateInternalObjectList;
|
|
procedure UpdateItems; virtual; abstract;
|
|
procedure UpdateTabStops;
|
|
property AutoFill: Boolean read FAutoFill write SetAutoFill default true;
|
|
property ColumnLayout: TColumnLayout read FColumnLayout write SetColumnLayout default clHorizontalThenVertical;
|
|
property Columns: Integer read FColumns write SetColumns default 1;
|
|
property Images: TCustomImageList read FImages write SetImages;
|
|
property ImagesWidth: Integer read FImagesWidth write SetImagesWidth default 0;
|
|
property Items: TStrings read FItems write SetItems;
|
|
property ReadOnly: Boolean read FReadOnly write SetReadOnly default false;
|
|
property OnClick: TNotifyEvent read FOnClick write FOnClick;
|
|
property OnGetImageIndex: TGetImageIndexEvent read FOnGetImageIndex write SetOnGetImageIndex;
|
|
property OnItemEnter: TNotifyEvent read FOnItemEnter write FOnItemEnter;
|
|
property OnItemExit: TNotifyEvent read FOnItemExit write FOnItemExit;
|
|
property OnSelectionChanged: TNotifyEvent read FOnSelectionChanged write FOnSelectionChanged;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
function CanModify: boolean; virtual;
|
|
procedure FlipChildren(AllLevels: Boolean); override;
|
|
function Rows: integer;
|
|
end;
|
|
|
|
{ TCustomRadioGroupEx }
|
|
TCustomRadioGroupEx = class(TCustomCheckControlGroupEx)
|
|
private
|
|
FCreatingWnd: Boolean;
|
|
FHiddenButton: TRadioButtonEx;
|
|
FItemIndex: integer;
|
|
FLastClickedItemIndex: Integer;
|
|
FReading: Boolean;
|
|
procedure Changed(Sender: TObject);
|
|
procedure Clicked(Sender: TObject);
|
|
function GetButtonCount: Integer;
|
|
function GetButtons(AIndex: Integer): TRadioButtonEx;
|
|
procedure SetItemIndex(const AValue: Integer);
|
|
protected
|
|
procedure CheckItemIndexChanged; virtual;
|
|
procedure InitializeWnd; override;
|
|
procedure ItemKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); override;
|
|
procedure ReadState(AReader: TReader); override;
|
|
procedure UpdateItems; override;
|
|
procedure UpdateRadioButtonStates; virtual;
|
|
property ItemIndex: Integer read FItemIndex write SetItemIndex default -1;
|
|
public
|
|
property ButtonCount: Integer read GetButtonCount;
|
|
property Buttons[AIndex: Integer]: TRadioButtonEx read GetButtons;
|
|
published
|
|
constructor Create(AOwner: TComponent); override;
|
|
end;
|
|
|
|
{ TRadioGroupEx }
|
|
TRadioGroupEx = class(TCustomRadioGroupEx)
|
|
published
|
|
property Align;
|
|
property Anchors;
|
|
property AutoFill;
|
|
property AutoSize;
|
|
property BiDiMode;
|
|
property BorderSpacing;
|
|
property Caption;
|
|
property ChildSizing;
|
|
property Color;
|
|
property ColumnLayout;
|
|
property Columns;
|
|
property Constraints;
|
|
property Cursor;
|
|
property DoubleBuffered;
|
|
property DragCursor;
|
|
property DragMode;
|
|
property Enabled;
|
|
property Font;
|
|
property Height;
|
|
property HelpContext;
|
|
property HelpKeyword;
|
|
property HelpType;
|
|
property Hint;
|
|
property Images;
|
|
property ImagesWidth;
|
|
property ItemIndex;
|
|
property Items;
|
|
property Left;
|
|
property Name;
|
|
property ParentBiDiMode;
|
|
property ParentColor;
|
|
property ParentFont;
|
|
property ParentShowHint;
|
|
property PopupMenu;
|
|
property ReadOnly;
|
|
property ShowHint;
|
|
property TabOrder;
|
|
property TabStop;
|
|
property Tag;
|
|
property Top;
|
|
property Visible;
|
|
property Width;
|
|
property OnChangeBounds;
|
|
property OnClick;
|
|
property OnDblClick;
|
|
property OnDragDrop;
|
|
property OnDragOver;
|
|
property OnEndDrag;
|
|
property OnEnter;
|
|
property OnExit;
|
|
property OnGetImageIndex;
|
|
property OnItemEnter;
|
|
property OnItemExit;
|
|
property OnKeyDown;
|
|
property OnKeyPress;
|
|
property OnKeyUp;
|
|
property OnMouseDown;
|
|
property OnMouseEnter;
|
|
property OnMouseLeave;
|
|
property OnMouseUp;
|
|
property OnMouseWheel;
|
|
property OnMouseWheelDown;
|
|
property OnMouseWheelUp;
|
|
property OnResize;
|
|
property OnSelectionChanged;
|
|
property OnStartDrag;
|
|
property OnUTF8KeyPress;
|
|
end;
|
|
|
|
TCustomCheckGroupEx = class(TCustomCheckControlGroupEx)
|
|
private
|
|
FOnItemClick: TCheckGroupClicked;
|
|
procedure Clicked(Sender: TObject);
|
|
procedure DoClick(AIndex: integer);
|
|
function GetButtonCount: Integer;
|
|
function GetButtons(AIndex: Integer): TCheckBoxEx;
|
|
function GetChecked(AIndex: integer): boolean;
|
|
function GetCheckEnabled(AIndex: integer): boolean;
|
|
procedure RaiseIndexOutOfBounds(AIndex: integer);
|
|
procedure SetChecked(AIndex: integer; const AValue: boolean);
|
|
procedure SetCheckEnabled(AIndex: integer; const AValue: boolean);
|
|
protected
|
|
procedure DefineProperties(Filer: TFiler); override;
|
|
procedure Loaded; override;
|
|
procedure ReadData(Stream: TStream);
|
|
procedure UpdateItems; override;
|
|
procedure WriteData(Stream: TStream);
|
|
// procedure DoOnResize; override;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
property ButtonCount: Integer read GetButtonCount;
|
|
property Buttons[AIndex: Integer]: TCheckBoxEx read GetButtons;
|
|
public
|
|
property Checked[Index: integer]: boolean read GetChecked write SetChecked;
|
|
property CheckEnabled[Index: integer]: boolean read GetCheckEnabled write SetCheckEnabled;
|
|
property OnItemClick: TCheckGroupClicked read FOnItemClick write FOnItemClick;
|
|
end;
|
|
|
|
{ TCheckGroupEx }
|
|
|
|
TCheckGroupEx = class(TCustomCheckGroupEx)
|
|
published
|
|
property Align;
|
|
property Anchors;
|
|
property AutoFill;
|
|
property AutoSize;
|
|
property BiDiMode;
|
|
property BorderSpacing;
|
|
property Caption;
|
|
property ChildSizing;
|
|
property ClientHeight;
|
|
property ClientWidth;
|
|
property Color;
|
|
property ColumnLayout;
|
|
property Columns;
|
|
property Constraints;
|
|
property DoubleBuffered;
|
|
property DragCursor;
|
|
property DragMode;
|
|
property Enabled;
|
|
property Font;
|
|
property Images;
|
|
property ImagesWidth;
|
|
property Items;
|
|
property ParentBiDiMode;
|
|
property ParentFont;
|
|
property ParentColor;
|
|
property ParentDoubleBuffered;
|
|
property ParentShowHint;
|
|
property PopupMenu;
|
|
property ReadOnly;
|
|
property ShowHint;
|
|
property TabOrder;
|
|
property TabStop;
|
|
property Visible;
|
|
|
|
property OnChangeBounds;
|
|
property OnClick;
|
|
property OnDblClick;
|
|
property OnDragDrop;
|
|
property OnDragOver;
|
|
property OnEndDrag;
|
|
property OnEnter;
|
|
property OnExit;
|
|
property OnGetImageIndex;
|
|
property OnItemClick;
|
|
property OnItemEnter;
|
|
property OnItemExit;
|
|
property OnKeyDown;
|
|
property OnKeyPress;
|
|
property OnKeyUp;
|
|
property OnMouseDown;
|
|
property OnMouseEnter;
|
|
property OnMouseLeave;
|
|
property OnMouseMove;
|
|
property OnMouseUp;
|
|
property OnMouseWheel;
|
|
property OnMouseWheelDown;
|
|
property OnMouseWheelUp;
|
|
property OnResize;
|
|
property OnStartDrag;
|
|
property OnUTF8KeyPress;
|
|
end;
|
|
|
|
implementation
|
|
|
|
uses
|
|
Math, LCLStrConsts, LResources;
|
|
|
|
const
|
|
cIndent = 5;
|
|
|
|
FIRST_RADIOBUTTON_DETAIL = tbRadioButtonUncheckedNormal;
|
|
FIRST_CHECKBOX_DETAIL = tbCheckBoxUncheckedNormal;
|
|
HOT_OFFSET = 1;
|
|
PRESSED_OFFSET = 2;
|
|
DISABLED_OFFSET = 3;
|
|
CHECKED_OFFSET = 4;
|
|
MIXED_OFFSET = 8;
|
|
|
|
procedure DrawParentImage(Control: TControl; Dest: TCanvas);
|
|
var
|
|
SaveIndex: integer;
|
|
DC: HDC;
|
|
Position: TPoint;
|
|
begin
|
|
with Control do
|
|
begin
|
|
if Parent = nil then Exit;
|
|
DC := Dest.Handle;
|
|
SaveIndex := SaveDC(DC);
|
|
GetViewportOrgEx(DC, @Position);
|
|
SetViewportOrgEx(DC, Position.X - Left, Position.Y - Top, nil);
|
|
IntersectClipRect(DC, 0, 0, Parent.ClientWidth, Parent.ClientHeight);
|
|
Parent.Perform(LM_ERASEBKGND, DC, 0);
|
|
Parent.Perform(LM_PAINT, DC, 0);
|
|
RestoreDC(DC, SaveIndex);
|
|
end;
|
|
end;
|
|
|
|
function ProcessLineBreaks(const AString: string; ToC: Boolean): String;
|
|
var
|
|
idx: Integer;
|
|
|
|
procedure AddChar(ch: Char);
|
|
begin
|
|
Result[idx] := ch;
|
|
inc(idx);
|
|
if idx > Length(Result) then
|
|
SetLength(Result, Length(Result) + 100);
|
|
end;
|
|
|
|
var
|
|
P, PEnd: PChar;
|
|
begin
|
|
if AString = '' then
|
|
begin
|
|
Result := '';
|
|
exit;
|
|
end;
|
|
|
|
SetLength(Result, Length(AString));
|
|
idx := 1;
|
|
P := @AString[1];
|
|
PEnd := P + Length(AString);
|
|
|
|
if ToC then
|
|
// Replace line breaks by '\n'
|
|
while P < PEnd do begin
|
|
if (P^ = #13) then begin
|
|
AddChar('\');
|
|
AddChar('n');
|
|
inc(P);
|
|
if P^ <> #10 then dec(P);
|
|
end else
|
|
if P^ = #10 then
|
|
begin
|
|
AddChar('\');
|
|
AddChar('n');
|
|
end else
|
|
if P^ = '\' then
|
|
begin
|
|
AddChar('\');
|
|
AddChar('\');
|
|
end else
|
|
AddChar(P^);
|
|
inc(P);
|
|
end
|
|
else
|
|
// Replace '\n' by LineEnding
|
|
while (P < PEnd) do
|
|
begin
|
|
if (P^ = '\') and (P < PEnd-1) then
|
|
begin
|
|
inc(P);
|
|
if (P^ = 'n') or (P^ = 'N') then
|
|
AddChar(#10)
|
|
else
|
|
AddChar(P^);
|
|
end else
|
|
AddChar(P^);
|
|
inc(P);
|
|
end;
|
|
SetLength(Result, idx-1);
|
|
end;
|
|
|
|
{ TCheckboxControlEx }
|
|
|
|
constructor TCustomCheckControlEx.Create(AOwner: TComponent);
|
|
begin
|
|
inherited;
|
|
ControlStyle := ControlStyle + [csParentBackground, csReplicatable] - [csOpaque]
|
|
- csMultiClicks - [csClickEvents, csNoStdEvents]; { inherited Click not used }
|
|
|
|
FAlignment := taRightJustify;
|
|
FBtnLayout := tlCenter;
|
|
FDrawFocusRect := true;
|
|
FKind := cckCheckbox;
|
|
FDistance := cIndent;
|
|
FFocusBorder := FDistance div 2;
|
|
FTextLayout := tlCenter;
|
|
FThemedCaption := true;
|
|
// FTransparent := true;
|
|
|
|
AutoSize := true;
|
|
TabStop := true;
|
|
end;
|
|
|
|
// Is called after the State has changed in SetState. Will be overridden by
|
|
// TCustomRadioButtonEx to uncheck all other iteme.s
|
|
procedure TCustomCheckControlEx.AfterSetState;
|
|
begin
|
|
end;
|
|
|
|
procedure TCustomCheckControlEx.CalculatePreferredSize(var PreferredWidth,
|
|
PreferredHeight: Integer; WithThemeSpace: Boolean);
|
|
var
|
|
flags: Cardinal;
|
|
textSize: TSize;
|
|
R: TRect;
|
|
captn: String;
|
|
details: TThemedElementDetails;
|
|
btnSize: TSize;
|
|
begin
|
|
captn := inherited Caption;
|
|
if (captn = '') then
|
|
begin
|
|
btnSize := GetBtnSize;
|
|
PreferredWidth := btnSize.CX;
|
|
PreferredHeight := btnSize.CY;
|
|
exit;
|
|
end;
|
|
|
|
Canvas.Font.Assign(Font);
|
|
|
|
R := ClientRect;
|
|
btnSize := GetBtnSize;
|
|
dec(R.Right, btnSize.CX + FDistance);
|
|
R.Bottom := MaxInt; // Max height possible
|
|
|
|
flags := GetDrawTextFlags + DT_CALCRECT;
|
|
|
|
// rectangle available for text
|
|
if FThemedCaption then
|
|
begin
|
|
details := GetThemedButtonDetails(false, false, true, cbChecked);
|
|
if FWordWrap then
|
|
begin
|
|
with ThemeServices.GetTextExtent(Canvas.Handle, details, captn, flags, @R) do begin
|
|
textSize.CX := Right;
|
|
textSize.CY := Bottom;
|
|
end;
|
|
end else
|
|
with ThemeServices.GetTextExtent(Canvas.Handle, details, captn, flags, nil) do begin
|
|
textSize.CX := Right;
|
|
textSize.CY := Bottom;
|
|
end;
|
|
end else
|
|
begin
|
|
DrawText(Canvas.Handle, PChar(captn), Length(captn), R, flags);
|
|
textSize.CX := R.Right - R.Left;
|
|
textSize.CY := R.Bottom - R.Top;
|
|
end;
|
|
|
|
PreferredWidth := btnSize.CX + FDistance + textSize.CX + FFocusBorder;
|
|
PreferredHeight := Max(btnSize.CY, textSize.CY + 2*FFocusBorder);
|
|
end;
|
|
|
|
// Will be overridden by the radio button to prevent unchecking a checked btn.
|
|
function TCustomCheckControlEx.CanExecUserChange: Boolean;
|
|
begin
|
|
Result := true;
|
|
end;
|
|
|
|
procedure TCustomCheckControlEx.CMBiDiModeChanged(var Message: TLMessage);
|
|
begin
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TCustomCheckControlEx.CreateHandle;
|
|
var
|
|
w, h: Integer;
|
|
begin
|
|
inherited;
|
|
if (Width = 0) or (Height = 0) then begin
|
|
CalculatePreferredSize(w{%H-}, h{%H-}, false);
|
|
if Width <> 0 then w := Width;
|
|
if Height <> 0 then h := Height;
|
|
SetBounds(Left, Top, w, h);
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomCheckControlEx.DoAutoAdjustLayout(
|
|
const AMode: TLayoutAdjustmentPolicy;
|
|
const AXProportion, AYProportion: Double);
|
|
begin
|
|
inherited;
|
|
if AMode in [lapAutoAdjustWithoutHorizontalScrolling, lapAutoAdjustForDPI] then
|
|
begin
|
|
FDistance := Round(cIndent * AXProportion);
|
|
FFocusBorder := FDistance div 2;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomCheckControlEx.Click;
|
|
begin
|
|
if Assigned(OnClick) then
|
|
OnClick(Self);
|
|
|
|
UserChange;
|
|
end;
|
|
|
|
procedure TCustomCheckControlEx.DoEnter;
|
|
begin
|
|
inherited DoEnter;
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TCustomCheckControlEx.DoExit;
|
|
begin
|
|
inherited DoExit;
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TCustomCheckControlEx.DrawBackground;
|
|
var
|
|
R: TRect;
|
|
begin
|
|
R := Rect(0, 0, Width, Height);
|
|
Canvas.Brush.Style := bsSolid;
|
|
Canvas.Brush.Color := Color;
|
|
Canvas.FillRect(R);
|
|
end;
|
|
|
|
procedure TCustomCheckControlEx.DrawButton(AHovered, APressed, AEnabled: Boolean; AState: TCheckboxState);
|
|
var
|
|
btnRect: TRect;
|
|
btnPoint: TPoint = (X:0; Y:0);
|
|
details: TThemedElementDetails;
|
|
imgIndex: Integer;
|
|
imgRes: TScaledImageListResolution;
|
|
btnSize: TSize;
|
|
begin
|
|
// Checkbox/Radiobutton size and position
|
|
btnSize := GetBtnSize;
|
|
case FAlignment of
|
|
taLeftJustify:
|
|
if not IsRightToLeft then btnPoint.X := ClientWidth - btnSize.CX;
|
|
taRightJustify:
|
|
if IsRightToLeft then btnPoint.X := ClientWidth - btnSize.CX;
|
|
end;
|
|
case FBtnLayout of
|
|
tlTop: btnPoint.Y := FFocusBorder;
|
|
tlCenter: btnPoint.Y := (ClientHeight - btnSize.CY) div 2;
|
|
tlBottom: btnPoint.Y := ClientHeight - btnSize.CY - FFocusBorder;
|
|
end;
|
|
btnRect := Rect(0, 0, btnSize.CX, btnSize.CY);
|
|
OffsetRect(btnRect, btnPoint.X, btnPoint.Y);
|
|
|
|
imgIndex := -1;
|
|
if (FImages <> nil) and Assigned(FOnGetImageIndex) then
|
|
FOnGetImageIndex(Self, AHovered, APressed, AEnabled, AState, imgIndex);
|
|
|
|
if imgIndex > -1 then
|
|
begin
|
|
ImgRes := FImages.ResolutionForPPI[FImagesWidth, Font.PixelsPerInch, GetCanvasScaleFactor];
|
|
ImgRes.Draw(Canvas, btnRect.Left, btnRect.Top, imgIndex, AEnabled);
|
|
end else
|
|
begin
|
|
// Drawing style of button
|
|
details := GetThemedButtonDetails(AHovered, APressed, AEnabled, AState);
|
|
// Draw button
|
|
ThemeServices.DrawElement(Canvas.Handle, details, btnRect);
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomCheckControlEx.DrawButtonText(AHovered, APressed, AEnabled: Boolean;
|
|
AState: TCheckboxState);
|
|
var
|
|
R: TRect;
|
|
// textStyle: TTextStyle;
|
|
delta: Integer;
|
|
details: TThemedElementDetails;
|
|
flags: Cardinal;
|
|
textSize: TSize;
|
|
captn: TCaption;
|
|
btnSize: TSize;
|
|
begin
|
|
captn := inherited Caption; // internal string with line breaks
|
|
|
|
if captn = '' then
|
|
exit;
|
|
|
|
// Determine text drawing parameters
|
|
flags := GetDrawTextFlags;
|
|
|
|
btnSize := GetBtnSize;
|
|
delta := btnSize.CX + FDistance;
|
|
R := ClientRect;
|
|
dec(R.Right, delta);
|
|
Canvas.Font.Assign(Font);
|
|
if FThemedCaption then
|
|
begin
|
|
R.Bottom := MaxInt; // max height for word-wrap
|
|
details := GetThemedButtonDetails(AHovered, APressed, AEnabled, AState);
|
|
with ThemeServices.GetTextExtent(Canvas.Handle, details, captn, flags, @R) do begin
|
|
textSize.CX := Right;
|
|
textSize.CY := Bottom;
|
|
end;
|
|
end else
|
|
begin
|
|
if not AEnabled then Canvas.Font.Color := clGrayText;
|
|
DrawText(Canvas.Handle, PChar(captn), Length(captn), R, flags + DT_CALCRECT);
|
|
textSize.CX := R.Right - R.Left;
|
|
textSize.CY := R.Bottom - R.Top;
|
|
end;
|
|
|
|
R := ClientRect;
|
|
|
|
case FTextLayout of
|
|
tlTop:
|
|
R.Top := 0;
|
|
tlCenter:
|
|
R.Top := (R.Top + R.Bottom - textSize.CY) div 2;
|
|
tlBottom:
|
|
R.Top := R.Bottom - textSize.CY;
|
|
end;
|
|
R.Bottom := R.Top + textSize.CY;
|
|
|
|
if (FAlignment = taRightJustify) and IsRightToLeft then
|
|
begin
|
|
dec(R.Right, delta);
|
|
R.Left := R.Right - textSize.CX;
|
|
end else
|
|
begin
|
|
inc(R.Left, delta);
|
|
R.Right := R.Left + textSize.CX;
|
|
end;
|
|
|
|
// Draw text
|
|
if FThemedCaption then
|
|
begin
|
|
ThemeServices.DrawText(Canvas, details, captn, R, flags, 0);
|
|
end else
|
|
begin
|
|
Canvas.Brush.Style := bsClear;
|
|
DrawText(Canvas.Handle, PChar(captn), Length(captn), R, flags);
|
|
end;
|
|
|
|
// Draw focus rect
|
|
if Focused and FDrawFocusRect then begin
|
|
InflateRect(R, FFocusBorder, 0);
|
|
if R.Left + R.Width > ClientWidth then R.Width := ClientWidth - R.Left;
|
|
if R.Left < 0 then R.Left := 0;
|
|
//LCLIntf.SetBkColor(Canvas.Handle, ColorToRGB(clBtnFace));
|
|
Canvas.Font.Color := clBlack;
|
|
LCLIntf.DrawFocusRect(Canvas.Handle, R);
|
|
end;
|
|
end;
|
|
|
|
function TCustomCheckControlEx.GetBtnSize: TSize;
|
|
var
|
|
ImgRes: TScaledImageListResolution;
|
|
begin
|
|
if (FImages <> nil) then begin
|
|
ImgRes := FImages.ResolutionForPPI[FImagesWidth, Font.PixelsPerInch, GetCanvasScaleFactor];
|
|
Result.CX := ImgRes.Width;
|
|
Result.CY := ImgRes.Height;
|
|
end else
|
|
begin
|
|
with ThemeServices do
|
|
if FKind = cckCheckbox then
|
|
Result := GetDetailSize(GetElementDetails(tbCheckBoxCheckedNormal))
|
|
else
|
|
if FKind = cckRadioButton then
|
|
Result := GetDetailSize(GetElementDetails(tbRadioButtonCheckedNormal));
|
|
//Result.CX := Scale96ToFont(Result.CX);
|
|
//Result.CY := Scale96ToFont(Result.CY);
|
|
end;
|
|
end;
|
|
|
|
// Replaces linebreaks in the inherited Caption by '\n' (and '\' by '\\') so
|
|
// that line breaks can be entered at designtime.
|
|
function TCustomCheckControlEx.GetCaption: TCaption;
|
|
const
|
|
TO_C = true;
|
|
begin
|
|
Result := ProcessLineBreaks(inherited Caption, TO_C);
|
|
end;
|
|
|
|
function TCustomCheckControlEx.GetChecked: Boolean;
|
|
begin
|
|
Result := (FState = cbChecked);
|
|
end;
|
|
|
|
// Determine text drawing parameters for the DrawText command
|
|
function TCustomCheckControlEx.GetDrawTextFlags: Cardinal;
|
|
begin
|
|
Result := 0;
|
|
case FTextLayout of
|
|
tlTop: inc(Result, DT_TOP);
|
|
tlCenter: inc(Result, DT_VCENTER);
|
|
tlBottom: inc(Result, DT_BOTTOM);
|
|
end;
|
|
|
|
if (FAlignment = taRightJustify) and IsRightToLeft then
|
|
inc(Result, DT_RIGHT)
|
|
else
|
|
inc(Result, DT_LEFT);
|
|
|
|
if IsRightToLeft then inc(Result, DT_RTLREADING);
|
|
if FWordWrap then inc(Result, DT_WORDBREAK);
|
|
end;
|
|
|
|
function TCustomCheckControlEx.GetTextExtent(const ACaption: String): TSize;
|
|
var
|
|
L: TStrings;
|
|
s: String;
|
|
begin
|
|
Result := Size(0, 0);
|
|
L := TStringList.Create;
|
|
try
|
|
L.Text := ACaption;
|
|
for s in L do
|
|
begin
|
|
Result.CY := Result.CY + Canvas.TextHeight(s);
|
|
Result.CX := Max(Result.CX, Canvas.TextWidth(s));
|
|
end;
|
|
finally
|
|
L.Free;
|
|
end;
|
|
end;
|
|
(*
|
|
procedure TCustomCheckControlEx.InitBtnSize(Scaled: Boolean);
|
|
var
|
|
ImgRes: TScaledImageListResolution;
|
|
begin
|
|
if (FImages <> nil) then begin
|
|
if Scaled then begin
|
|
ImgRes := FImages.ResolutionForPPI[FImagesWidth, Font.PixelsPerInch, GetCanvasScaleFactor];
|
|
FBtnSize.CX := ImgRes.Width;
|
|
FBtnSize.CY := ImgRes.Height;
|
|
end else
|
|
begin
|
|
FBtnSize.CX := FImages.Width;
|
|
FBtnSize.CY := FImages.Height;
|
|
end;
|
|
end else
|
|
begin
|
|
with ThemeServices do
|
|
if FKind = cckCheckbox then
|
|
FBtnSize := GetDetailSize(GetElementDetails(tbCheckBoxCheckedNormal))
|
|
else if FKind = cckRadioButton then
|
|
FBtnSize := GetDetailSize(GetElementDetails(tbRadioButtonCheckedNormal));
|
|
if Scaled then
|
|
begin
|
|
FBtnSize.CX := Scale96ToFont(FBtnSize.CX);
|
|
FBtnSize.CY := Scale96ToFont(FBtnSize.CY);
|
|
end;
|
|
end;
|
|
end;
|
|
*)
|
|
|
|
procedure TCustomCheckControlEx.KeyDown(var Key: Word; Shift: TShiftState);
|
|
begin
|
|
inherited KeyDown(Key, Shift);
|
|
if (Key in [VK_RETURN, VK_SPACE]) and not (ssCtrl in Shift) and (not FReadOnly) then
|
|
begin
|
|
FPressed := True;
|
|
Invalidate;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomCheckControlEx.KeyUp(var Key: Word; Shift: TShiftState);
|
|
begin
|
|
inherited KeyUp(Key, Shift);
|
|
if (Key in [VK_RETURN, VK_SPACE]) and not (ssCtrl in Shift) then
|
|
begin
|
|
FPressed := False;
|
|
UserChange;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomCheckControlEx.LockGroup;
|
|
begin
|
|
inc(FGroupLock);
|
|
end;
|
|
|
|
procedure TCustomCheckControlEx.MouseDown(Button: TMouseButton;
|
|
Shift: TShiftState; X, Y: Integer);
|
|
begin
|
|
inherited MouseDown(Button, Shift, X, Y);
|
|
if (Button = mbLeft) and FHover and not FReadOnly then
|
|
begin
|
|
FPressed := True;
|
|
Invalidate;
|
|
end;
|
|
SetFocus;
|
|
end;
|
|
|
|
procedure TCustomCheckControlEx.MouseEnter;
|
|
begin
|
|
FHover := true;
|
|
Invalidate;
|
|
inherited;
|
|
end;
|
|
|
|
procedure TCustomCheckControlEx.MouseLeave;
|
|
begin
|
|
FHover := false;
|
|
Invalidate;
|
|
inherited;
|
|
end;
|
|
|
|
procedure TCustomCheckControlEx.MouseUp(Button: TMouseButton;
|
|
Shift: TShiftState; X, Y: Integer);
|
|
begin
|
|
inherited MouseUp(Button, Shift, X, Y);
|
|
if Button = mbLeft then begin
|
|
if PtInRect(ClientRect, Point(X, Y)) then Click;
|
|
FPressed := False;
|
|
Invalidate;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomCheckControlEx.Paint;
|
|
begin
|
|
{
|
|
if FTransparent then
|
|
DrawParentImage(Self, Self.Canvas)
|
|
else
|
|
DrawBackground;
|
|
}
|
|
DrawButton(FHover, FPressed, IsEnabled, FState);
|
|
DrawButtonText(FHover, FPressed, IsEnabled, FState);
|
|
end;
|
|
|
|
procedure TCustomCheckControlEx.SetAlignment(const AValue: TLeftRight);
|
|
begin
|
|
if AValue = FAlignment then exit;
|
|
FAlignment := AValue;
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TCustomCheckControlEx.SetBtnLayout(const AValue: TTextLayout);
|
|
begin
|
|
if AValue = FBtnLayout then exit;
|
|
FBtnLayout := AValue;
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TCustomCheckControlEx.SetCaption(const AValue: TCaption);
|
|
const
|
|
FROM_C = false;
|
|
begin
|
|
if AValue = GetCaption then exit;
|
|
inherited Caption := ProcessLineBreaks(AValue, FROM_C);
|
|
end;
|
|
|
|
procedure TCustomCheckControlEx.SetChecked(const AValue: Boolean);
|
|
begin
|
|
if AValue then
|
|
State := cbChecked
|
|
else
|
|
State := cbUnChecked;
|
|
end;
|
|
|
|
procedure TCustomCheckControlEx.SetDrawFocusRect(const AValue: Boolean);
|
|
begin
|
|
if AValue = FDrawFocusRect then exit;
|
|
FDrawFocusRect := AValue;
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TCustomCheckControlEx.SetImages(const AValue: TCustomImageList);
|
|
begin
|
|
if AValue = FImages then exit;
|
|
FImages := AValue;
|
|
// InitBtnSize(true);
|
|
InvalidatePreferredSize;
|
|
AdjustSize;
|
|
end;
|
|
|
|
procedure TCustomCheckControlEx.SetImagesWidth(const AValue: Integer);
|
|
begin
|
|
if AValue = FImagesWidth then exit;
|
|
FImagesWidth := AValue;
|
|
// InitBtnSize(true);
|
|
InvalidatePreferredSize;
|
|
AdjustSize;
|
|
end;
|
|
|
|
procedure TCustomCheckControlEx.SetTextLayout(const AValue: TTextLayout);
|
|
begin
|
|
if AValue = FTextLayout then exit;
|
|
FTextLayout := AValue;
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TCustomCheckControlEx.SetThemedCaption(const AValue: Boolean);
|
|
begin
|
|
if AValue = FThemedCaption then exit;
|
|
FThemedCaption := AValue;
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TCustomCheckControlEx.SetState(const AValue: TCheckboxState);
|
|
begin
|
|
if (FState = AValue) then exit;
|
|
FState := AValue;
|
|
if [csLoading, csDestroying, csDesigning] * ComponentState = [] then begin
|
|
if Assigned(OnEditingDone) then OnEditingDone(self);
|
|
if Assigned(OnChange) then OnChange(self);
|
|
{
|
|
// Execute only when Action.Checked is changed
|
|
if not CheckFromAction then begin
|
|
if Assigned(OnClick) then
|
|
if not (Assigned(Action) and
|
|
CompareMethods(TMethod(Action.OnExecute), TMethod(OnClick)))
|
|
then OnClick(self);
|
|
if (Action is TCustomAction) and
|
|
(TCustomAction(Action).Checked <> (AValue = cbChecked))
|
|
then ActionLink.Execute(self);
|
|
end;
|
|
}
|
|
AfterSetState;
|
|
end;
|
|
Invalidate;
|
|
end;
|
|
{
|
|
procedure TCustomCheckControlEx.SetTransparent(const AValue: Boolean);
|
|
begin
|
|
if AValue = FTransparent then exit;
|
|
FTransparent := AValue;
|
|
Invalidate;
|
|
end;
|
|
}
|
|
|
|
procedure TCustomCheckControlEx.SetWordWrap(const AValue: Boolean);
|
|
begin
|
|
if AValue = FWordWrap then exit;
|
|
FWordWrap := AValue;
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TCustomCheckControlEx.TextChanged;
|
|
begin
|
|
inherited TextChanged;
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TCustomCheckControlEx.UnlockGroup;
|
|
begin
|
|
dec(FGroupLock);
|
|
end;
|
|
|
|
// Executes a change triggered by user interaction (not by code)
|
|
procedure TCustomCheckControlEx.UserChange;
|
|
begin
|
|
if FReadOnly then
|
|
exit;
|
|
|
|
if not CanExecUserChange then
|
|
exit;
|
|
|
|
if AllowGrayed then begin
|
|
case FState of
|
|
cbUnchecked: SetState(cbGrayed);
|
|
cbGrayed: SetState(cbChecked);
|
|
cbChecked: SetState(cbUnchecked);
|
|
end;
|
|
end else
|
|
Checked := not Checked;
|
|
end;
|
|
|
|
procedure TCustomCheckControlEx.WMSize(var Message: TLMSize);
|
|
begin
|
|
inherited WMSize(Message);
|
|
Invalidate;
|
|
end;
|
|
|
|
|
|
{ TCustomRadioButtonEx }
|
|
|
|
constructor TCustomRadioButtonEx.Create(AOwner: TComponent);
|
|
begin
|
|
inherited;
|
|
FKind := cckRadioButton;
|
|
// InitBtnSize(false);
|
|
end;
|
|
|
|
{ Is called by SetState and is supposed to uncheck all other radiobuttons in the
|
|
same group, i.e. having the same parent. Provides a locking mechanism because
|
|
uncheding another radiobutton would trigger AfterSetState again. }
|
|
procedure TCustomRadioButtonEx.AfterSetState;
|
|
var
|
|
i: Integer;
|
|
C: TControl;
|
|
begin
|
|
if (FGroupLock > 0) or (Parent = nil) then
|
|
exit;
|
|
for i := 0 to Parent.ControlCount-1 do
|
|
begin
|
|
C := Parent.Controls[i];
|
|
if (C is TCustomRadioButtonEx) and (C <> self) then
|
|
with TCustomRadioButtonEx(C) do
|
|
begin
|
|
LockGroup;
|
|
try
|
|
State := cbUnChecked;
|
|
finally
|
|
UnlockGroup;
|
|
end;
|
|
end;
|
|
end;
|
|
// Parent.Invalidate;
|
|
end;
|
|
|
|
// Prevents the user from unchecking the btn when the btn is already checked.
|
|
function TCustomRadioButtonEx.CanExecUserChange: Boolean;
|
|
begin
|
|
Result := FState <> cbChecked;
|
|
end;
|
|
|
|
function TCustomRadioButtonEx.GetThemedButtonDetails(
|
|
AHovered, APressed, AEnabled: Boolean; AState: TCheckboxState): TThemedElementDetails;
|
|
var
|
|
offset: Integer = 0;
|
|
tb: TThemedButton;
|
|
begin
|
|
offset := ord(FIRST_RADIOBUTTON_DETAIL);
|
|
if APressed then
|
|
inc(offset, PRESSED_OFFSET)
|
|
else if AHovered then
|
|
inc(offset, HOT_OFFSET);
|
|
if not AEnabled then inc(offset, DISABLED_OFFSET);
|
|
if AState = cbChecked then inc(offset, CHECKED_OFFSET);
|
|
tb := TThemedButton(offset);
|
|
Result := ThemeServices.GetElementDetails(tb);
|
|
end;
|
|
(*
|
|
offset := 0
|
|
const // hovered pressed state
|
|
caEnabledDetails: array [False..True, False..True, cbUnChecked..cbChecked] of TThemedElementDetails =
|
|
(
|
|
(
|
|
(tbRadioButtonUncheckedNormal, tbRadioButtonCheckedNormal),
|
|
(tbRadioButtonUncheckedPressed, tbRadioButtonCheckedPressed)
|
|
),
|
|
(
|
|
(tbRadioButtonUncheckedHot, tbRadioButtonCheckedHot),
|
|
(tbRadioButtonUncheckedPressed, tbRadioButtonCheckedPressed)
|
|
)
|
|
);
|
|
|
|
caDisabledDetails: array [cbUnchecked..cbChecked] of TThemedButton =
|
|
(tbRadioButtonUncheckedDisabled, tbRadioButtonCheckedDisabled);
|
|
begin
|
|
if Enabled then
|
|
Result := caEnabledDetails[AHovered, APressed, AState]
|
|
else
|
|
Result := caDisabledDetails[AState];
|
|
end;
|
|
*)
|
|
|
|
|
|
{==============================================================================}
|
|
{ TCustomCheckboxEx }
|
|
{==============================================================================}
|
|
|
|
constructor TCustomCheckboxEx.Create(AOwner: TComponent);
|
|
begin
|
|
inherited;
|
|
FKind := cckCheckbox;
|
|
// InitBtnSize(false);
|
|
end;
|
|
|
|
function TCustomCheckBoxEx.GetThemedButtonDetails(
|
|
AHovered, APressed, AEnabled: Boolean; AState: TCheckboxState): TThemedElementDetails;
|
|
var
|
|
offset: Integer = 0;
|
|
tb: TThemedButton;
|
|
begin
|
|
offset := ord(FIRST_CHECKBOX_DETAIL);
|
|
if APressed then
|
|
inc(offset, PRESSED_OFFSET)
|
|
else if AHovered then
|
|
inc(offset, HOT_OFFSET);
|
|
if not AEnabled then inc(offset, DISABLED_OFFSET);
|
|
case AState of
|
|
cbChecked: inc(offset, CHECKED_OFFSET);
|
|
cbGrayed: inc(offset, MIXED_OFFSET);
|
|
end;
|
|
tb := TThemedButton(offset);
|
|
Result := ThemeServices.GetElementDetails(tb);
|
|
end;
|
|
(*
|
|
|
|
const // hovered pressed state
|
|
caEnabledDetails: array [False..True, False..True, cbUnchecked..cbGrayed] of TThemedButton =
|
|
(
|
|
(
|
|
(tbCheckBoxUncheckedNormal, tbCheckBoxCheckedNormal, tbCheckBoxMixedNormal),
|
|
(tbCheckBoxUncheckedPressed, tbCheckBoxCheckedPressed, tbCheckBoxMixedPressed)
|
|
),
|
|
(
|
|
(tbCheckBoxUncheckedHot, tbCheckBoxCheckedHot, tbCheckBoxMixedHot),
|
|
(tbCheckBoxUncheckedPressed, tbCheckBoxCheckedPressed, tbCheckBoxMixedPressed)
|
|
)
|
|
);
|
|
|
|
caDisabledDetails: array [cbUnchecked..cbGrayed] of TThemedButton =
|
|
(tbCheckBoxUncheckedDisabled, tbCheckBoxCheckedDisabled, tbCheckBoxMixedDisabled);
|
|
var
|
|
tb: TThemedButton;
|
|
begin
|
|
if Enabled then
|
|
tb := caEnabledDetails[AHovered, APressed, AState]
|
|
else
|
|
tb := caDisabledDetails[AState];
|
|
Result := ThemeServices.GetElementDetails(tb);
|
|
end; *)
|
|
|
|
|
|
{==============================================================================}
|
|
{ TCustomCheckControlGroupEx }
|
|
{==============================================================================}
|
|
constructor TCustomCheckControlGroupEx.Create(AOwner: TComponent);
|
|
begin
|
|
inherited;
|
|
FAutoFill := true;
|
|
FButtonList := TFPList.Create;
|
|
FColumns := 1;
|
|
FColumnLayout := clHorizontalThenVertical;
|
|
ChildSizing.Layout := cclLeftToRightThenTopToBottom;
|
|
ChildSizing.ControlsPerLine := FColumns;
|
|
ChildSizing.ShrinkHorizontal := crsScaleChilds;
|
|
ChildSizing.ShrinkVertical := crsScaleChilds;
|
|
ChildSizing.EnlargeHorizontal := crsHomogenousChildResize;
|
|
ChildSizing.EnlargeVertical := crsHomogenousChildResize;
|
|
ChildSizing.LeftRightSpacing := 6;
|
|
ChildSizing.TopBottomSpacing := 0;
|
|
end;
|
|
|
|
destructor TCustomCheckControlGroupEx.Destroy;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
for i:=0 to FButtonList.Count-1 do
|
|
TCustomCheckControlEx(FButtonList[i]).Free;
|
|
FButtonList.Free;
|
|
FItems.Free;
|
|
inherited;
|
|
end;
|
|
|
|
function TCustomCheckControlGroupEx.CanModify: Boolean;
|
|
begin
|
|
Result := not FReadOnly;
|
|
end;
|
|
|
|
procedure TCustomCheckControlgroupEx.FlipChildren(AllLevels: Boolean);
|
|
begin
|
|
// no flipping
|
|
end;
|
|
|
|
procedure TCustomCheckControlGroupEx.ItemEnter(Sender: TObject);
|
|
begin
|
|
if Assigned(FOnItemEnter) then FOnItemEnter(Sender);
|
|
end;
|
|
|
|
procedure TCustomCheckControlGroupEx.ItemExit(Sender: TObject);
|
|
begin
|
|
if Assigned(FOnItemExit) then FOnItemExit(Sender);
|
|
end;
|
|
|
|
procedure TCustomCheckControlGroupEx.ItemKeyDown(Sender: TObject;
|
|
var Key: Word; Shift: TShiftState);
|
|
begin
|
|
if Key <> 0 then
|
|
KeyDown(Key, Shift);
|
|
end;
|
|
|
|
procedure TCustomCheckControlGroupEx.ItemKeyUp(Sender: TObject; var Key: Word;
|
|
Shift: TShiftState);
|
|
begin
|
|
if Key <> 0 then
|
|
KeyUp(Key, Shift);
|
|
end;
|
|
|
|
procedure TCustomCheckControlGroupEx.ItemKeyPress(Sender: TObject; var Key: Char);
|
|
begin
|
|
if Key <> #0 then
|
|
KeyPress(Key);
|
|
end;
|
|
|
|
procedure TCustomCheckControlGroupEx.ItemUTF8KeyPress(Sender: TObject;
|
|
var UTF8Key: TUTF8Char);
|
|
begin
|
|
UTF8KeyPress(UTF8Key);
|
|
end;
|
|
|
|
function TCustomCheckControlGroupEx.Rows: integer;
|
|
begin
|
|
if FItems.Count > 0 then
|
|
Result := ((FItems.Count-1) div Columns) + 1
|
|
else
|
|
Result := 0;
|
|
end;
|
|
|
|
procedure TCustomCheckControlGroupEx.SetAutoFill(const AValue: Boolean);
|
|
begin
|
|
if FAutoFill = AValue then exit;
|
|
FAutoFill := AValue;
|
|
DisableAlign;
|
|
try
|
|
if FAutoFill then begin
|
|
ChildSizing.EnlargeHorizontal := crsHomogenousChildResize;
|
|
ChildSizing.EnlargeVertical := crsHomogenousChildResize;
|
|
end else begin
|
|
ChildSizing.EnlargeHorizontal := crsAnchorAligning;
|
|
ChildSizing.EnlargeVertical := crsAnchorAligning;
|
|
end;
|
|
finally
|
|
EnableAlign;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomCheckControlGroupEx.SetColumnLayout(const AValue: TColumnLayout);
|
|
begin
|
|
if FColumnLayout = AValue then exit;
|
|
FColumnLayout := AValue;
|
|
if FColumnLayout = clHorizontalThenVertical then
|
|
ChildSizing.Layout := cclLeftToRightThenTopToBottom
|
|
else
|
|
ChildSizing.Layout := cclTopToBottomThenLeftToRight;
|
|
UpdateControlsPerLine;
|
|
end;
|
|
|
|
procedure TCustomCheckControlGroupEx.SetColumns(const AValue: integer);
|
|
begin
|
|
if AValue <> FColumns then begin
|
|
if (AValue < 1) then
|
|
raise Exception.Create('TCustomRadioGroup: Columns must be >= 1');
|
|
FColumns := AValue;
|
|
UpdateControlsPerLine;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomCheckControlGroupEx.SetOnGetImageIndex(const AValue: TGetImageIndexEvent);
|
|
var
|
|
i: Integer;
|
|
begin
|
|
FOnGetImageIndex := AValue;
|
|
for i := 0 to FButtonList.Count - 1 do
|
|
TCustomCheckControlEx(FButtonList[i]).OnGetImageIndex := AValue;
|
|
end;
|
|
|
|
procedure TCustomCheckControlGroupEx.SetImages(const AValue: TCustomImagelist);
|
|
var
|
|
i: Integer;
|
|
begin
|
|
if AValue = FImages then exit;
|
|
FImages := AValue;
|
|
for i:=0 to FButtonList.Count-1 do
|
|
TCustomCheckControlEx(FButtonList[i]).Images := FImages;
|
|
end;
|
|
|
|
procedure TCustomCheckControlGroupEx.SetImagesWidth(const AValue: Integer);
|
|
var
|
|
i: Integer;
|
|
begin
|
|
if AValue = FImagesWidth then exit;
|
|
FImagesWidth := AValue;
|
|
for i := 0 to FButtonList.Count - 1 do
|
|
TCustomCheckControlEx(FButtonList[i]).ImagesWidth := FImagesWidth;
|
|
end;
|
|
|
|
procedure TCustomCheckControlGroupEx.SetItems(const AValue: TStrings);
|
|
begin
|
|
if (AValue <> FItems) then
|
|
begin
|
|
FItems.Assign(AValue);
|
|
UpdateItems;
|
|
UpdateControlsPerLine;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomCheckControlGroupEx.SetReadOnly(const AValue: Boolean);
|
|
var
|
|
i: Integer;
|
|
begin
|
|
if AValue = FReadOnly then exit;
|
|
FReadOnly := AValue;
|
|
for i := 0 to FButtonList.Count -1 do
|
|
TCustomCheckControlEx(FButtonList[i]).ReadOnly := FReadOnly;
|
|
end;
|
|
|
|
procedure TCustomCheckControlGroupEx.UpdateAll;
|
|
begin
|
|
UpdateItems;
|
|
UpdateControlsPerLine;
|
|
OwnerFormDesignerModified(Self);
|
|
end;
|
|
|
|
procedure TCustomCheckControlGroupEx.UpdateControlsPerLine;
|
|
var
|
|
newControlsPerLine: LongInt;
|
|
begin
|
|
if ChildSizing.Layout = cclLeftToRightThenTopToBottom then
|
|
newControlsPerLine := Max(1, FColumns)
|
|
else
|
|
newControlsPerLine := Max(1, Rows);
|
|
ChildSizing.ControlsPerLine := NewControlsPerLine;
|
|
end;
|
|
|
|
procedure TCustomCheckControlGroupEx.UpdateInternalObjectList;
|
|
begin
|
|
UpdateItems;
|
|
end;
|
|
|
|
procedure TCustomCheckControlGroupEx.UpdateTabStops;
|
|
var
|
|
i: Integer;
|
|
btn: TCustomCheckControlEx;
|
|
begin
|
|
for i := 0 to FButtonList.Count - 1 do
|
|
begin
|
|
btn := TCustomCheckControlEx(FButtonList[i]);
|
|
btn.TabStop := btn.Checked;
|
|
end;
|
|
end;
|
|
|
|
{==============================================================================}
|
|
{ TRadioGroupExStringList }
|
|
{==============================================================================}
|
|
|
|
type
|
|
TRadioGroupExStringList = class(TStringList)
|
|
private
|
|
FRadioGroup: TCustomRadioGroupEx;
|
|
protected
|
|
procedure Changed; override;
|
|
public
|
|
constructor Create(ARadioGroup: TCustomRadioGroupEx);
|
|
procedure Assign(Source: TPersistent); override;
|
|
end;
|
|
|
|
constructor TRadioGroupExStringList.Create(ARadioGroup: TCustomRadioGroupEx);
|
|
begin
|
|
inherited Create;
|
|
FRadioGroup := ARadioGroup;
|
|
end;
|
|
|
|
procedure TRadioGroupExStringList.Assign(Source: TPersistent);
|
|
var
|
|
savedIndex: Integer;
|
|
begin
|
|
savedIndex := FRadioGroup.ItemIndex;
|
|
inherited Assign(Source);
|
|
if savedIndex < Count then FRadioGroup.ItemIndex := savedIndex;
|
|
end;
|
|
|
|
procedure TRadioGroupExStringList.Changed;
|
|
begin
|
|
inherited Changed;
|
|
if (UpdateCount = 0) then
|
|
FRadioGroup.UpdateAll
|
|
else
|
|
FRadioGroup.UpdateInternalObjectList;
|
|
FRadioGroup.FLastClickedItemIndex := FRadioGroup.FItemIndex;
|
|
end;
|
|
|
|
|
|
{==============================================================================}
|
|
{ TCustomRadioGroupEx }
|
|
{==============================================================================}
|
|
|
|
constructor TCustomRadioGroupEx.Create(AOwner: TComponent);
|
|
begin
|
|
inherited;
|
|
FItems := TRadioGroupExStringList.Create(Self);
|
|
FItemIndex := -1;
|
|
FLastClickedItemIndex := -1;
|
|
end;
|
|
|
|
procedure TCustomRadioGroupEx.Changed(Sender: TObject);
|
|
begin
|
|
CheckItemIndexChanged;
|
|
end;
|
|
|
|
procedure TCustomRadioGroupEx.CheckItemIndexChanged;
|
|
begin
|
|
if FCreatingWnd or FUpdatingItems then
|
|
exit;
|
|
if [csLoading,csDestroying]*ComponentState<>[] then exit;
|
|
UpdateRadioButtonStates;
|
|
if [csDesigning]*ComponentState<>[] then exit;
|
|
if FLastClickedItemIndex=FItemIndex then exit;
|
|
FLastClickedItemIndex:=FItemIndex;
|
|
EditingDone;
|
|
// for Delphi compatibility: OnClick should be invoked, whenever ItemIndex
|
|
// has changed
|
|
if Assigned (FOnClick) then FOnClick(Self);
|
|
// And a better named LCL equivalent
|
|
if Assigned (FOnSelectionChanged) then FOnSelectionChanged(Self);
|
|
end;
|
|
|
|
procedure TCustomRadioGroupEx.Clicked(Sender: TObject);
|
|
begin
|
|
if FIgnoreClicks then exit;
|
|
CheckItemIndexChanged;
|
|
end;
|
|
|
|
function TCustomRadioGroupEx.GetButtonCount: Integer;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
Result := 0;
|
|
for i := 0 to ControlCount-1 do
|
|
if (Controls[i] is TCustomRadioButtonEx) and (Controls[i] <> FHiddenButton) then
|
|
inc(Result);
|
|
end;
|
|
|
|
function TCustomRadioGroupEx.GetButtons(AIndex: Integer): TRadioButtonEx;
|
|
begin
|
|
Result := Controls[AIndex] as TRadioButtonEx;
|
|
end;
|
|
|
|
procedure TCustomRadioGroupEx.InitializeWnd;
|
|
|
|
procedure RealizeItemIndex;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
if (FItemIndex <> -1) and (FItemIndex<FButtonList.Count) then
|
|
TRadioButtonEx(FButtonList[FItemIndex]).Checked := true
|
|
else if FHiddenButton<>nil then
|
|
FHiddenButton.Checked := true;
|
|
for i:=0 to FItems.Count-1 do begin
|
|
TRadioButtonEx(FButtonList[i]).Checked := (FItemIndex = i);
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
if FCreatingWnd then RaiseGDBException('TCustomRadioGroup.InitializeWnd');
|
|
FCreatingWnd := true;
|
|
UpdateItems;
|
|
inherited InitializeWnd;
|
|
RealizeItemIndex;
|
|
//debugln(['TCustomRadioGroup.InitializeWnd END']);
|
|
FCreatingWnd := false;
|
|
end;
|
|
|
|
procedure TCustomRadioGroupEx.ItemKeyDown(Sender: TObject; var Key: Word;
|
|
Shift: TShiftState);
|
|
|
|
procedure MoveSelection(HorzDiff, VertDiff: integer);
|
|
var
|
|
Count: integer;
|
|
StepSize: integer;
|
|
BlockSize : integer;
|
|
NewIndex : integer;
|
|
WrapOffset: integer;
|
|
begin
|
|
if FReadOnly then
|
|
exit;
|
|
|
|
Count := FButtonList.Count;
|
|
if FColumnLayout = clHorizontalThenVertical then begin
|
|
//add a row for ease wrapping
|
|
BlockSize := Columns * (Rows+1);
|
|
StepSize := HorzDiff + VertDiff * Columns;
|
|
WrapOffSet := VertDiff;
|
|
end
|
|
else begin
|
|
//add a column for ease wrapping
|
|
BlockSize := (Columns+1) * Rows;
|
|
StepSize := HorzDiff * Rows + VertDiff;
|
|
WrapOffSet := HorzDiff;
|
|
end;
|
|
NewIndex := ItemIndex;
|
|
repeat
|
|
Inc(NewIndex, StepSize);
|
|
if (NewIndex >= Count) or (NewIndex < 0) then begin
|
|
NewIndex := (NewIndex + WrapOffSet + BlockSize) mod BlockSize;
|
|
// Keep moving in the same direction until in valid range
|
|
while NewIndex >= Count do
|
|
NewIndex := (NewIndex + StepSize) mod BlockSize;
|
|
end;
|
|
until (NewIndex = ItemIndex) or TCustomCheckControlEx(FButtonList[NewIndex]).Enabled;
|
|
ItemIndex := NewIndex;
|
|
TCustomCheckControlEx(FButtonList[ItemIndex]).SetFocus;
|
|
Key := 0;
|
|
end;
|
|
|
|
begin
|
|
if Shift=[] then begin
|
|
case Key of
|
|
VK_LEFT: MoveSelection(-1,0);
|
|
VK_RIGHT: MoveSelection(1,0);
|
|
VK_UP: MoveSelection(0,-1);
|
|
VK_DOWN: MoveSelection(0,1);
|
|
end;
|
|
end;
|
|
if Key <> 0 then
|
|
KeyDown(Key, Shift);
|
|
end;
|
|
|
|
procedure TCustomRadioGroupEx.ReadState(AReader: TReader);
|
|
begin
|
|
FReading := True;
|
|
inherited ReadState(AReader);
|
|
FReading := False;
|
|
if (FItemIndex < -1) or (FItemIndex >= FItems.Count) then
|
|
FItemIndex := -1;
|
|
FLastClickedItemIndex := FItemIndex;
|
|
end;
|
|
|
|
procedure TCustomRadioGroupEx.SetItemIndex(const AValue: integer);
|
|
var
|
|
oldItemIndex: LongInt;
|
|
oldIgnoreClicks: Boolean;
|
|
begin
|
|
if (AValue = FItemIndex) or FReadOnly then exit;
|
|
|
|
// needed later if handle isn't allocated
|
|
oldItemIndex := FItemIndex;
|
|
|
|
if FReading then
|
|
FItemIndex := AValue
|
|
else begin
|
|
if (AValue < -1) or (AValue >= FItems.Count) then
|
|
raise Exception.CreateFmt(rsIndexOutOfBounds, [ClassName, AValue, FItems.Count-1]);
|
|
|
|
if HandleAllocated then
|
|
begin
|
|
// the radiobuttons are grouped by the widget interface
|
|
// and some does not allow to uncheck all buttons in a group
|
|
// Therefore there is a hidden button
|
|
FItemIndex := AValue;
|
|
oldIgnoreClicks := FIgnoreClicks;
|
|
FIgnoreClicks := true;
|
|
try
|
|
if (FItemIndex <> -1) then
|
|
TCustomCheckControlEx(FButtonList[FItemIndex]).Checked := true
|
|
else
|
|
FHiddenButton.Checked := true;
|
|
// uncheck old radiobutton
|
|
if (OldItemIndex <> -1) then begin
|
|
if (OldItemIndex >= 0) and (OldItemIndex < FButtonList.Count) then
|
|
TCustomCheckControlEx(FButtonList[OldItemIndex]).Checked := false
|
|
end else
|
|
FHiddenButton.Checked := false;
|
|
finally
|
|
FIgnoreClicks := OldIgnoreClicks;
|
|
end;
|
|
// this has automatically unset the old button. But they do not recognize
|
|
// it. Update the states.
|
|
CheckItemIndexChanged;
|
|
UpdateTabStops;
|
|
OwnerFormDesignerModified(Self);
|
|
end else
|
|
begin
|
|
FItemIndex := AValue;
|
|
|
|
// maybe handle was recreated. issue #26714
|
|
FLastClickedItemIndex := -1;
|
|
|
|
// trigger event to be delphi compat, even if handle isn't allocated.
|
|
// issue #15989
|
|
if (AValue <> oldItemIndex) and not FCreatingWnd then
|
|
begin
|
|
if Assigned(FOnClick) then FOnClick(Self);
|
|
if Assigned(FOnSelectionChanged) then FOnSelectionChanged(Self);
|
|
FLastClickedItemIndex := FItemIndex;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomRadioGroupEx.UpdateItems;
|
|
var
|
|
i: integer;
|
|
button: TCustomCheckControlEx;
|
|
begin
|
|
if FUpdatingItems then exit;
|
|
FUpdatingItems := true;
|
|
try
|
|
// destroy radiobuttons, if there are too many
|
|
while FButtonList.Count > FItems.Count do
|
|
begin
|
|
TObject(FButtonList[FButtonList.Count-1]).Free;
|
|
FButtonList.Delete(FButtonList.Count-1);
|
|
end;
|
|
|
|
// create as many TRadioButtons as needed
|
|
while (FButtonList.Count < FItems.Count) do
|
|
begin
|
|
button := TRadioButtonEx.Create(Self);
|
|
with TCustomCheckControlEx(button) do
|
|
begin
|
|
Name := 'RadioButtonEx' + IntToStr(FButtonList.Count);
|
|
OnClick := @Self.Clicked;
|
|
OnChange := @Self.Changed;
|
|
OnEnter := @Self.ItemEnter;
|
|
OnExit := @Self.ItemExit;
|
|
OnKeyDown := @Self.ItemKeyDown;
|
|
OnKeyUp := @Self.ItemKeyUp;
|
|
OnKeyPress := @Self.ItemKeyPress;
|
|
OnUTF8KeyPress := @Self.ItemUTF8KeyPress;
|
|
ParentFont := True;
|
|
ReadOnly := Self.ReadOnly;
|
|
BorderSpacing.CellAlignHorizontal := ccaLeftTop;
|
|
BorderSpacing.CellAlignVertical := ccaCenter;
|
|
ControlStyle := ControlStyle + [csNoDesignSelectable];
|
|
end;
|
|
FButtonList.Add(button);
|
|
end;
|
|
if FHiddenButton = nil then begin
|
|
FHiddenButton := TRadioButtonEx.Create(nil);
|
|
with FHiddenButton do
|
|
begin
|
|
Name := 'HiddenRadioButton';
|
|
Visible := False;
|
|
ControlStyle := ControlStyle + [csNoDesignSelectable, csNoDesignVisible];
|
|
end;
|
|
end;
|
|
|
|
if (FItemIndex >= FItems.Count) and not (csLoading in ComponentState) then
|
|
FItemIndex := FItems.Count-1;
|
|
|
|
if FItems.Count > 0 then
|
|
begin
|
|
// to reduce overhead do it in several steps
|
|
|
|
// assign Caption and then Parent
|
|
for i:=0 to FItems.Count-1 do
|
|
begin
|
|
button := TCustomCheckControlEx(FButtonList[i]);
|
|
button.Caption := FItems[i];
|
|
button.Parent := Self;
|
|
end;
|
|
FHiddenButton.Parent := Self;
|
|
|
|
// the checked and unchecked states can be applied only after all other
|
|
for i := 0 to FItems.Count-1 do
|
|
begin
|
|
button := TCustomCheckControlEx(FButtonList[i]);
|
|
button.Checked := (i = FItemIndex);
|
|
button.Visible := true;
|
|
end;
|
|
|
|
//FHiddenButton must remain the last item in Controls[], so that Controls[] is in sync with Items[]
|
|
Self.RemoveControl(FHiddenButton);
|
|
Self.InsertControl(FHiddenButton);
|
|
if HandleAllocated then
|
|
FHiddenButton.HandleNeeded;
|
|
FHiddenButton.Checked := (FItemIndex = -1);
|
|
UpdateTabStops;
|
|
end;
|
|
finally
|
|
FUpdatingItems := false;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomRadioGroupEx.UpdateRadioButtonStates;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
if FReadOnly then
|
|
exit;
|
|
|
|
FItemIndex := -1;
|
|
FHiddenButton.Checked;
|
|
for i:=0 to FButtonList.Count-1 do
|
|
if TCustomRadioButtonEx(FButtonList[i]).Checked then FItemIndex := i;
|
|
UpdateTabStops;
|
|
end;
|
|
|
|
|
|
{==============================================================================}
|
|
{ TCheckGroupExStringList }
|
|
{==============================================================================}
|
|
|
|
type
|
|
TCheckGroupExStringList = class(TStringList)
|
|
private
|
|
FCheckGroup: TCustomCheckGroupEx;
|
|
procedure RestoreCheckStates(const AStates: TByteDynArray);
|
|
procedure SaveCheckStates(out AStates: TByteDynArray);
|
|
protected
|
|
procedure Changed; override;
|
|
public
|
|
constructor Create(ACheckGroup: TCustomCheckGroupEx);
|
|
procedure Delete(AIndex: Integer); override;
|
|
end;
|
|
|
|
|
|
constructor TCheckGroupExStringList.Create(ACheckGroup: TCustomCheckGroupEx);
|
|
begin
|
|
inherited Create;
|
|
FCheckGroup := ACheckGroup;
|
|
end;
|
|
|
|
procedure TCheckGroupExStringList.Changed;
|
|
begin
|
|
inherited Changed;
|
|
if UpdateCount = 0 then
|
|
FCheckGroup.UpdateAll
|
|
else
|
|
FCheckGroup.UpdateInternalObjectList;
|
|
end;
|
|
|
|
procedure TCheckGroupExStringList.Delete(AIndex: Integer);
|
|
// Deleting destroys the checked state of the items -> we must save and restore it
|
|
// Issue https://bugs.freepascal.org/view.php?id=34327.
|
|
var
|
|
b: TByteDynArray;
|
|
i: Integer;
|
|
begin
|
|
SaveCheckStates(b);
|
|
|
|
inherited Delete(AIndex);
|
|
|
|
for i:= AIndex to High(b)-1 do b[i] := b[i+1];
|
|
SetLength(b, Length(b)-1);
|
|
RestoreCheckStates(b);
|
|
end;
|
|
|
|
procedure TCheckGroupExStringList.RestoreCheckStates(const AStates: TByteDynArray);
|
|
var
|
|
i: Integer;
|
|
begin
|
|
Assert(Length(AStates) = FCheckGroup.Items.Count);
|
|
for i:=0 to FCheckgroup.Items.Count-1 do begin
|
|
FCheckGroup.Checked[i] := AStates[i] and 1 <> 0;
|
|
FCheckGroup.CheckEnabled[i] := AStates[i] and 2 <> 0;
|
|
end;
|
|
end;
|
|
|
|
procedure TCheckGroupExStringList.SaveCheckStates(out AStates: TByteDynArray);
|
|
var
|
|
i: Integer;
|
|
begin
|
|
SetLength(AStates, FCheckgroup.Items.Count);
|
|
for i:=0 to FCheckgroup.Items.Count-1 do begin
|
|
AStates[i] := 0;
|
|
if FCheckGroup.Checked[i] then inc(AStates[i]);
|
|
if FCheckGroup.CheckEnabled[i] then inc(AStates[i], 2);
|
|
end;
|
|
end;
|
|
|
|
|
|
{==============================================================================}
|
|
{ TCustomCheckGroupEx }
|
|
{==============================================================================}
|
|
|
|
constructor TCustomCheckGroupEx.Create(AOwner: TComponent);
|
|
begin
|
|
inherited;
|
|
FItems := TCheckGroupExStringList.Create(Self);
|
|
end;
|
|
|
|
procedure TCustomCheckGroupEx.Clicked(Sender: TObject);
|
|
var
|
|
index: Integer;
|
|
begin
|
|
index := FButtonList.IndexOf(Sender);
|
|
if index < 0 then exit;
|
|
DoClick(index);
|
|
end;
|
|
|
|
procedure TCustomCheckGroupEx.DefineProperties(Filer: TFiler);
|
|
begin
|
|
inherited DefineProperties(Filer);
|
|
Filer.DefineBinaryProperty('Data', @ReadData, @WriteData, FItems.Count > 0);
|
|
end;
|
|
|
|
procedure TCustomCheckGroupEx.DoClick(AIndex: integer);
|
|
begin
|
|
if [csLoading,csDestroying, csDesigning] * ComponentState <> [] then exit;
|
|
EditingDone;
|
|
if Assigned(FOnItemClick) then FOnItemClick(Self, AIndex);
|
|
end;
|
|
|
|
function TCustomCheckGroupEx.GetButtonCount: Integer;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
Result := 0;
|
|
for i := 0 to ControlCount-1 do
|
|
if (Controls[i] is TCustomCheckBoxEx) then
|
|
inc(Result);
|
|
end;
|
|
|
|
function TCustomCheckGroupEx.GetButtons(AIndex: Integer): TCheckBoxEx;
|
|
begin
|
|
Result := Controls[AIndex] as TCheckBoxEx;
|
|
end;
|
|
|
|
function TCustomCheckGroupEx.GetChecked(AIndex: Integer): Boolean;
|
|
begin
|
|
if (AIndex < -1) or (AIndex >= FItems.Count) then
|
|
RaiseIndexOutOfBounds(AIndex);
|
|
Result := TCustomCheckControlEx(FButtonList[AIndex]).Checked;
|
|
end;
|
|
|
|
function TCustomCheckGroupEx.GetCheckEnabled(AIndex: integer): boolean;
|
|
begin
|
|
if (AIndex < -1) or (AIndex >= FItems.Count) then
|
|
RaiseIndexOutOfBounds(AIndex);
|
|
Result := TCustomCheckControlEx(FButtonList[AIndex]).Enabled;
|
|
end;
|
|
|
|
procedure TCustomCheckGroupEx.Loaded;
|
|
begin
|
|
inherited Loaded;
|
|
UpdateItems;
|
|
end;
|
|
|
|
procedure TCustomCheckGroupEx.RaiseIndexOutOfBounds(AIndex: integer);
|
|
begin
|
|
raise Exception.CreateFmt(rsIndexOutOfBounds, [ClassName, AIndex, FItems.Count - 1]);
|
|
end;
|
|
|
|
procedure TCustomCheckGroupEx.ReadData(Stream: TStream);
|
|
var
|
|
ChecksCount: integer;
|
|
Checks: string;
|
|
i: Integer;
|
|
v: Integer;
|
|
begin
|
|
ChecksCount := ReadLRSInteger(Stream);
|
|
if ChecksCount > 0 then begin
|
|
SetLength(Checks, ChecksCount);
|
|
Stream.ReadBuffer(Checks[1], ChecksCount);
|
|
for i:=0 to ChecksCount-1 do begin
|
|
v := ord(Checks[i+1]);
|
|
Checked[i] := ((v and 1) > 0);
|
|
CheckEnabled[i] := ((v and 2) > 0);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomCheckGroupEx.SetChecked(AIndex: integer; const AValue: boolean);
|
|
begin
|
|
if (AIndex < -1) or (AIndex >= FItems.Count) then
|
|
RaiseIndexOutOfBounds(AIndex);
|
|
// disable OnClick
|
|
TCheckBox(FButtonList[AIndex]).OnClick := nil;
|
|
// set value
|
|
TCheckBox(FButtonList[AIndex]).Checked := AValue;
|
|
// enable OnClick
|
|
TCheckBox(FButtonList[AIndex]).OnClick := @Clicked;
|
|
end;
|
|
|
|
procedure TCustomCheckGroupEx.SetCheckEnabled(AIndex: integer;
|
|
const AValue: boolean);
|
|
begin
|
|
if (AIndex < -1) or (AIndex >= FItems.Count) then
|
|
RaiseIndexOutOfBounds(AIndex);
|
|
TCustomCheckControlEx(FButtonList[AIndex]).Enabled := AValue;
|
|
end;
|
|
|
|
procedure TCustomCheckGroupEx.UpdateItems;
|
|
var
|
|
i: integer;
|
|
btn: TCustomCheckControlEx;
|
|
begin
|
|
if FUpdatingItems then exit;
|
|
FUpdatingItems := true;
|
|
try
|
|
// destroy checkboxes, if there are too many
|
|
while FButtonList.Count > FItems.Count do begin
|
|
TObject(FButtonList[FButtonList.Count-1]).Free;
|
|
FButtonList.Delete(FButtonList.Count-1);
|
|
end;
|
|
|
|
// create as many TCheckBoxes as needed
|
|
while (FButtonList.Count < FItems.Count) do begin
|
|
btn := TCheckBoxEx.Create(Self);
|
|
with TCheckBoxEx(btn) do begin
|
|
Name := 'CheckBoxEx' + IntToStr(FButtonList.Count);
|
|
OnClick := @Self.Clicked;
|
|
OnKeyDown := @Self.ItemKeyDown;
|
|
OnKeyUp := @Self.ItemKeyUp;
|
|
OnKeyPress := @Self.ItemKeyPress;
|
|
OnUTF8KeyPress := @Self.ItemUTF8KeyPress;
|
|
AutoSize := False;
|
|
Parent := Self;
|
|
ParentFont := true;
|
|
ReadOnly := Self.ReadOnly;
|
|
BorderSpacing.CellAlignHorizontal := ccaLeftTop;
|
|
BorderSpacing.CellAlignVertical := ccaCenter;
|
|
ControlStyle := ControlStyle + [csNoDesignSelectable];
|
|
end;
|
|
FButtonList.Add(btn);
|
|
end;
|
|
|
|
for i:=0 to FItems.Count-1 do begin
|
|
btn := TCustomCheckControlEx(FButtonList[i]);
|
|
btn.Caption := FItems[i];
|
|
end;
|
|
finally
|
|
FUpdatingItems := false;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomCheckGroupEx.WriteData(Stream: TStream);
|
|
var
|
|
ChecksCount: integer;
|
|
Checks: string;
|
|
i: Integer;
|
|
v: Integer;
|
|
begin
|
|
ChecksCount := FItems.Count;
|
|
WriteLRSInteger(Stream, ChecksCount);
|
|
if ChecksCount > 0 then begin
|
|
SetLength(Checks, ChecksCount);
|
|
for i := 0 to ChecksCount-1 do begin
|
|
v := 0;
|
|
if Checked[i] then inc(v, 1);
|
|
if CheckEnabled[i] then inc(v, 2);
|
|
Checks[i+1] := chr(v);
|
|
end;
|
|
Stream.WriteBuffer(Checks[1], ChecksCount);
|
|
end;
|
|
end;
|
|
|
|
end.
|
|
|