4466 lines
124 KiB
ObjectPascal
4466 lines
124 KiB
ObjectPascal
{ rxctrls unit
|
|
|
|
Copyright (C) 2005-2017 Lagunov Aleksey alexs75@yandex.ru and Lazarus team
|
|
original conception from rx library for Delphi (c)
|
|
|
|
This library is free software; you can redistribute it and/or modify it
|
|
under the terms of the GNU Library General Public License as published by
|
|
the Free Software Foundation; either version 2 of the License, or (at your
|
|
option) any later version with the following modification:
|
|
|
|
As a special exception, the copyright holders of this library give you
|
|
permission to link this library with independent modules to produce an
|
|
executable, regardless of the license terms of these independent modules,and
|
|
to copy and distribute the resulting executable under terms of your choice,
|
|
provided that you also meet, for each linked independent module, the terms
|
|
and conditions of the license of that module. An independent module is a
|
|
module which is not derived from or based on this library. If you modify
|
|
this library, you may extend this exception to your version of the library,
|
|
but you are not obligated to do so. If you do not wish to do so, delete this
|
|
exception statement from your version.
|
|
|
|
This program is distributed in the hope that it will be useful, but WITHOUT
|
|
ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
|
|
FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License
|
|
for more details.
|
|
|
|
You should have received a copy of the GNU Library General Public License
|
|
along with this library; if not, write to the Free Software Foundation,
|
|
Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
|
|
}
|
|
|
|
unit rxctrls;
|
|
|
|
{$I rx.inc}
|
|
|
|
interface
|
|
|
|
uses LResources, LCLType, LCLIntf, LMessages, Classes, Controls, Graphics,
|
|
StdCtrls, ExtCtrls, Forms, Buttons, Menus, RxConst, IniFiles, GraphType
|
|
{, Placemnt};
|
|
|
|
type
|
|
TPositiveInt = 1..MaxInt;
|
|
|
|
(*
|
|
{ TTextListBox }
|
|
|
|
TTextListBox = class(TCustomListBox)
|
|
private
|
|
FMaxWidth: Integer;
|
|
{$IFNDEF WIN32}
|
|
FTabWidth: Integer;
|
|
procedure SetTabWidth(Value: Integer);
|
|
{$ENDIF}
|
|
procedure ResetHorizontalExtent;
|
|
procedure SetHorizontalExtent;
|
|
function GetItemWidth(Index: Integer): Integer;
|
|
protected
|
|
{$IFNDEF WIN32}
|
|
procedure CreateParams(var Params: TCreateParams); override;
|
|
procedure CreateWnd; override;
|
|
{$ENDIF}
|
|
procedure WndProc(var Message: TMessage); override;
|
|
published
|
|
property Align;
|
|
property BorderStyle;
|
|
property Color;
|
|
property DragCursor;
|
|
property DragMode;
|
|
property Enabled;
|
|
property ExtendedSelect;
|
|
property Font;
|
|
property IntegralHeight;
|
|
{$IFDEF RX_D4}
|
|
property Anchors;
|
|
property BiDiMode;
|
|
property Constraints;
|
|
property DragKind;
|
|
property ParentBiDiMode;
|
|
{$ENDIF}
|
|
{$IFDEF WIN32}
|
|
{$IFNDEF VER90}
|
|
property ImeMode;
|
|
property ImeName;
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
property ItemHeight;
|
|
property Items;
|
|
property MultiSelect;
|
|
property ParentColor;
|
|
property ParentFont;
|
|
property ParentShowHint;
|
|
property PopupMenu;
|
|
property ShowHint;
|
|
property Sorted;
|
|
property TabOrder;
|
|
property TabStop;
|
|
{$IFDEF WIN32}
|
|
property TabWidth;
|
|
{$ELSE}
|
|
property TabWidth: Integer read FTabWidth write SetTabWidth default 0;
|
|
{$ENDIF}
|
|
property Visible;
|
|
property OnClick;
|
|
property OnDblClick;
|
|
property OnDragDrop;
|
|
property OnDragOver;
|
|
property OnEndDrag;
|
|
property OnEnter;
|
|
property OnExit;
|
|
property OnKeyDown;
|
|
property OnKeyPress;
|
|
property OnKeyUp;
|
|
property OnMouseDown;
|
|
property OnMouseMove;
|
|
property OnMouseUp;
|
|
{$IFDEF WIN32}
|
|
property OnStartDrag;
|
|
{$ENDIF}
|
|
{$IFDEF RX_D5}
|
|
property OnContextPopup;
|
|
{$ENDIF}
|
|
{$IFDEF RX_D4}
|
|
property OnMouseWheelDown;
|
|
property OnMouseWheelUp;
|
|
property OnEndDock;
|
|
property OnStartDock;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
{ TRxCustomListBox }
|
|
|
|
TGetItemWidthEvent = procedure(Control: TWinControl; Index: Integer;
|
|
var Width: Integer) of object;
|
|
|
|
TRxCustomListBox = class(TWinControl)
|
|
private
|
|
FItems: TStrings;
|
|
FBorderStyle: TBorderStyle;
|
|
FCanvas: TCanvas;
|
|
FColumns: Integer;
|
|
FItemHeight: Integer;
|
|
FStyle: TListBoxStyle;
|
|
FIntegralHeight: Boolean;
|
|
FMultiSelect: Boolean;
|
|
FSorted: Boolean;
|
|
FExtendedSelect: Boolean;
|
|
FTabWidth: Integer;
|
|
FSaveItems: TStringList;
|
|
FSaveTopIndex: Integer;
|
|
FSaveItemIndex: Integer;
|
|
FAutoScroll: Boolean;
|
|
FGraySelection: Boolean;
|
|
FMaxItemWidth: Integer;
|
|
FOnDrawItem: TDrawItemEvent;
|
|
FOnMeasureItem: TMeasureItemEvent;
|
|
FOnGetItemWidth: TGetItemWidthEvent;
|
|
procedure ResetHorizontalExtent;
|
|
procedure SetHorizontalExtent;
|
|
function GetAutoScroll: Boolean;
|
|
function GetItemHeight: Integer; virtual;
|
|
function GetItemIndex: Integer;
|
|
function GetSelCount: Integer;
|
|
function GetSelected(Index: Integer): Boolean;
|
|
function GetTopIndex: Integer;
|
|
procedure SetAutoScroll(Value: Boolean);
|
|
procedure SetBorderStyle(Value: TBorderStyle);
|
|
procedure SetColumnWidth;
|
|
procedure SetColumns(Value: Integer);
|
|
procedure SetExtendedSelect(Value: Boolean);
|
|
procedure SetIntegralHeight(Value: Boolean);
|
|
procedure SetItemHeight(Value: Integer);
|
|
procedure SetItemIndex(Value: Integer);
|
|
procedure SetMultiSelect(Value: Boolean);
|
|
procedure SetSelected(Index: Integer; Value: Boolean);
|
|
procedure SetSorted(Value: Boolean);
|
|
procedure SetStyle(Value: TListBoxStyle);
|
|
procedure SetTabWidth(Value: Integer);
|
|
procedure SetTopIndex(Value: Integer);
|
|
procedure SetGraySelection(Value: Boolean);
|
|
procedure SetOnDrawItem(Value: TDrawItemEvent);
|
|
procedure SetOnGetItemWidth(Value: TGetItemWidthEvent);
|
|
procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
|
|
procedure WMSize(var Message: TWMSize); message WM_SIZE;
|
|
procedure CNCommand(var Message: TWMCommand); message CN_COMMAND;
|
|
procedure CNDrawItem(var Message: TWMDrawItem); message CN_DRAWITEM;
|
|
procedure CNMeasureItem(var Message: TWMMeasureItem); message CN_MEASUREITEM;
|
|
procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN;
|
|
procedure WMNCHitTest(var Msg: TWMNCHitTest); message WM_NCHITTEST;
|
|
procedure WMKillFocus(var Msg: TWMKillFocus); message WM_KILLFOCUS;
|
|
procedure WMSetFocus(var Msg: TWMSetFocus); message WM_SETFOCUS;
|
|
{$IFDEF WIN32}
|
|
// procedure CMCtl3DChanged(var Message: TMessage); message CM_CTL3DCHANGED;
|
|
{$ENDIF}
|
|
protected
|
|
procedure CreateParams(var Params: TCreateParams); override;
|
|
procedure CreateWnd; override;
|
|
procedure DestroyWnd; override;
|
|
function CreateItemList: TStrings; virtual;
|
|
function GetItemWidth(Index: Integer): Integer; virtual;
|
|
procedure WndProc(var Message: TMessage); override;
|
|
procedure DragCanceled; override;
|
|
procedure DrawItem(Index: Integer; Rect: TRect;
|
|
State: TOwnerDrawState); virtual;
|
|
procedure MeasureItem(Index: Integer; var Height: Integer); virtual;
|
|
function GetItemData(Index: Integer): Longint; dynamic;
|
|
procedure SetItemData(Index: Integer; AData: LongInt); dynamic;
|
|
procedure SetItems(Value: TStrings); virtual;
|
|
procedure ResetContent; dynamic;
|
|
procedure DeleteString(Index: Integer); dynamic;
|
|
property AutoScroll: Boolean read GetAutoScroll write SetAutoScroll default False;
|
|
property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle default bsSingle;
|
|
property Columns: Integer read FColumns write SetColumns default 0;
|
|
property ExtendedSelect: Boolean read FExtendedSelect write SetExtendedSelect default True;
|
|
property GraySelection: Boolean read FGraySelection write SetGraySelection default False;
|
|
property IntegralHeight: Boolean read FIntegralHeight write SetIntegralHeight default False;
|
|
property ItemHeight: Integer read GetItemHeight write SetItemHeight;
|
|
property MultiSelect: Boolean read FMultiSelect write SetMultiSelect default False;
|
|
property ParentColor default False;
|
|
property Sorted: Boolean read FSorted write SetSorted default False;
|
|
property Style: TListBoxStyle read FStyle write SetStyle default lbStandard;
|
|
property TabWidth: Integer read FTabWidth write SetTabWidth default 0;
|
|
property OnDrawItem: TDrawItemEvent read FOnDrawItem write SetOnDrawItem;
|
|
property OnMeasureItem: TMeasureItemEvent read FOnMeasureItem write FOnMeasureItem;
|
|
property OnGetItemWidth: TGetItemWidthEvent read FOnGetItemWidth write SetOnGetItemWidth;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
procedure Clear;
|
|
procedure DefaultDrawText(X, Y: Integer; const S: string);
|
|
function ItemAtPos(Pos: TPoint; Existing: Boolean): Integer;
|
|
function ItemRect(Index: Integer): TRect;
|
|
property Canvas: TCanvas read FCanvas;
|
|
property Items: TStrings read FItems write SetItems;
|
|
property ItemIndex: Integer read GetItemIndex write SetItemIndex;
|
|
property SelCount: Integer read GetSelCount;
|
|
property Selected[Index: Integer]: Boolean read GetSelected write SetSelected;
|
|
property TopIndex: Integer read GetTopIndex write SetTopIndex;
|
|
published
|
|
property TabStop default True;
|
|
end;
|
|
|
|
{ TRxCheckListBox }
|
|
|
|
TCheckKind = (ckCheckBoxes, ckRadioButtons, ckCheckMarks);
|
|
TChangeStateEvent = procedure (Sender: TObject; Index: Integer) of object;
|
|
|
|
TRxCheckListBox = class(TRxCustomListBox)
|
|
private
|
|
FAllowGrayed: Boolean;
|
|
FCheckKind: TCheckKind;
|
|
FSaveStates: TList;
|
|
FDrawBitmap: TBitmap;
|
|
FCheckWidth, FCheckHeight: Integer;
|
|
FReserved: Integer;
|
|
FInUpdateStates: Boolean;
|
|
FIniLink: TIniLink;
|
|
FOnClickCheck: TNotifyEvent;
|
|
FOnStateChange: TChangeStateEvent;
|
|
procedure ResetItemHeight;
|
|
function GetItemHeight: Integer; override;
|
|
procedure DrawCheck(R: TRect; AState: TCheckBoxState; Enabled: Boolean);
|
|
procedure SetCheckKind(Value: TCheckKind);
|
|
procedure SetChecked(Index: Integer; AChecked: Boolean);
|
|
function GetChecked(Index: Integer): Boolean;
|
|
procedure SetState(Index: Integer; AState: TCheckBoxState);
|
|
function GetState(Index: Integer): TCheckBoxState;
|
|
procedure SetItemEnabled(Index: Integer; Value: Boolean);
|
|
function GetItemEnabled(Index: Integer): Boolean;
|
|
function GetAllowGrayed: Boolean;
|
|
procedure ToggleClickCheck(Index: Integer);
|
|
procedure InvalidateCheck(Index: Integer);
|
|
procedure InvalidateItem(Index: Integer);
|
|
function CreateCheckObject(Index: Integer): TObject;
|
|
function FindCheckObject(Index: Integer): TObject;
|
|
function GetCheckObject(Index: Integer): TObject;
|
|
function IsCheckObject(Index: Integer): Boolean;
|
|
procedure ReadVersion(Reader: TReader);
|
|
procedure WriteVersion(Writer: TWriter);
|
|
procedure ReadCheckData(Reader: TReader);
|
|
procedure WriteCheckData(Writer: TWriter);
|
|
procedure InternalSaveStates(IniFile: TObject; const Section: string);
|
|
procedure InternalRestoreStates(IniFile: TObject; const Section: string);
|
|
function GetStorage: TFormPlacement;
|
|
procedure SetStorage(Value: TFormPlacement);
|
|
procedure IniSave(Sender: TObject);
|
|
procedure IniLoad(Sender: TObject);
|
|
procedure UpdateCheckStates;
|
|
function GetCheckedIndex: Integer;
|
|
procedure SetCheckedIndex(Value: Integer);
|
|
procedure CNDrawItem(var Message: TWMDrawItem); message CN_DRAWITEM;
|
|
procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
|
|
protected
|
|
function CreateItemList: TStrings; override;
|
|
procedure DrawItem(Index: Integer; Rect: TRect;
|
|
State: TOwnerDrawState); override;
|
|
procedure DefineProperties(Filer: TFiler); override;
|
|
function GetItemWidth(Index: Integer): Integer; override;
|
|
function GetItemData(Index: Integer): LongInt; override;
|
|
procedure SetItemData(Index: Integer; AData: LongInt); override;
|
|
procedure KeyPress(var Key: Char); override;
|
|
procedure Loaded; override;
|
|
procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
|
|
X, Y: Integer); override;
|
|
procedure ResetContent; override;
|
|
procedure DeleteString(Index: Integer); override;
|
|
procedure ClickCheck; dynamic;
|
|
procedure ChangeItemState(Index: Integer); dynamic;
|
|
procedure CreateParams(var Params: TCreateParams); override;
|
|
procedure CreateWnd; override;
|
|
procedure DestroyWnd; override;
|
|
procedure WMDestroy(var Msg: TWMDestroy); message WM_DESTROY;
|
|
function GetCheckWidth: Integer;
|
|
procedure SetItems(Value: TStrings); override;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
{$IFDEF WIN32}
|
|
procedure SaveStatesReg(IniFile: TRegIniFile);
|
|
procedure RestoreStatesReg(IniFile: TRegIniFile);
|
|
{$ENDIF WIN32}
|
|
procedure SaveStates(IniFile: TIniFile);
|
|
procedure RestoreStates(IniFile: TIniFile);
|
|
procedure ApplyState(AState: TCheckBoxState; EnabledOnly: Boolean);
|
|
property Checked[Index: Integer]: Boolean read GetChecked write SetChecked;
|
|
property State[Index: Integer]: TCheckBoxState read GetState write SetState;
|
|
property EnabledItem[Index: Integer]: Boolean read GetItemEnabled write SetItemEnabled;
|
|
published
|
|
property AllowGrayed: Boolean read GetAllowGrayed write FAllowGrayed default False;
|
|
property CheckKind: TCheckKind read FCheckKind write SetCheckKind default ckCheckBoxes;
|
|
property CheckedIndex: Integer read GetCheckedIndex write SetCheckedIndex default -1;
|
|
property IniStorage: TFormPlacement read GetStorage write SetStorage;
|
|
property Align;
|
|
property AutoScroll default True;
|
|
property BorderStyle;
|
|
property Color;
|
|
property Columns;
|
|
property DragCursor;
|
|
property DragMode;
|
|
property Enabled;
|
|
property ExtendedSelect;
|
|
property Font;
|
|
property GraySelection;
|
|
{$IFDEF RX_D4}
|
|
property Anchors;
|
|
property BiDiMode;
|
|
property Constraints;
|
|
property DragKind;
|
|
property ParentBiDiMode;
|
|
{$ENDIF}
|
|
{$IFDEF WIN32}
|
|
{$IFNDEF VER90}
|
|
property ImeMode;
|
|
property ImeName;
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
property IntegralHeight;
|
|
property ItemHeight;
|
|
property Items stored False;
|
|
property MultiSelect;
|
|
property ParentColor;
|
|
property ParentFont;
|
|
property ParentShowHint;
|
|
property PopupMenu;
|
|
property ShowHint;
|
|
property Sorted;
|
|
property Style;
|
|
property TabOrder;
|
|
property TabWidth;
|
|
property Visible;
|
|
property OnStateChange: TChangeStateEvent read FOnStateChange write FOnStateChange;
|
|
property OnClickCheck: TNotifyEvent read FOnClickCheck write FOnClickCheck;
|
|
property OnClick;
|
|
property OnDblClick;
|
|
property OnDragDrop;
|
|
property OnDragOver;
|
|
property OnDrawItem;
|
|
property OnEndDrag;
|
|
property OnEnter;
|
|
property OnExit;
|
|
property OnGetItemWidth;
|
|
property OnKeyDown;
|
|
property OnKeyPress;
|
|
property OnKeyUp;
|
|
property OnMeasureItem;
|
|
property OnMouseDown;
|
|
property OnMouseMove;
|
|
property OnMouseUp;
|
|
{$IFDEF WIN32}
|
|
property OnStartDrag;
|
|
{$ENDIF}
|
|
{$IFDEF RX_D5}
|
|
property OnContextPopup;
|
|
{$ENDIF}
|
|
{$IFDEF RX_D4}
|
|
property OnMouseWheelDown;
|
|
property OnMouseWheelUp;
|
|
property OnEndDock;
|
|
property OnStartDock;
|
|
{$ENDIF}
|
|
end;
|
|
*)
|
|
const
|
|
clbDefaultState = cbUnchecked;
|
|
clbDefaultEnabled = True;
|
|
|
|
{ TRxCustomLabel }
|
|
|
|
type
|
|
TShadowPosition = (spLeftTop, spLeftBottom, spRightBottom, spRightTop);
|
|
{$IFNDEF RX_D3}
|
|
TTextLayout = (tlTop, tlCenter, tlBottom);
|
|
{$ENDIF}
|
|
|
|
TRxCustomLabel = class(TGraphicControl)
|
|
private
|
|
FFocusControl: TWinControl;
|
|
FAlignment: TAlignment;
|
|
FAutoSize: Boolean;
|
|
FLayout: TTextLayout;
|
|
FShadowColor: TColor;
|
|
FShadowSize: Byte;
|
|
FShadowPos: TShadowPosition;
|
|
FWordWrap: Boolean;
|
|
FShowAccelChar: Boolean;
|
|
FShowFocus: Boolean;
|
|
FFocused: Boolean;
|
|
FMouseInControl: Boolean;
|
|
FDragging: Boolean;
|
|
FLeftMargin: Integer;
|
|
FRightMargin: Integer;
|
|
FOnMouseEnter: TNotifyEvent;
|
|
FOnMouseLeave: TNotifyEvent;
|
|
procedure DoDrawText(var Rect: TRect; Flags: Word);
|
|
function GetTransparent: Boolean;
|
|
procedure UpdateTracking;
|
|
procedure SetAlignment(Value: TAlignment);
|
|
{$IFNDEF RX_D6}
|
|
procedure SetAutoSize(Value: Boolean);
|
|
{$ENDIF}
|
|
procedure SetFocusControl(Value: TWinControl);
|
|
procedure SetLayout(Value: TTextLayout);
|
|
procedure SetLeftMargin(Value: Integer);
|
|
procedure SetRightMargin(Value: Integer);
|
|
procedure SetShadowColor(Value: TColor);
|
|
procedure SetShadowSize(Value: Byte);
|
|
procedure SetShadowPos(Value: TShadowPosition);
|
|
procedure SetShowAccelChar(Value: Boolean);
|
|
procedure SetTransparent(Value: Boolean);
|
|
procedure SetWordWrap(Value: Boolean);
|
|
procedure SetShowFocus(Value: Boolean);
|
|
procedure CMTextChanged(var Message: TLMessage); message CM_TEXTCHANGED;
|
|
procedure CMFocusChanged(var Message: TLMessage); message CM_FOCUSCHANGED;
|
|
procedure CMFontChanged(var Message: TLMessage); message CM_FONTCHANGED;
|
|
procedure CMDialogChar(var Message: TCMDialogChar); message CM_DIALOGCHAR;
|
|
procedure CMEnabledChanged(var Message: TLMessage); message CM_ENABLEDCHANGED;
|
|
procedure CMMouseEnter(var Message: TLMessage); message CM_MOUSEENTER;
|
|
procedure CMMouseLeave(var Message: TLMessage); message CM_MOUSELEAVE;
|
|
procedure CMVisibleChanged(var Message: TLMessage); message CM_VISIBLECHANGED;
|
|
(*
|
|
procedure WMRButtonDown(var Message: TWMRButtonDown); message WM_RBUTTONDOWN;
|
|
procedure WMRButtonUp(var Message: TWMRButtonUp); message WM_RBUTTONUP;
|
|
*)
|
|
protected
|
|
procedure MouseDown(Button: TMouseButton; Shift:TShiftState; X,Y:Integer); override;
|
|
procedure MouseUp(Button: TMouseButton; Shift:TShiftState; X,Y:Integer); override;
|
|
// procedure SetAutoSize(Value: Boolean); override;
|
|
procedure AdjustBounds;
|
|
function GetDefaultFontColor: TColor; virtual;
|
|
function GetLabelCaption: string; virtual;
|
|
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
|
|
procedure Paint; override;
|
|
procedure MouseEnter; dynamic;
|
|
procedure MouseLeave; dynamic;
|
|
property Alignment: TAlignment read FAlignment write SetAlignment default taLeftJustify;
|
|
property AutoSize: Boolean read FAutoSize write SetAutoSize default True;
|
|
property FocusControl: TWinControl read FFocusControl write SetFocusControl;
|
|
property Layout: TTextLayout read FLayout write SetLayout default tlTop;
|
|
property LeftMargin: Integer read FLeftMargin write SetLeftMargin default 0;
|
|
property RightMargin: Integer read FRightMargin write SetRightMargin default 0;
|
|
property ShadowColor: TColor read FShadowColor write SetShadowColor default clBtnHighlight;
|
|
property ShadowSize: Byte read FShadowSize write SetShadowSize default 1;
|
|
property ShadowPos: TShadowPosition read FShadowPos write SetShadowPos default spLeftTop;
|
|
property ShowAccelChar: Boolean read FShowAccelChar write SetShowAccelChar default True;
|
|
property ShowFocus: Boolean read FShowFocus write SetShowFocus default False;
|
|
property Transparent: Boolean read GetTransparent write SetTransparent default False;
|
|
property WordWrap: Boolean read FWordWrap write SetWordWrap default False;
|
|
property OnMouseEnter: TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
|
|
property OnMouseLeave: TNotifyEvent read FOnMouseLeave write FOnMouseLeave;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
property Canvas;
|
|
property MouseInControl: Boolean read FMouseInControl;
|
|
end;
|
|
|
|
{ TRxLabel }
|
|
|
|
TRxLabel = class(TRxCustomLabel)
|
|
published
|
|
property Align;
|
|
property Alignment;
|
|
property AutoSize;
|
|
property Caption;
|
|
property Color;
|
|
property DragCursor;
|
|
property DragMode;
|
|
property Enabled;
|
|
property FocusControl;
|
|
property Font;
|
|
property Anchors;
|
|
property Constraints;
|
|
property DragKind;
|
|
{$IFDEF RX_D4}
|
|
property BiDiMode;
|
|
property ParentBiDiMode;
|
|
{$ENDIF}
|
|
property BorderSpacing;
|
|
property Layout;
|
|
property ParentColor;
|
|
property ParentFont;
|
|
property ParentShowHint;
|
|
property PopupMenu;
|
|
property ShadowColor;
|
|
property ShadowSize;
|
|
property ShadowPos;
|
|
property ShowAccelChar;
|
|
property ShowFocus;
|
|
property ShowHint;
|
|
property Transparent;
|
|
property Visible;
|
|
property WordWrap;
|
|
property OnClick;
|
|
property OnDblClick;
|
|
property OnDragDrop;
|
|
property OnDragOver;
|
|
property OnEndDrag;
|
|
property OnMouseDown;
|
|
property OnMouseMove;
|
|
property OnMouseUp;
|
|
property OnMouseEnter;
|
|
property OnMouseLeave;
|
|
property OnMouseWheel;
|
|
property OnMouseWheelDown;
|
|
property OnMouseWheelUp;
|
|
property OnStartDrag;
|
|
property OnContextPopup;
|
|
property OnEndDock;
|
|
property OnStartDock;
|
|
end;
|
|
|
|
|
|
{ TSecretPanel }
|
|
|
|
TGlyphLayout = (glGlyphLeft, glGlyphRight, glGlyphTop, glGlyphBottom);
|
|
TScrollDirection = (sdVertical, sdHorizontal);
|
|
TPanelDrawEvent = procedure(Sender: TObject; Canvas: TCanvas;
|
|
Rect: TRect) of object;
|
|
|
|
TSecretPanel = class(TCustomPanel)
|
|
private
|
|
FActive: Boolean;
|
|
FAlignment: TAlignment;
|
|
FLines: TStrings;
|
|
FCycled: Boolean;
|
|
FScrollCnt: Integer;
|
|
FMaxScroll: Integer;
|
|
FTxtDivider: Byte;
|
|
FFirstLine: Integer;
|
|
FTimer: TTimer;
|
|
FTxtRect: TRect;
|
|
FPaintRect: TRect;
|
|
FGlyphOrigin: TPoint;
|
|
FMemoryImage: TBitmap;
|
|
FGlyph: TBitmap;
|
|
FHiddenList: TList;
|
|
FTextStyle: TPanelBevel;
|
|
FDirection: TScrollDirection;
|
|
FGlyphLayout: TGlyphLayout;
|
|
FOnPaintClient: TPanelDrawEvent;
|
|
FOnStartPlay: TNotifyEvent;
|
|
FOnStopPlay: TNotifyEvent;
|
|
FAsyncDrawing: Boolean;
|
|
procedure SetAsyncDrawing(Value: Boolean);
|
|
function GetInflateWidth: Integer;
|
|
function GetInterval: Cardinal;
|
|
procedure SetInterval(Value: Cardinal);
|
|
procedure SetGlyph(Value: TBitmap);
|
|
procedure SetLines(Value: TStrings);
|
|
procedure SetActive(Value: Boolean);
|
|
procedure SetAlignment(Value: TAlignment);
|
|
procedure SetGlyphLayout(Value: TGlyphLayout);
|
|
procedure SetTextStyle(Value: TPanelBevel);
|
|
procedure SetDirection(Value: TScrollDirection);
|
|
procedure RecalcDrawRect;
|
|
procedure PaintGlyph;
|
|
procedure PaintText;
|
|
procedure UpdateMemoryImage;
|
|
procedure GlyphChanged(Sender: TObject);
|
|
procedure LinesChanged(Sender: TObject);
|
|
procedure CMFontChanged(var Message: TLMessage); message CM_FONTCHANGED;
|
|
procedure CMColorChanged(var Message: TLMessage); message CM_COLORCHANGED;
|
|
// procedure WMSize(var Message: TLMessage); message LM_SIZE;
|
|
procedure WMSize(var Message: TLMSize); message LM_SIZE;
|
|
protected
|
|
procedure AlignControls(AControl: TControl; var Rect: TRect); override;
|
|
procedure Paint; override;
|
|
procedure PaintClient(ACanvas: TCanvas; Rect: TRect); virtual;
|
|
procedure TimerExpired(Sender: TObject); virtual;
|
|
procedure StartPlay; dynamic;
|
|
procedure StopPlay; dynamic;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
procedure Play;
|
|
procedure Stop;
|
|
property Canvas;
|
|
published
|
|
property AsyncDrawing: Boolean read FAsyncDrawing write SetAsyncDrawing default True;
|
|
property Active: Boolean read FActive write SetActive default False;
|
|
property Alignment: TAlignment read FAlignment write SetAlignment default taCenter;
|
|
property Cycled: Boolean read FCycled write FCycled default False;
|
|
property Glyph: TBitmap read FGlyph write SetGlyph;
|
|
property GlyphLayout: TGlyphLayout read FGlyphLayout write SetGlyphLayout
|
|
default glGlyphLeft;
|
|
property Interval: Cardinal read GetInterval write SetInterval default 30;
|
|
property Lines: TStrings read FLines write SetLines;
|
|
property ScrollDirection: TScrollDirection read FDirection write SetDirection
|
|
default sdVertical;
|
|
property TextStyle: TPanelBevel read FTextStyle write SetTextStyle default bvNone;
|
|
property Anchors;
|
|
property Constraints;
|
|
property DragKind;
|
|
{$IFDEF RX_D4}
|
|
property BiDiMode;
|
|
property ParentBiDiMode;
|
|
{$ENDIF}
|
|
property Align;
|
|
property BevelInner;
|
|
property BevelOuter default bvLowered;
|
|
property BevelWidth;
|
|
property BorderWidth;
|
|
property BorderStyle;
|
|
property DragCursor;
|
|
property DragMode;
|
|
property Color;
|
|
property Font;
|
|
property ParentColor;
|
|
property ParentFont;
|
|
property ParentShowHint;
|
|
property PopupMenu;
|
|
property ShowHint;
|
|
property TabOrder;
|
|
property TabStop;
|
|
property Visible;
|
|
property OnPaintClient: TPanelDrawEvent read FOnPaintClient write FOnPaintClient;
|
|
property OnStartPlay: TNotifyEvent read FOnStartPlay write FOnStartPlay;
|
|
property OnStopPlay: TNotifyEvent read FOnStopPlay write FOnStopPlay;
|
|
property OnClick;
|
|
property OnDblClick;
|
|
property OnDragDrop;
|
|
property OnDragOver;
|
|
property OnEndDrag;
|
|
property OnEnter;
|
|
property OnExit;
|
|
property OnMouseDown;
|
|
property OnMouseMove;
|
|
property OnMouseUp;
|
|
property OnMouseWheel;
|
|
property OnMouseWheelDown;
|
|
property OnMouseWheelUp;
|
|
property OnStartDrag;
|
|
property OnContextPopup;
|
|
property OnEndDock;
|
|
property OnStartDock;
|
|
property OnResize;
|
|
end;
|
|
|
|
{ TRxSpeedButton }
|
|
(*
|
|
|
|
TRxNumGlyphs = 1..5;
|
|
TRxDropDownMenuPos = (dmpBottom, dmpRight);
|
|
TRxButtonState = (rbsUp, rbsDisabled, rbsDown, rbsExclusive, rbsInactive);
|
|
*)
|
|
|
|
TRxSpeedButton = class(TSpeedButton)
|
|
private
|
|
FAllowTimer: Boolean;
|
|
FInitRepeatPause: Word;
|
|
FRepeatPause: Word;
|
|
FRepeatTimer: TTimer;
|
|
procedure SetAllowTimer(const AValue: Boolean);
|
|
procedure TimerExpired(Sender: TObject);
|
|
protected
|
|
procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
|
|
X, Y: Integer); override;
|
|
procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
|
|
X, Y: Integer); override;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
published
|
|
property AllowTimer: Boolean read FAllowTimer write SetAllowTimer default False;
|
|
property InitPause: Word read FInitRepeatPause write FInitRepeatPause default 500;
|
|
property RepeatInterval: Word read FRepeatPause write FRepeatPause default 100;
|
|
end;
|
|
|
|
(*
|
|
{ TButtonImage }
|
|
|
|
TButtonImage = class(TObject)
|
|
private
|
|
FGlyph: TObject;
|
|
FButtonSize: TPoint;
|
|
FCaption: TCaption;
|
|
function GetNumGlyphs: TRxNumGlyphs;
|
|
procedure SetNumGlyphs(Value: TRxNumGlyphs);
|
|
function GetWordWrap: Boolean;
|
|
procedure SetWordWrap(Value: Boolean);
|
|
function GetAlignment: TAlignment;
|
|
procedure SetAlignment(Value: TAlignment);
|
|
function GetGlyph: TBitmap;
|
|
procedure SetGlyph(Value: TBitmap);
|
|
public
|
|
constructor Create;
|
|
destructor Destroy; override;
|
|
procedure Invalidate;
|
|
{$IFDEF WIN32}
|
|
procedure DrawEx(Canvas: TCanvas; X, Y, Margin, Spacing: Integer;
|
|
Layout: TButtonLayout; AFont: TFont; Images: TImageList;
|
|
ImageIndex: Integer; Flags: Word);
|
|
{$ENDIF}
|
|
procedure Draw(Canvas: TCanvas; X, Y, Margin, Spacing: Integer;
|
|
Layout: TButtonLayout; AFont: TFont; Flags: Word);
|
|
property Alignment: TAlignment read GetAlignment write SetAlignment;
|
|
property Caption: TCaption read FCaption write FCaption;
|
|
property Glyph: TBitmap read GetGlyph write SetGlyph;
|
|
property NumGlyphs: TRxNumGlyphs read GetNumGlyphs write SetNumGlyphs;
|
|
property ButtonSize: TPoint read FButtonSize write FButtonSize;
|
|
property WordWrap: Boolean read GetWordWrap write SetWordWrap;
|
|
end;
|
|
|
|
{ TRxButtonGlyph }
|
|
|
|
TRxButtonGlyph = class
|
|
private
|
|
FOriginal: TBitmap;
|
|
FGlyphList: TImageList;
|
|
FIndexs: array[TRxButtonState] of Integer;
|
|
FTransparentColor: TColor;
|
|
FNumGlyphs: TRxNumGlyphs;
|
|
FWordWrap: Boolean;
|
|
FAlignment: TAlignment;
|
|
FOnChange: TNotifyEvent;
|
|
procedure GlyphChanged(Sender: TObject);
|
|
procedure SetGlyph(Value: TBitmap);
|
|
procedure SetNumGlyphs(Value: TRxNumGlyphs);
|
|
function MapColor(Color: TColor): TColor;
|
|
protected
|
|
procedure MinimizeCaption(Canvas: TCanvas; const Caption: string;
|
|
Buffer: PChar; MaxLen, Width: Integer);
|
|
function CreateButtonGlyph(State: TRxButtonState): Integer;
|
|
{$IFDEF WIN32}
|
|
function CreateImageGlyph(State: TRxButtonState; Images: TImageList;
|
|
Index: Integer): Integer;
|
|
{$ENDIF}
|
|
procedure CalcButtonLayout(Canvas: TCanvas; const Client: TRect;
|
|
var Caption: string; Layout: TButtonLayout; Margin, Spacing: Integer;
|
|
PopupMark: Boolean; var GlyphPos: TPoint; var TextBounds: TRect;
|
|
Flags: Word {$IFDEF WIN32}; Images: TImageList; ImageIndex: Integer
|
|
{$ENDIF});
|
|
public
|
|
constructor Create;
|
|
destructor Destroy; override;
|
|
procedure Invalidate;
|
|
function DrawButtonGlyph(Canvas: TCanvas; X, Y: Integer;
|
|
State: TRxButtonState): TPoint;
|
|
{$IFDEF WIN32}
|
|
function DrawButtonImage(Canvas: TCanvas; X, Y: Integer; Images: TImageList;
|
|
ImageIndex: Integer; State: TRxButtonState): TPoint;
|
|
function DrawEx(Canvas: TCanvas; const Client: TRect; const Caption: string;
|
|
Layout: TButtonLayout; Margin, Spacing: Integer; PopupMark: Boolean;
|
|
Images: TImageList; ImageIndex: Integer; State: TRxButtonState;
|
|
Flags: Word): TRect;
|
|
{$ENDIF}
|
|
procedure DrawButtonText(Canvas: TCanvas; const Caption: string;
|
|
TextBounds: TRect; State: TRxButtonState; Flags: Word);
|
|
procedure DrawPopupMark(Canvas: TCanvas; X, Y: Integer;
|
|
State: TRxButtonState);
|
|
function Draw(Canvas: TCanvas; const Client: TRect; const Caption: string;
|
|
Layout: TButtonLayout; Margin, Spacing: Integer; PopupMark: Boolean;
|
|
State: TRxButtonState; Flags: Word): TRect;
|
|
property Alignment: TAlignment read FAlignment write FAlignment;
|
|
property Glyph: TBitmap read FOriginal write SetGlyph;
|
|
property NumGlyphs: TRxNumGlyphs read FNumGlyphs write SetNumGlyphs;
|
|
property WordWrap: Boolean read FWordWrap write FWordWrap;
|
|
property OnChange: TNotifyEvent read FOnChange write FOnChange;
|
|
end;
|
|
|
|
function DrawShadowText(DC: HDC; Str: PChar; Count: Integer; var Rect: TRect;
|
|
Format: Word; ShadowSize: Byte; ShadowColor: TColorRef;
|
|
ShadowPos: TShadowPosition): Integer;
|
|
|
|
function CheckBitmap: TBitmap;
|
|
*)
|
|
|
|
type
|
|
|
|
{ TRxDBRadioGroup }
|
|
|
|
{ TRxRadioGroup }
|
|
|
|
TRxRadioGroup = class(TRadioGroup)
|
|
private
|
|
function GetItemEnabled(Index: integer): boolean;
|
|
procedure SetItemEnabled(Index: integer; AValue: boolean);
|
|
public
|
|
property ItemEnabled[Index: integer]: boolean read GetItemEnabled write SetItemEnabled;
|
|
end;
|
|
|
|
implementation
|
|
|
|
|
|
uses SysUtils, Dialogs, rxlclutils, Math, RxAppUtils, ImgList,
|
|
ActnList, InterfaceBase;
|
|
const
|
|
Alignments: array [TAlignment] of Word = (DT_LEFT, DT_RIGHT, DT_CENTER);
|
|
WordWraps: array[Boolean] of Word = (0, DT_WORDBREAK);
|
|
(*
|
|
{ TTextListBox }
|
|
|
|
procedure TTextListBox.SetHorizontalExtent;
|
|
begin
|
|
SendMessage(Handle, LB_SETHORIZONTALEXTENT, FMaxWidth, 0);
|
|
end;
|
|
|
|
function TTextListBox.GetItemWidth(Index: Integer): Integer;
|
|
var
|
|
ATabWidth: Longint;
|
|
S: string;
|
|
begin
|
|
S := Items[Index] + 'x';
|
|
if TabWidth > 0 then begin
|
|
ATabWidth := Round((TabWidth * Canvas.TextWidth('0')) * 0.25);
|
|
Result := LoWord(GetTabbedTextExtent(Canvas.Handle, @S[1], Length(S),
|
|
1, ATabWidth));
|
|
end
|
|
else Result := Canvas.TextWidth(S);
|
|
end;
|
|
|
|
procedure TTextListBox.ResetHorizontalExtent;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
FMaxWidth := 0;
|
|
for I := 0 to Items.Count - 1 do
|
|
FMaxWidth := Max(FMaxWidth, GetItemWidth(I));
|
|
SetHorizontalExtent;
|
|
end;
|
|
|
|
{$IFNDEF WIN32}
|
|
|
|
procedure TTextListBox.SetTabWidth(Value: Integer);
|
|
begin
|
|
if Value < 0 then Value := 0;
|
|
if FTabWidth <> Value then begin
|
|
FTabWidth := Value;
|
|
RecreateWnd;
|
|
end;
|
|
end;
|
|
|
|
procedure TTextListBox.CreateParams(var Params: TCreateParams);
|
|
const
|
|
TabStops: array[Boolean] of Longword = (0, LBS_USETABSTOPS);
|
|
begin
|
|
inherited CreateParams(Params);
|
|
Params.Style := Params.Style or TabStops[FTabWidth <> 0];
|
|
end;
|
|
|
|
procedure TTextListBox.CreateWnd;
|
|
begin
|
|
inherited CreateWnd;
|
|
if FTabWidth <> 0 then
|
|
SendMessage(Handle, LB_SETTABSTOPS, 1, Longint(@FTabWidth));
|
|
end;
|
|
|
|
{$ENDIF}
|
|
|
|
procedure TTextListBox.WndProc(var Message: TMessage);
|
|
begin
|
|
case Message.Msg of
|
|
LB_ADDSTRING, LB_INSERTSTRING:
|
|
begin
|
|
inherited WndProc(Message);
|
|
FMaxWidth := Max(FMaxWidth, GetItemWidth(Message.Result));
|
|
SetHorizontalExtent;
|
|
end;
|
|
LB_DELETESTRING:
|
|
begin
|
|
if GetItemWidth(Message.wParam) >= FMaxWidth then begin
|
|
Perform(WM_HSCROLL, SB_TOP, 0);
|
|
inherited WndProc(Message);
|
|
ResetHorizontalExtent;
|
|
end
|
|
else inherited WndProc(Message);
|
|
end;
|
|
LB_RESETCONTENT:
|
|
begin
|
|
FMaxWidth := 0;
|
|
SetHorizontalExtent;
|
|
Perform(WM_HSCROLL, SB_TOP, 0);
|
|
inherited WndProc(Message);
|
|
end;
|
|
WM_SETFONT:
|
|
begin
|
|
inherited WndProc(Message);
|
|
Canvas.Font.Assign(Self.Font);
|
|
ResetHorizontalExtent;
|
|
Exit;
|
|
end;
|
|
else inherited WndProc(Message);
|
|
end;
|
|
end;
|
|
|
|
{ TRxCustomListBox implementation copied from STDCTRLS.PAS and modified }
|
|
|
|
{ TRxListBoxStrings }
|
|
|
|
type
|
|
TRxListBoxStrings = class(TStrings)
|
|
private
|
|
ListBox: TRxCustomListBox;
|
|
protected
|
|
{$IFNDEF RX_D3}
|
|
procedure Error(Msg: Word; Data: Integer);
|
|
{$ENDIF}
|
|
function Get(Index: Integer): string; override;
|
|
function GetCount: Integer; override;
|
|
function GetObject(Index: Integer): TObject; override;
|
|
procedure PutObject(Index: Integer; AObject: TObject); override;
|
|
procedure SetUpdateState(Updating: Boolean); override;
|
|
public
|
|
function Add(const S: string): Integer; override;
|
|
procedure Clear; override;
|
|
procedure Delete(Index: Integer); override;
|
|
procedure Insert(Index: Integer; const S: string); override;
|
|
end;
|
|
|
|
{$IFNDEF RX_D3}
|
|
procedure TRxListBoxStrings.Error(Msg: Word; Data: Integer);
|
|
|
|
{$IFDEF WIN32}
|
|
function ReturnAddr: Pointer;
|
|
asm
|
|
MOV EAX,[EBP+4]
|
|
end;
|
|
{$ELSE}
|
|
function ReturnAddr: Pointer; assembler;
|
|
asm
|
|
MOV AX,[BP].Word[2]
|
|
MOV DX,[BP].Word[4]
|
|
end;
|
|
{$ENDIF}
|
|
|
|
begin
|
|
raise EStringListError.CreateFmt('%s: %d', [LoadStr(Msg),
|
|
Data]) at ReturnAddr;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
function TRxListBoxStrings.GetCount: Integer;
|
|
begin
|
|
Result := SendMessage(ListBox.Handle, LB_GETCOUNT, 0, 0);
|
|
end;
|
|
|
|
function TRxListBoxStrings.Get(Index: Integer): string;
|
|
var
|
|
Len: Integer;
|
|
{$IFDEF WIN32}
|
|
Text: array[0..4095] of Char;
|
|
{$ENDIF}
|
|
begin
|
|
Len := SendMessage(ListBox.Handle, LB_GETTEXT, Index,
|
|
{$IFDEF WIN32} LongInt(@Text) {$ELSE} LongInt(@Result) {$ENDIF});
|
|
if Len < 0 then Error(SListIndexError, Index);
|
|
{$IFDEF WIN32}
|
|
SetString(Result, Text, Len);
|
|
{$ELSE}
|
|
System.Move(Result[0], Result[1], Len);
|
|
Result[0] := Char(Len);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function TRxListBoxStrings.GetObject(Index: Integer): TObject;
|
|
begin
|
|
Result := TObject(ListBox.GetItemData(Index));
|
|
if Longint(Result) = LB_ERR then Error(SListIndexError, Index);
|
|
end;
|
|
|
|
procedure TRxListBoxStrings.PutObject(Index: Integer; AObject: TObject);
|
|
begin
|
|
ListBox.SetItemData(Index, LongInt(AObject));
|
|
end;
|
|
|
|
function TRxListBoxStrings.Add(const S: string): Integer;
|
|
{$IFNDEF WIN32}
|
|
var
|
|
Text: array[0..255] of Char;
|
|
{$ENDIF}
|
|
begin
|
|
{$IFDEF WIN32}
|
|
Result := SendMessage(ListBox.Handle, LB_ADDSTRING, 0, LongInt(PChar(S)));
|
|
{$ELSE}
|
|
Result := SendMessage(ListBox.Handle, LB_ADDSTRING, 0, LongInt(StrPCopy(Text, S)));
|
|
{$ENDIF}
|
|
if Result < 0 then raise EOutOfResources.Create(ResStr(SInsertLineError));
|
|
end;
|
|
|
|
procedure TRxListBoxStrings.Insert(Index: Integer; const S: string);
|
|
{$IFNDEF WIN32}
|
|
var
|
|
Text: array[0..255] of Char;
|
|
{$ENDIF}
|
|
begin
|
|
if SendMessage(ListBox.Handle, LB_INSERTSTRING, Index,
|
|
{$IFDEF WIN32}
|
|
Longint(PChar(S))) < 0 then
|
|
{$ELSE}
|
|
Longint(StrPCopy(Text, S))) < 0 then
|
|
{$ENDIF}
|
|
raise EOutOfResources.Create(ResStr(SInsertLineError));
|
|
end;
|
|
|
|
procedure TRxListBoxStrings.Delete(Index: Integer);
|
|
begin
|
|
ListBox.DeleteString(Index);
|
|
end;
|
|
|
|
procedure TRxListBoxStrings.Clear;
|
|
begin
|
|
ListBox.ResetContent;
|
|
end;
|
|
|
|
procedure TRxListBoxStrings.SetUpdateState(Updating: Boolean);
|
|
begin
|
|
SendMessage(ListBox.Handle, WM_SETREDRAW, Ord(not Updating), 0);
|
|
if not Updating then ListBox.Refresh;
|
|
end;
|
|
|
|
{ TRxCustomListBox }
|
|
|
|
procedure ListIndexError(Index: Integer);
|
|
|
|
{$IFDEF WIN32}
|
|
function ReturnAddr: Pointer;
|
|
asm
|
|
MOV EAX,[EBP+4]
|
|
end;
|
|
{$ELSE}
|
|
function ReturnAddr: Pointer; assembler;
|
|
asm
|
|
MOV AX,[BP].Word[2]
|
|
MOV DX,[BP].Word[4]
|
|
end;
|
|
{$ENDIF}
|
|
|
|
begin
|
|
{$IFDEF RX_D3}
|
|
raise EStringListError.CreateFmt(SListIndexError, [Index]) at ReturnAddr;
|
|
{$ELSE}
|
|
raise EStringListError.CreateFmt('%s: %d', [LoadStr(SListIndexError),
|
|
Index]) at ReturnAddr;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
constructor TRxCustomListBox.Create(AOwner: TComponent);
|
|
const
|
|
ListBoxStyle = [csSetCaption, csDoubleClicks];
|
|
begin
|
|
inherited Create(AOwner);
|
|
{$IFDEF WIN32}
|
|
if NewStyleControls then ControlStyle := ListBoxStyle
|
|
else ControlStyle := ListBoxStyle + [csFramed];
|
|
{$ELSE}
|
|
ControlStyle := ListBoxStyle + [csFramed];
|
|
{$ENDIF}
|
|
Width := 121;
|
|
Height := 97;
|
|
TabStop := True;
|
|
ParentColor := False;
|
|
FItems := CreateItemList;
|
|
TRxListBoxStrings(FItems).ListBox := Self;
|
|
FCanvas := TControlCanvas.Create;
|
|
TControlCanvas(FCanvas).Control := Self;
|
|
FItemHeight := 16;
|
|
FBorderStyle := bsSingle;
|
|
FExtendedSelect := True;
|
|
end;
|
|
|
|
destructor TRxCustomListBox.Destroy;
|
|
begin
|
|
inherited Destroy;
|
|
FCanvas.Free;
|
|
FItems.Free;
|
|
FSaveItems.Free;
|
|
end;
|
|
|
|
function TRxCustomListBox.CreateItemList: TStrings;
|
|
begin
|
|
Result := TRxListBoxStrings.Create;
|
|
end;
|
|
|
|
function TRxCustomListBox.GetItemData(Index: Integer): LongInt;
|
|
begin
|
|
Result := SendMessage(Handle, LB_GETITEMDATA, Index, 0);
|
|
end;
|
|
|
|
procedure TRxCustomListBox.SetItemData(Index: Integer; AData: LongInt);
|
|
begin
|
|
SendMessage(Handle, LB_SETITEMDATA, Index, AData);
|
|
end;
|
|
|
|
procedure TRxCustomListBox.DeleteString(Index: Integer);
|
|
begin
|
|
SendMessage(Handle, LB_DELETESTRING, Index, 0);
|
|
end;
|
|
|
|
procedure TRxCustomListBox.SetHorizontalExtent;
|
|
begin
|
|
SendMessage(Handle, LB_SETHORIZONTALEXTENT, FMaxItemWidth, 0);
|
|
end;
|
|
|
|
function TRxCustomListBox.GetItemWidth(Index: Integer): Integer;
|
|
var
|
|
ATabWidth: Longint;
|
|
S: string;
|
|
begin
|
|
if (Style <> lbStandard) and Assigned(FOnGetItemWidth) and
|
|
Assigned(FOnDrawItem) then
|
|
begin
|
|
Result := 0;
|
|
FOnGetItemWidth(Self, Index, Result);
|
|
end
|
|
else begin
|
|
S := Items[Index] + 'x';
|
|
if TabWidth > 0 then begin
|
|
{if (FTabChar > #0) then
|
|
for I := 1 to Length(S) do
|
|
if S[I] = FTabChar then S[I] := #9;}
|
|
ATabWidth := Round((TabWidth * Canvas.TextWidth('0')) * 0.25);
|
|
Result := LoWord(GetTabbedTextExtent(Canvas.Handle, @S[1], Length(S),
|
|
1, ATabWidth));
|
|
end
|
|
else Result := Canvas.TextWidth(S);
|
|
end;
|
|
end;
|
|
|
|
procedure TRxCustomListBox.ResetHorizontalExtent;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
FMaxItemWidth := 0;
|
|
for I := 0 to Items.Count - 1 do
|
|
FMaxItemWidth := Max(FMaxItemWidth, GetItemWidth(I));
|
|
SetHorizontalExtent;
|
|
end;
|
|
|
|
procedure TRxCustomListBox.ResetContent;
|
|
begin
|
|
SendMessage(Handle, LB_RESETCONTENT, 0, 0);
|
|
end;
|
|
|
|
procedure TRxCustomListBox.Clear;
|
|
begin
|
|
FItems.Clear;
|
|
end;
|
|
|
|
procedure TRxCustomListBox.SetColumnWidth;
|
|
begin
|
|
if FColumns > 0 then
|
|
SendMessage(Handle, LB_SETCOLUMNWIDTH, (Width + FColumns - 3) div
|
|
FColumns, 0);
|
|
end;
|
|
|
|
procedure TRxCustomListBox.SetColumns(Value: Integer);
|
|
begin
|
|
if FColumns <> Value then
|
|
if (FColumns = 0) or (Value = 0) then begin
|
|
FColumns := Value;
|
|
RecreateWnd;
|
|
end
|
|
else begin
|
|
FColumns := Value;
|
|
if HandleAllocated then SetColumnWidth;
|
|
end;
|
|
end;
|
|
|
|
function TRxCustomListBox.GetItemIndex: Integer;
|
|
begin
|
|
Result := SendMessage(Handle, LB_GETCURSEL, 0, 0);
|
|
end;
|
|
|
|
function TRxCustomListBox.GetSelCount: Integer;
|
|
begin
|
|
Result := SendMessage(Handle, LB_GETSELCOUNT, 0, 0);
|
|
end;
|
|
|
|
procedure TRxCustomListBox.SetItemIndex(Value: Integer);
|
|
begin
|
|
if GetItemIndex <> Value then
|
|
SendMessage(Handle, LB_SETCURSEL, Value, 0);
|
|
end;
|
|
|
|
procedure TRxCustomListBox.SetExtendedSelect(Value: Boolean);
|
|
begin
|
|
if Value <> FExtendedSelect then begin
|
|
FExtendedSelect := Value;
|
|
RecreateWnd;
|
|
end;
|
|
end;
|
|
|
|
procedure TRxCustomListBox.SetIntegralHeight(Value: Boolean);
|
|
begin
|
|
if Value <> FIntegralHeight then begin
|
|
FIntegralHeight := Value;
|
|
RecreateWnd;
|
|
end;
|
|
end;
|
|
|
|
function TRxCustomListBox.GetAutoScroll: Boolean;
|
|
begin
|
|
Result := FAutoScroll and (Columns = 0);
|
|
end;
|
|
|
|
procedure TRxCustomListBox.SetOnDrawItem(Value: TDrawItemEvent);
|
|
begin
|
|
if Assigned(FOnDrawItem) <> Assigned(Value) then begin
|
|
FOnDrawItem := Value;
|
|
Perform(WM_HSCROLL, SB_TOP, 0);
|
|
if HandleAllocated then
|
|
if AutoScroll then ResetHorizontalExtent
|
|
else SendMessage(Handle, LB_SETHORIZONTALEXTENT, 0, 0);
|
|
end
|
|
else FOnDrawItem := Value;
|
|
end;
|
|
|
|
procedure TRxCustomListBox.SetOnGetItemWidth(Value: TGetItemWidthEvent);
|
|
begin
|
|
if Assigned(FOnGetItemWidth) <> Assigned(Value) then begin
|
|
FOnGetItemWidth := Value;
|
|
Perform(WM_HSCROLL, SB_TOP, 0);
|
|
if HandleAllocated then
|
|
if AutoScroll then ResetHorizontalExtent
|
|
else SendMessage(Handle, LB_SETHORIZONTALEXTENT, 0, 0);
|
|
end
|
|
else FOnGetItemWidth := Value;
|
|
end;
|
|
|
|
procedure TRxCustomListBox.SetAutoScroll(Value: Boolean);
|
|
begin
|
|
if AutoScroll <> Value then begin
|
|
FAutoScroll := Value;
|
|
Perform(WM_HSCROLL, SB_TOP, 0);
|
|
if HandleAllocated then begin
|
|
if AutoScroll then ResetHorizontalExtent
|
|
else SendMessage(Handle, LB_SETHORIZONTALEXTENT, 0, 0);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TRxCustomListBox.GetItemHeight: Integer;
|
|
var
|
|
R: TRect;
|
|
begin
|
|
Result := FItemHeight;
|
|
if HandleAllocated and (FStyle = lbStandard) then begin
|
|
Perform(LB_GETITEMRECT, 0, Longint(@R));
|
|
Result := R.Bottom - R.Top;
|
|
end;
|
|
end;
|
|
|
|
procedure TRxCustomListBox.SetItemHeight(Value: Integer);
|
|
begin
|
|
if (FItemHeight <> Value) and (Value > 0) then begin
|
|
FItemHeight := Value;
|
|
RecreateWnd;
|
|
end;
|
|
end;
|
|
|
|
procedure TRxCustomListBox.SetTabWidth(Value: Integer);
|
|
begin
|
|
if Value < 0 then Value := 0;
|
|
if FTabWidth <> Value then begin
|
|
FTabWidth := Value;
|
|
RecreateWnd;
|
|
end;
|
|
end;
|
|
|
|
procedure TRxCustomListBox.SetMultiSelect(Value: Boolean);
|
|
begin
|
|
if FMultiSelect <> Value then begin
|
|
FMultiSelect := Value;
|
|
RecreateWnd;
|
|
end;
|
|
end;
|
|
|
|
function TRxCustomListBox.GetSelected(Index: Integer): Boolean;
|
|
var
|
|
R: Longint;
|
|
begin
|
|
R := SendMessage(Handle, LB_GETSEL, Index, 0);
|
|
if R = LB_ERR then ListIndexError(Index);
|
|
Result := LongBool(R);
|
|
end;
|
|
|
|
procedure TRxCustomListBox.SetSelected(Index: Integer; Value: Boolean);
|
|
begin
|
|
if MultiSelect then begin
|
|
if SendMessage(Handle, LB_SETSEL, Ord(Value), Index) = LB_ERR then
|
|
ListIndexError(Index);
|
|
end
|
|
else begin
|
|
if Value then SetItemIndex(Index)
|
|
else if (ItemIndex = Index) then SetItemIndex(-1);
|
|
end;
|
|
end;
|
|
|
|
procedure TRxCustomListBox.SetSorted(Value: Boolean);
|
|
begin
|
|
if FSorted <> Value then begin
|
|
FSorted := Value;
|
|
RecreateWnd;
|
|
end;
|
|
end;
|
|
|
|
procedure TRxCustomListBox.SetStyle(Value: TListBoxStyle);
|
|
begin
|
|
if FStyle <> Value then begin
|
|
FStyle := Value;
|
|
RecreateWnd;
|
|
end;
|
|
end;
|
|
|
|
function TRxCustomListBox.GetTopIndex: Integer;
|
|
begin
|
|
Result := SendMessage(Handle, LB_GETTOPINDEX, 0, 0);
|
|
end;
|
|
|
|
procedure TRxCustomListBox.SetBorderStyle(Value: TBorderStyle);
|
|
begin
|
|
if FBorderStyle <> Value then begin
|
|
FBorderStyle := Value;
|
|
RecreateWnd;
|
|
end;
|
|
end;
|
|
|
|
procedure TRxCustomListBox.SetTopIndex(Value: Integer);
|
|
begin
|
|
if GetTopIndex <> Value then SendMessage(Handle, LB_SETTOPINDEX, Value, 0);
|
|
end;
|
|
|
|
procedure TRxCustomListBox.SetGraySelection(Value: Boolean);
|
|
begin
|
|
if FGraySelection <> Value then begin
|
|
FGraySelection := Value;
|
|
if not Focused then Invalidate;
|
|
end;
|
|
end;
|
|
|
|
procedure TRxCustomListBox.SetItems(Value: TStrings);
|
|
begin
|
|
Items.Assign(Value);
|
|
end;
|
|
|
|
function TRxCustomListBox.ItemAtPos(Pos: TPoint; Existing: Boolean): Integer;
|
|
var
|
|
Count: Integer;
|
|
ItemRect: TRect;
|
|
begin
|
|
if PtInRect(ClientRect, Pos) then begin
|
|
Result := TopIndex;
|
|
Count := Items.Count;
|
|
while Result < Count do begin
|
|
Perform(LB_GETITEMRECT, Result, Longint(@ItemRect));
|
|
if PtInRect(ItemRect, Pos) then Exit;
|
|
Inc(Result);
|
|
end;
|
|
if not Existing then Exit;
|
|
end;
|
|
Result := -1;
|
|
end;
|
|
|
|
function TRxCustomListBox.ItemRect(Index: Integer): TRect;
|
|
var
|
|
Count: Integer;
|
|
begin
|
|
Count := Items.Count;
|
|
if (Index = 0) or (Index < Count) then
|
|
Perform(LB_GETITEMRECT, Index, Longint(@Result))
|
|
else if Index = Count then begin
|
|
Perform(LB_GETITEMRECT, Index - 1, Longint(@Result));
|
|
OffsetRect(Result, 0, Result.Bottom - Result.Top);
|
|
end
|
|
else FillChar(Result, SizeOf(Result), 0);
|
|
end;
|
|
|
|
procedure TRxCustomListBox.CreateParams(var Params: TCreateParams);
|
|
type
|
|
PSelects = ^TSelects;
|
|
TSelects = array[Boolean] of Longword;
|
|
const
|
|
BorderStyles: array[TBorderStyle] of Longword = (0, WS_BORDER);
|
|
Styles: array[TListBoxStyle] of Longword =
|
|
(0, LBS_OWNERDRAWFIXED, LBS_OWNERDRAWVARIABLE
|
|
{$IFDEF RX_D6}, LBS_OWNERDRAWFIXED, LBS_OWNERDRAWFIXED{$ENDIF});
|
|
Sorteds: array[Boolean] of Longword = (0, LBS_SORT);
|
|
MultiSelects: array[Boolean] of Longword = (0, LBS_MULTIPLESEL);
|
|
ExtendSelects: array[Boolean] of Longword = (0, LBS_EXTENDEDSEL);
|
|
IntegralHeights: array[Boolean] of Longword = (LBS_NOINTEGRALHEIGHT, 0);
|
|
MultiColumns: array[Boolean] of Longword = (0, LBS_MULTICOLUMN);
|
|
TabStops: array[Boolean] of Longword = (0, LBS_USETABSTOPS);
|
|
var
|
|
Selects: PSelects;
|
|
begin
|
|
inherited CreateParams(Params);
|
|
CreateSubClass(Params, 'LISTBOX');
|
|
with Params do begin
|
|
{$IFNDEF WIN32}
|
|
Inc(X); Inc(Y);
|
|
Dec(Width, 2); Dec(Height, 2);
|
|
{$ENDIF}
|
|
Selects := @MultiSelects;
|
|
if FExtendedSelect then Selects := @ExtendSelects;
|
|
Style := Style or (WS_HSCROLL or WS_VSCROLL or LBS_HASSTRINGS or
|
|
LBS_NOTIFY) or Styles[FStyle] or Sorteds[FSorted] or
|
|
Selects^[FMultiSelect] or IntegralHeights[FIntegralHeight] or
|
|
MultiColumns[FColumns <> 0] or BorderStyles[FBorderStyle] or
|
|
TabStops[FTabWidth <> 0];
|
|
{$IFDEF WIN32}
|
|
if NewStyleControls and Ctl3D and (FBorderStyle = bsSingle) then begin
|
|
Style := Style and not WS_BORDER;
|
|
ExStyle := ExStyle or WS_EX_CLIENTEDGE;
|
|
end;
|
|
{$ENDIF}
|
|
WindowClass.Style := WindowClass.Style and not (CS_HREDRAW or CS_VREDRAW);
|
|
end;
|
|
end;
|
|
|
|
procedure TRxCustomListBox.CreateWnd;
|
|
var
|
|
W, H: Integer;
|
|
begin
|
|
W := Width;
|
|
H := Height;
|
|
inherited CreateWnd;
|
|
SetWindowPos(Handle, 0, Left, Top, W, H, SWP_NOZORDER or SWP_NOACTIVATE);
|
|
if FTabWidth <> 0 then
|
|
SendMessage(Handle, LB_SETTABSTOPS, 1, Longint(@FTabWidth));
|
|
SetColumnWidth;
|
|
if FSaveItems <> nil then begin
|
|
FItems.Assign(FSaveItems);
|
|
SetTopIndex(FSaveTopIndex);
|
|
SetItemIndex(FSaveItemIndex);
|
|
FSaveItems.Free;
|
|
FSaveItems := nil;
|
|
end;
|
|
end;
|
|
|
|
procedure TRxCustomListBox.DestroyWnd;
|
|
begin
|
|
if FItems.Count > 0 then begin
|
|
FSaveItems := TStringList.Create;
|
|
FSaveItems.Assign(FItems);
|
|
FSaveTopIndex := GetTopIndex;
|
|
FSaveItemIndex := GetItemIndex;
|
|
end;
|
|
inherited DestroyWnd;
|
|
end;
|
|
|
|
procedure TRxCustomListBox.WndProc(var Message: TMessage);
|
|
begin
|
|
if AutoScroll then begin
|
|
case Message.Msg of
|
|
LB_ADDSTRING, LB_INSERTSTRING:
|
|
begin
|
|
inherited WndProc(Message);
|
|
FMaxItemWidth := Max(FMaxItemWidth, GetItemWidth(Message.Result));
|
|
SetHorizontalExtent;
|
|
Exit;
|
|
end;
|
|
LB_DELETESTRING:
|
|
begin
|
|
if GetItemWidth(Message.wParam) >= FMaxItemWidth then begin
|
|
Perform(WM_HSCROLL, SB_TOP, 0);
|
|
inherited WndProc(Message);
|
|
ResetHorizontalExtent;
|
|
end
|
|
else inherited WndProc(Message);
|
|
Exit;
|
|
end;
|
|
LB_RESETCONTENT:
|
|
begin
|
|
FMaxItemWidth := 0;
|
|
SetHorizontalExtent;
|
|
Perform(WM_HSCROLL, SB_TOP, 0);
|
|
inherited WndProc(Message);
|
|
Exit;
|
|
end;
|
|
WM_SETFONT:
|
|
begin
|
|
inherited WndProc(Message);
|
|
Canvas.Font.Assign(Self.Font);
|
|
ResetHorizontalExtent;
|
|
Exit;
|
|
end;
|
|
end;
|
|
end;
|
|
{for auto drag mode, let listbox handle itself, instead of TControl}
|
|
if not (csDesigning in ComponentState) and ((Message.Msg = WM_LBUTTONDOWN) or
|
|
(Message.Msg = WM_LBUTTONDBLCLK)) and not Dragging then
|
|
begin
|
|
if DragMode = dmAutomatic then begin
|
|
if IsControlMouseMsg(TWMMouse(Message)) then Exit;
|
|
ControlState := ControlState + [csLButtonDown];
|
|
Dispatch(Message); {overrides TControl's BeginDrag}
|
|
Exit;
|
|
end;
|
|
end;
|
|
inherited WndProc(Message);
|
|
end;
|
|
|
|
procedure TRxCustomListBox.WMLButtonDown(var Message: TWMLButtonDown);
|
|
var
|
|
ItemNo: Integer;
|
|
ShiftState: TShiftState;
|
|
begin
|
|
ShiftState := KeysToShiftState(Message.Keys);
|
|
if (DragMode = dmAutomatic) and FMultiSelect then begin
|
|
if not (ssShift in ShiftState) or (ssCtrl in ShiftState) then begin
|
|
ItemNo := ItemAtPos(SmallPointToPoint(Message.Pos), True);
|
|
if (ItemNo >= 0) and (Selected[ItemNo]) then begin
|
|
BeginDrag(False);
|
|
Exit;
|
|
end;
|
|
end;
|
|
end;
|
|
inherited;
|
|
if (DragMode = dmAutomatic) and not (FMultiSelect and
|
|
((ssCtrl in ShiftState) or (ssShift in ShiftState))) then
|
|
BeginDrag(False);
|
|
end;
|
|
|
|
procedure TRxCustomListBox.WMNCHitTest(var Msg: TWMNCHitTest);
|
|
begin
|
|
if csDesigning in ComponentState then DefaultHandler(Msg)
|
|
else inherited;
|
|
end;
|
|
|
|
procedure TRxCustomListBox.CNCommand(var Message: TWMCommand);
|
|
begin
|
|
case Message.NotifyCode of
|
|
LBN_SELCHANGE:
|
|
begin
|
|
{$IFDEF RX_D3}
|
|
inherited Changed;
|
|
{$ENDIF}
|
|
Click;
|
|
end;
|
|
LBN_DBLCLK: DblClick;
|
|
end;
|
|
end;
|
|
|
|
procedure TRxCustomListBox.WMPaint(var Message: TWMPaint);
|
|
|
|
procedure PaintListBox;
|
|
var
|
|
DrawItemMsg: TWMDrawItem;
|
|
MeasureItemMsg: TWMMeasureItem;
|
|
DrawItemStruct: TDrawItemStruct;
|
|
MeasureItemStruct: TMeasureItemStruct;
|
|
R: TRect;
|
|
Y, I, H, W: Integer;
|
|
begin
|
|
{ Initialize drawing records }
|
|
DrawItemMsg.Msg := CN_DRAWITEM;
|
|
DrawItemMsg.DrawItemStruct := @DrawItemStruct;
|
|
DrawItemMsg.Ctl := Handle;
|
|
DrawItemStruct.CtlType := ODT_LISTBOX;
|
|
DrawItemStruct.itemAction := ODA_DRAWENTIRE;
|
|
DrawItemStruct.itemState := 0;
|
|
DrawItemStruct.hDC := Message.DC;
|
|
DrawItemStruct.CtlID := Handle;
|
|
DrawItemStruct.hwndItem := Handle;
|
|
{ Intialize measure records }
|
|
MeasureItemMsg.Msg := CN_MEASUREITEM;
|
|
MeasureItemMsg.IDCtl := Handle;
|
|
MeasureItemMsg.MeasureItemStruct := @MeasureItemStruct;
|
|
MeasureItemStruct.CtlType := ODT_LISTBOX;
|
|
MeasureItemStruct.CtlID := Handle;
|
|
{ Draw the listbox }
|
|
Y := 0;
|
|
I := TopIndex;
|
|
GetClipBox(Message.DC, R);
|
|
H := Height;
|
|
W := Width;
|
|
while Y < H do begin
|
|
MeasureItemStruct.itemID := I;
|
|
if I < Items.Count then
|
|
MeasureItemStruct.itemData := Longint(Pointer(Items.Objects[I]));
|
|
MeasureItemStruct.itemWidth := W;
|
|
MeasureItemStruct.itemHeight := FItemHeight;
|
|
DrawItemStruct.itemData := MeasureItemStruct.itemData;
|
|
DrawItemStruct.itemID := I;
|
|
Dispatch(MeasureItemMsg);
|
|
DrawItemStruct.rcItem := Rect(0, Y, MeasureItemStruct.itemWidth,
|
|
Y + Integer(MeasureItemStruct.itemHeight));
|
|
Dispatch(DrawItemMsg);
|
|
Inc(Y, MeasureItemStruct.itemHeight);
|
|
Inc(I);
|
|
if I >= Items.Count then break;
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
if Message.DC <> 0 then PaintListBox
|
|
else inherited;
|
|
end;
|
|
|
|
procedure TRxCustomListBox.WMSize(var Message: TWMSize);
|
|
begin
|
|
inherited;
|
|
SetColumnWidth;
|
|
end;
|
|
|
|
procedure TRxCustomListBox.DragCanceled;
|
|
var
|
|
M: TWMMouse;
|
|
{$IFDEF WIN32}
|
|
MousePos: TPoint;
|
|
{$ENDIF}
|
|
begin
|
|
with M do begin
|
|
Msg := WM_LBUTTONDOWN;
|
|
{$IFDEF WIN32}
|
|
GetCursorPos(MousePos);
|
|
Pos := PointToSmallPoint(ScreenToClient(MousePos));
|
|
{$ELSE}
|
|
GetCursorPos(Pos);
|
|
Pos := ScreenToClient(Pos);
|
|
{$ENDIF}
|
|
Keys := 0;
|
|
Result := 0;
|
|
end;
|
|
DefaultHandler(M);
|
|
M.Msg := WM_LBUTTONUP;
|
|
DefaultHandler(M);
|
|
end;
|
|
|
|
procedure TRxCustomListBox.DefaultDrawText(X, Y: Integer; const S: string);
|
|
var
|
|
ATabWidth: Longint;
|
|
begin
|
|
{$IFDEF RX_D4}
|
|
TControlCanvas(FCanvas).UpdateTextFlags;
|
|
{$ENDIF}
|
|
if FTabWidth = 0 then FCanvas.TextOut(X, Y, S)
|
|
else begin
|
|
ATabWidth := Round((TabWidth * Canvas.TextWidth('0')) * 0.25);
|
|
TabbedTextOut(FCanvas.Handle, X, Y, @S[1], Length(S), 1, ATabWidth, X);
|
|
end;
|
|
end;
|
|
|
|
procedure TRxCustomListBox.DrawItem(Index: Integer; Rect: TRect;
|
|
State: TOwnerDrawState);
|
|
begin
|
|
if Assigned(FOnDrawItem) then FOnDrawItem(Self, Index, Rect, State)
|
|
else begin
|
|
FCanvas.FillRect(Rect);
|
|
if Index < Items.Count then begin
|
|
{$IFDEF RX_D4}
|
|
if not UseRightToLeftAlignment then Inc(Rect.Left, 2)
|
|
else Dec(Rect.Right, 2);
|
|
{$ELSE}
|
|
Inc(Rect.Left, 2);
|
|
{$ENDIF}
|
|
DefaultDrawText(Rect.Left, Max(Rect.Top, (Rect.Bottom +
|
|
Rect.Top - Canvas.TextHeight('Wy')) div 2), Items[Index]);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TRxCustomListBox.MeasureItem(Index: Integer; var Height: Integer);
|
|
begin
|
|
if Assigned(FOnMeasureItem) then FOnMeasureItem(Self, Index, Height)
|
|
end;
|
|
|
|
procedure TRxCustomListBox.CNDrawItem(var Message: TWMDrawItem);
|
|
var
|
|
State: TOwnerDrawState;
|
|
begin
|
|
with Message.DrawItemStruct^ do begin
|
|
{$IFDEF WIN32}
|
|
{$IFDEF RX_D5}
|
|
State := TOwnerDrawState(LongRec(itemState).Lo);
|
|
{$ELSE}
|
|
State := TOwnerDrawState(WordRec(LongRec(itemState).Lo).Lo);
|
|
{$ENDIF}
|
|
{$ELSE}
|
|
State := TOwnerDrawState(WordRec(itemState).Lo);
|
|
{$ENDIF}
|
|
FCanvas.Handle := hDC;
|
|
FCanvas.Font := Font;
|
|
FCanvas.Brush := Brush;
|
|
if (Integer(itemID) >= 0) and (odSelected in State) then begin
|
|
with FCanvas do
|
|
if not (csDesigning in ComponentState) and FGraySelection and
|
|
not Focused then
|
|
begin
|
|
Brush.Color := clBtnFace;
|
|
if ColorToRGB(Font.Color) = ColorToRGB(clBtnFace) then
|
|
Font.Color := clBtnText;
|
|
end
|
|
else begin
|
|
Brush.Color := clHighlight;
|
|
Font.Color := clHighlightText
|
|
end;
|
|
end;
|
|
if Integer(itemID) >= 0 then DrawItem(itemID, rcItem, State)
|
|
else FCanvas.FillRect(rcItem);
|
|
if odFocused in State then DrawFocusRect(hDC, rcItem);
|
|
FCanvas.Handle := 0;
|
|
end;
|
|
end;
|
|
|
|
procedure TRxCustomListBox.CNMeasureItem(var Message: TWMMeasureItem);
|
|
begin
|
|
with Message.MeasureItemStruct^ do begin
|
|
itemHeight := FItemHeight;
|
|
if FStyle = lbOwnerDrawVariable then
|
|
MeasureItem(itemID, Integer(itemHeight));
|
|
end;
|
|
end;
|
|
|
|
procedure TRxCustomListBox.WMKillFocus(var Msg: TWMKillFocus);
|
|
begin
|
|
inherited;
|
|
if FGraySelection and MultiSelect and (SelCount > 1) then Invalidate;
|
|
end;
|
|
|
|
procedure TRxCustomListBox.WMSetFocus(var Msg: TWMSetFocus);
|
|
begin
|
|
inherited;
|
|
if FGraySelection and MultiSelect and (SelCount > 1) then Invalidate;
|
|
end;
|
|
|
|
{$IFDEF WIN32}
|
|
procedure TRxCustomListBox.CMCtl3DChanged(var Message: TMessage);
|
|
begin
|
|
if NewStyleControls and (FBorderStyle = bsSingle) then RecreateWnd;
|
|
inherited;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
{ TCheckListBoxItem }
|
|
|
|
type
|
|
TCheckListBoxItem = class
|
|
private
|
|
FData: LongInt;
|
|
FState: TCheckBoxState;
|
|
FEnabled: Boolean;
|
|
function GetChecked: Boolean;
|
|
public
|
|
constructor Create;
|
|
property Checked: Boolean read GetChecked;
|
|
property Enabled: Boolean read FEnabled write FEnabled;
|
|
property State: TCheckBoxState read FState write FState;
|
|
end;
|
|
|
|
constructor TCheckListBoxItem.Create;
|
|
begin
|
|
inherited Create;
|
|
FState := clbDefaultState;
|
|
FEnabled := clbDefaultEnabled;
|
|
end;
|
|
|
|
function TCheckListBoxItem.GetChecked: Boolean;
|
|
begin
|
|
Result := FState = cbChecked;
|
|
end;
|
|
|
|
{ TCheckListBoxStrings }
|
|
|
|
type
|
|
TCheckListBoxStrings = class(TRxListBoxStrings)
|
|
public
|
|
procedure Exchange(Index1, Index2: Integer); override;
|
|
procedure Move(CurIndex, NewIndex: Integer); override;
|
|
end;
|
|
|
|
procedure TCheckListBoxStrings.Exchange(Index1, Index2: Integer);
|
|
var
|
|
TempEnabled1, TempEnabled2: Boolean;
|
|
TempState1, TempState2: TCheckBoxState;
|
|
begin
|
|
with TRxCheckListBox(ListBox) do begin
|
|
TempState1 := State[Index1];
|
|
TempEnabled1 := EnabledItem[Index1];
|
|
TempState2 := State[Index2];
|
|
TempEnabled2 := EnabledItem[Index2];
|
|
inherited Exchange(Index1, Index2);
|
|
State[Index1] := TempState2;
|
|
EnabledItem[Index1] := TempEnabled2;
|
|
State[Index2] := TempState1;
|
|
EnabledItem[Index2] := TempEnabled1;
|
|
end;
|
|
end;
|
|
|
|
procedure TCheckListBoxStrings.Move(CurIndex, NewIndex: Integer);
|
|
var
|
|
TempEnabled: Boolean;
|
|
TempState: TCheckBoxState;
|
|
begin
|
|
with TRxCheckListBox(ListBox) do begin
|
|
TempState := State[CurIndex];
|
|
TempEnabled := EnabledItem[CurIndex];
|
|
inherited Move(CurIndex, NewIndex);
|
|
State[NewIndex] := TempState;
|
|
EnabledItem[NewIndex] := TempEnabled;
|
|
end;
|
|
end;
|
|
|
|
{ TRxCheckListBox }
|
|
|
|
const
|
|
FCheckBitmap: TBitmap = nil;
|
|
|
|
function CheckBitmap: TBitmap;
|
|
begin
|
|
if FCheckBitmap = nil then begin
|
|
FCheckBitmap := TBitmap.Create;
|
|
FCheckBitmap.Handle := LoadBitmap(hInstance, 'CHECK_IMAGES');
|
|
end;
|
|
Result := FCheckBitmap;
|
|
end;
|
|
|
|
procedure DestroyLocals; far;
|
|
begin
|
|
if FCheckBitmap <> nil then begin
|
|
FCheckBitmap.Free;
|
|
FCheckBitmap := nil;
|
|
end;
|
|
end;
|
|
|
|
const
|
|
InternalVersion = 202; { for backward compatibility only }
|
|
|
|
constructor TRxCheckListBox.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
FAutoScroll := True;
|
|
with CheckBitmap do begin
|
|
FCheckWidth := Width div 6;
|
|
FCheckHeight := Height div 3;
|
|
end;
|
|
FDrawBitmap := TBitmap.Create;
|
|
with FDrawBitmap do begin
|
|
Width := FCheckWidth;
|
|
Height := FCheckHeight;
|
|
end;
|
|
FIniLink := TIniLink.Create;
|
|
FIniLink.OnSave := IniSave;
|
|
FIniLink.OnLoad := IniLoad;
|
|
end;
|
|
|
|
destructor TRxCheckListBox.Destroy;
|
|
begin
|
|
FSaveStates.Free;
|
|
FSaveStates := nil;
|
|
FDrawBitmap.Free;
|
|
FDrawBitmap := nil;
|
|
FIniLink.Free;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TRxCheckListBox.Loaded;
|
|
begin
|
|
inherited Loaded;
|
|
UpdateCheckStates;
|
|
end;
|
|
|
|
function TRxCheckListBox.CreateItemList: TStrings;
|
|
begin
|
|
Result := TCheckListBoxStrings.Create;
|
|
end;
|
|
|
|
const
|
|
sCount = 'Count';
|
|
sItem = 'Item';
|
|
|
|
procedure TRxCheckListBox.InternalSaveStates(IniFile: TObject;
|
|
const Section: string);
|
|
var
|
|
I: Integer;
|
|
begin
|
|
IniEraseSection(IniFile, Section);
|
|
IniWriteInteger(IniFile, Section, sCount, Items.Count);
|
|
for I := 0 to Items.Count - 1 do
|
|
IniWriteInteger(IniFile, Section, sItem + IntToStr(I), Integer(State[I]));
|
|
end;
|
|
|
|
procedure TRxCheckListBox.InternalRestoreStates(IniFile: TObject;
|
|
const Section: string);
|
|
var
|
|
I: Integer;
|
|
ACount: Integer;
|
|
begin
|
|
ACount := Min(IniReadInteger(IniFile, Section, sCount, 0), Items.Count);
|
|
for I := 0 to ACount - 1 do begin
|
|
State[I] := TCheckBoxState(IniReadInteger(IniFile, Section,
|
|
sItem + IntToStr(I), Integer(clbDefaultState)));
|
|
if (State[I] = cbChecked) and (FCheckKind = ckRadioButtons) then Exit;
|
|
end;
|
|
end;
|
|
|
|
{$IFDEF WIN32}
|
|
procedure TRxCheckListBox.SaveStatesReg(IniFile: TRegIniFile);
|
|
begin
|
|
InternalSaveStates(IniFile, GetDefaultSection(Self));
|
|
end;
|
|
|
|
procedure TRxCheckListBox.RestoreStatesReg(IniFile: TRegIniFile);
|
|
begin
|
|
InternalRestoreStates(IniFile, GetDefaultSection(Self));
|
|
end;
|
|
{$ENDIF WIN32}
|
|
|
|
procedure TRxCheckListBox.SaveStates(IniFile: TIniFile);
|
|
begin
|
|
InternalSaveStates(IniFile, GetDefaultSection(Self));
|
|
end;
|
|
|
|
procedure TRxCheckListBox.RestoreStates(IniFile: TIniFile);
|
|
begin
|
|
InternalRestoreStates(IniFile, GetDefaultSection(Self));
|
|
end;
|
|
|
|
function TRxCheckListBox.GetStorage: TFormPlacement;
|
|
begin
|
|
Result := FIniLink.Storage;
|
|
end;
|
|
|
|
procedure TRxCheckListBox.SetStorage(Value: TFormPlacement);
|
|
begin
|
|
FIniLink.Storage := Value;
|
|
end;
|
|
|
|
procedure TRxCheckListBox.IniSave(Sender: TObject);
|
|
begin
|
|
if (Name <> '') and (FIniLink.IniObject <> nil) then
|
|
InternalSaveStates(FIniLink.IniObject, FIniLink.RootSection +
|
|
GetDefaultSection(Self));
|
|
end;
|
|
|
|
procedure TRxCheckListBox.IniLoad(Sender: TObject);
|
|
begin
|
|
if (Name <> '') and (FIniLink.IniObject <> nil) then
|
|
InternalRestoreStates(FIniLink.IniObject, FIniLink.RootSection +
|
|
GetDefaultSection(Self));
|
|
end;
|
|
|
|
procedure TRxCheckListBox.ReadCheckData(Reader: TReader);
|
|
var
|
|
I: Integer;
|
|
begin
|
|
Items.BeginUpdate;
|
|
try
|
|
Reader.ReadListBegin;
|
|
Clear;
|
|
while not Reader.EndOfList do begin
|
|
I := Items.Add(Reader.ReadString);
|
|
if FReserved >= InternalVersion then begin
|
|
State[I] := TCheckBoxState(Reader.ReadInteger);
|
|
EnabledItem[I] := Reader.ReadBoolean;
|
|
end
|
|
else begin { for backward compatibility only }
|
|
Checked[I] := Reader.ReadBoolean;
|
|
EnabledItem[I] := Reader.ReadBoolean;
|
|
if FReserved > 0 then
|
|
State[I] := TCheckBoxState(Reader.ReadInteger);
|
|
end;
|
|
end;
|
|
Reader.ReadListEnd;
|
|
UpdateCheckStates;
|
|
finally
|
|
Items.EndUpdate;
|
|
end;
|
|
end;
|
|
|
|
procedure TRxCheckListBox.WriteCheckData(Writer: TWriter);
|
|
var
|
|
I: Integer;
|
|
begin
|
|
with Writer do begin
|
|
WriteListBegin;
|
|
for I := 0 to Items.Count - 1 do begin
|
|
WriteString(Items[I]);
|
|
WriteInteger(Integer(Self.State[I]));
|
|
WriteBoolean(EnabledItem[I]);
|
|
end;
|
|
WriteListEnd;
|
|
end;
|
|
end;
|
|
|
|
procedure TRxCheckListBox.ReadVersion(Reader: TReader);
|
|
begin
|
|
FReserved := Reader.ReadInteger;
|
|
end;
|
|
|
|
procedure TRxCheckListBox.WriteVersion(Writer: TWriter);
|
|
begin
|
|
Writer.WriteInteger(InternalVersion);
|
|
end;
|
|
|
|
procedure TRxCheckListBox.DefineProperties(Filer: TFiler);
|
|
|
|
{$IFDEF WIN32}
|
|
function DoWrite: Boolean;
|
|
var
|
|
I: Integer;
|
|
Ancestor: TRxCheckListBox;
|
|
begin
|
|
Result := False;
|
|
Ancestor := TRxCheckListBox(Filer.Ancestor);
|
|
if (Ancestor <> nil) and (Ancestor.Items.Count = Items.Count) and
|
|
(Ancestor.Items.Count > 0) then
|
|
for I := 1 to Items.Count - 1 do begin
|
|
Result := (CompareText(Items[I], Ancestor.Items[I]) <> 0) or
|
|
(State[I] <> Ancestor.State[I]) or
|
|
(EnabledItem[I] <> Ancestor.EnabledItem[I]);
|
|
if Result then Break;
|
|
end
|
|
else Result := Items.Count > 0;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
begin
|
|
inherited DefineProperties(Filer);
|
|
Filer.DefineProperty('InternalVersion', ReadVersion, WriteVersion,
|
|
{$IFDEF WIN32} Filer.Ancestor = nil {$ELSE} True {$ENDIF});
|
|
Filer.DefineProperty('Strings', ReadCheckData, WriteCheckData,
|
|
{$IFDEF WIN32} DoWrite {$ELSE} Items.Count > 0 {$ENDIF});
|
|
end;
|
|
|
|
procedure TRxCheckListBox.CreateWnd;
|
|
begin
|
|
inherited CreateWnd;
|
|
if FSaveStates <> nil then begin
|
|
FSaveStates.Free;
|
|
FSaveStates := nil;
|
|
end;
|
|
ResetItemHeight;
|
|
end;
|
|
|
|
procedure TRxCheckListBox.DestroyWnd;
|
|
begin
|
|
inherited DestroyWnd;
|
|
end;
|
|
|
|
procedure TRxCheckListBox.WMDestroy(var Msg: TWMDestroy);
|
|
var
|
|
I: Integer;
|
|
begin
|
|
if Items.Count > 0 then begin
|
|
if FSaveStates <> nil then FSaveStates.Clear
|
|
else FSaveStates := TList.Create;
|
|
for I := 0 to Items.Count - 1 do begin
|
|
FSaveStates.Add(TObject(MakeLong(Ord(EnabledItem[I]), Word(State[I]))));
|
|
FindCheckObject(I).Free;
|
|
end;
|
|
end;
|
|
inherited;
|
|
end;
|
|
|
|
procedure TRxCheckListBox.CreateParams(var Params: TCreateParams);
|
|
begin
|
|
inherited CreateParams(Params);
|
|
with Params do
|
|
if Style and (LBS_OWNERDRAWFIXED or LBS_OWNERDRAWVARIABLE) = 0 then
|
|
Style := Style or LBS_OWNERDRAWFIXED;
|
|
end;
|
|
|
|
procedure TRxCheckListBox.SetItems(Value: TStrings);
|
|
var
|
|
I: Integer;
|
|
begin
|
|
Items.BeginUpdate;
|
|
try
|
|
inherited SetItems(Value);
|
|
if (Value <> nil) and (Value is TRxListBoxStrings) and
|
|
(TRxListBoxStrings(Value).ListBox <> nil) and
|
|
(TRxListBoxStrings(Value).ListBox is TRxCheckListBox) then
|
|
begin
|
|
for I := 0 to Items.Count - 1 do
|
|
if I < Value.Count then begin
|
|
Self.State[I] := TRxCheckListBox(TRxListBoxStrings(Value).ListBox).State[I];
|
|
EnabledItem[I] := TRxCheckListBox(TRxListBoxStrings(Value).ListBox).EnabledItem[I];
|
|
end;
|
|
end;
|
|
finally
|
|
Items.EndUpdate;
|
|
end;
|
|
end;
|
|
|
|
function TRxCheckListBox.GetItemWidth(Index: Integer): Integer;
|
|
begin
|
|
Result := inherited GetItemWidth(Index) + GetCheckWidth;
|
|
end;
|
|
|
|
function TRxCheckListBox.GetCheckWidth: Integer;
|
|
begin
|
|
Result := FCheckWidth + 2;
|
|
end;
|
|
|
|
function TRxCheckListBox.GetAllowGrayed: Boolean;
|
|
begin
|
|
Result := FAllowGrayed and (FCheckKind in [ckCheckBoxes, ckCheckMarks]);
|
|
end;
|
|
|
|
procedure TRxCheckListBox.CMFontChanged(var Message: TMessage);
|
|
begin
|
|
inherited;
|
|
ResetItemHeight;
|
|
end;
|
|
|
|
function TRxCheckListBox.GetItemHeight: Integer;
|
|
var
|
|
R: TRect;
|
|
begin
|
|
Result := FItemHeight;
|
|
if HandleAllocated and ((FStyle = lbStandard) or
|
|
((FStyle = lbOwnerDrawFixed) and not Assigned(FOnDrawItem))) then
|
|
begin
|
|
Perform(LB_GETITEMRECT, 0, Longint(@R));
|
|
Result := R.Bottom - R.Top;
|
|
end;
|
|
end;
|
|
|
|
procedure TRxCheckListBox.ResetItemHeight;
|
|
var
|
|
H: Integer;
|
|
begin
|
|
if (Style = lbStandard) or ((Style = lbOwnerDrawFixed) and
|
|
not Assigned(FOnDrawItem)) then
|
|
begin
|
|
Canvas.Font := Font;
|
|
H := Max(Canvas.TextHeight('Wg'), FCheckHeight);
|
|
if Style = lbOwnerDrawFixed then H := Max(H, FItemHeight);
|
|
Perform(LB_SETITEMHEIGHT, 0, H);
|
|
if (H * Items.Count) <= ClientHeight then
|
|
SetScrollRange(Handle, SB_VERT, 0, 0, True);
|
|
end;
|
|
end;
|
|
|
|
procedure TRxCheckListBox.DrawItem(Index: Integer; Rect: TRect;
|
|
State: TOwnerDrawState);
|
|
var
|
|
R: TRect;
|
|
SaveEvent: TDrawItemEvent;
|
|
begin
|
|
if Index < Items.Count then begin
|
|
R := Rect;
|
|
{$IFDEF RX_D4}
|
|
if not UseRightToLeftAlignment then begin
|
|
R.Right := Rect.Left;
|
|
R.Left := R.Right - GetCheckWidth;
|
|
end
|
|
else
|
|
begin
|
|
R.Left := Rect.Right;
|
|
R.Right := R.Left + GetCheckWidth;
|
|
end;
|
|
{$ELSE}
|
|
R.Right := Rect.Left;
|
|
R.Left := R.Right - GetCheckWidth;
|
|
{$ENDIF}
|
|
DrawCheck(R, GetState(Index), EnabledItem[Index]);
|
|
if not EnabledItem[Index] then
|
|
if odSelected in State then Canvas.Font.Color := clInactiveCaptionText
|
|
else Canvas.Font.Color := clGrayText;
|
|
end;
|
|
if (Style = lbStandard) and Assigned(FOnDrawItem) then begin
|
|
SaveEvent := OnDrawItem;
|
|
OnDrawItem := nil;
|
|
try
|
|
inherited DrawItem(Index, Rect, State);
|
|
finally
|
|
OnDrawItem := SaveEvent;
|
|
end;
|
|
end
|
|
else inherited DrawItem(Index, Rect, State);
|
|
end;
|
|
|
|
procedure TRxCheckListBox.CNDrawItem(var Message: TWMDrawItem);
|
|
begin
|
|
with Message.DrawItemStruct^ do
|
|
{$IFDEF RX_D4}
|
|
if not UseRightToLeftAlignment then
|
|
rcItem.Left := rcItem.Left + GetCheckWidth
|
|
else
|
|
rcItem.Right := rcItem.Right - GetCheckWidth;
|
|
{$ELSE}
|
|
rcItem.Left := rcItem.Left + GetCheckWidth;
|
|
{$ENDIF}
|
|
inherited;
|
|
end;
|
|
|
|
procedure TRxCheckListBox.DrawCheck(R: TRect; AState: TCheckBoxState;
|
|
Enabled: Boolean);
|
|
const
|
|
CheckImages: array[TCheckBoxState, TCheckKind, Boolean] of Integer =
|
|
(((3, 0), (9, 6), (15, 12)), { unchecked }
|
|
((4, 1), (10, 7), (16, 13)), { checked }
|
|
((5, 2), (11, 8), (17, 14))); { grayed }
|
|
var
|
|
DrawRect: TRect;
|
|
SaveColor: TColor;
|
|
begin
|
|
DrawRect.Left := R.Left + (R.Right - R.Left - FCheckWidth) div 2;
|
|
DrawRect.Top := R.Top + (R.Bottom - R.Top - FCheckHeight) div 2;
|
|
DrawRect.Right := DrawRect.Left + FCheckWidth;
|
|
DrawRect.Bottom := DrawRect.Top + FCheckHeight;
|
|
SaveColor := Canvas.Brush.Color;
|
|
AssignBitmapCell(CheckBitmap, FDrawBitmap, 6, 3,
|
|
CheckImages[AState, FCheckKind, Enabled]);
|
|
Canvas.Brush.Color := Self.Color;
|
|
try
|
|
Canvas.BrushCopy(DrawRect, FDrawBitmap, Bounds(0, 0, FCheckWidth,
|
|
FCheckHeight), CheckBitmap.TransparentColor and not PaletteMask);
|
|
finally
|
|
Canvas.Brush.Color := SaveColor;
|
|
end;
|
|
end;
|
|
|
|
procedure TRxCheckListBox.ApplyState(AState: TCheckBoxState;
|
|
EnabledOnly: Boolean);
|
|
var
|
|
I: Integer;
|
|
begin
|
|
if FCheckKind in [ckCheckBoxes, ckCheckMarks] then
|
|
for I := 0 to Items.Count - 1 do
|
|
if not EnabledOnly or EnabledItem[I] then begin
|
|
State[I] := AState;
|
|
end;
|
|
end;
|
|
|
|
function TRxCheckListBox.GetCheckedIndex: Integer;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
Result := -1;
|
|
if FCheckKind = ckRadioButtons then
|
|
for I := 0 to Items.Count - 1 do
|
|
if State[I] = cbChecked then begin
|
|
Result := I;
|
|
Exit;
|
|
end;
|
|
end;
|
|
|
|
procedure TRxCheckListBox.SetCheckedIndex(Value: Integer);
|
|
begin
|
|
if (FCheckKind = ckRadioButtons) and (Items.Count > 0) then
|
|
SetState(Max(Value, 0), cbChecked);
|
|
end;
|
|
|
|
procedure TRxCheckListBox.UpdateCheckStates;
|
|
begin
|
|
if (FCheckKind = ckRadioButtons) and (Items.Count > 0) then begin
|
|
FInUpdateStates := True;
|
|
try
|
|
SetState(Max(GetCheckedIndex, 0), cbChecked);
|
|
finally
|
|
FInUpdateStates := False;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TRxCheckListBox.SetCheckKind(Value: TCheckKind);
|
|
begin
|
|
if FCheckKind <> Value then begin
|
|
FCheckKind := Value;
|
|
UpdateCheckStates;
|
|
Invalidate;
|
|
end;
|
|
end;
|
|
|
|
procedure TRxCheckListBox.SetChecked(Index: Integer; AChecked: Boolean);
|
|
const
|
|
CheckStates: array[Boolean] of TCheckBoxState = (cbUnchecked, cbChecked);
|
|
begin
|
|
SetState(Index, CheckStates[AChecked]);
|
|
end;
|
|
|
|
procedure TRxCheckListBox.SetState(Index: Integer; AState: TCheckBoxState);
|
|
var
|
|
I: Integer;
|
|
begin
|
|
if (AState <> GetState(Index)) or FInUpdateStates then begin
|
|
if (FCheckKind = ckRadioButtons) and (AState = cbUnchecked) and
|
|
(GetCheckedIndex = Index) then Exit;
|
|
TCheckListBoxItem(GetCheckObject(Index)).State := AState;
|
|
if (FCheckKind = ckRadioButtons) and (AState = cbChecked) then
|
|
for I := Items.Count - 1 downto 0 do begin
|
|
if (I <> Index) and (GetState(I) = cbChecked) then begin
|
|
TCheckListBoxItem(GetCheckObject(I)).State := cbUnchecked;
|
|
InvalidateCheck(I);
|
|
end;
|
|
end;
|
|
InvalidateCheck(Index);
|
|
if not (csReading in ComponentState) then ChangeItemState(Index);
|
|
end;
|
|
end;
|
|
|
|
procedure TRxCheckListBox.SetItemEnabled(Index: Integer; Value: Boolean);
|
|
begin
|
|
if Value <> GetItemEnabled(Index) then begin
|
|
TCheckListBoxItem(GetCheckObject(Index)).Enabled := Value;
|
|
InvalidateItem(Index);
|
|
end;
|
|
end;
|
|
|
|
procedure TRxCheckListBox.InvalidateCheck(Index: Integer);
|
|
var
|
|
R: TRect;
|
|
begin
|
|
R := ItemRect(Index);
|
|
{$IFDEF RX_D4}
|
|
if not UseRightToLeftAlignment then R.Right := R.Left + GetCheckWidth
|
|
else R.Left := R.Right - GetCheckWidth;
|
|
{$ELSE}
|
|
R.Right := R.Left + GetCheckWidth;
|
|
{$ENDIF}
|
|
InvalidateRect(Handle, @R, not (csOpaque in ControlStyle));
|
|
UpdateWindow(Handle);
|
|
end;
|
|
|
|
procedure TRxCheckListBox.InvalidateItem(Index: Integer);
|
|
var
|
|
R: TRect;
|
|
begin
|
|
R := ItemRect(Index);
|
|
InvalidateRect(Handle, @R, not (csOpaque in ControlStyle));
|
|
UpdateWindow(Handle);
|
|
end;
|
|
|
|
function TRxCheckListBox.GetChecked(Index: Integer): Boolean;
|
|
begin
|
|
if IsCheckObject(Index) then
|
|
Result := TCheckListBoxItem(GetCheckObject(Index)).GetChecked
|
|
else Result := False;
|
|
end;
|
|
|
|
function TRxCheckListBox.GetState(Index: Integer): TCheckBoxState;
|
|
begin
|
|
if IsCheckObject(Index) then
|
|
Result := TCheckListBoxItem(GetCheckObject(Index)).State
|
|
else Result := clbDefaultState;
|
|
if (FCheckKind = ckRadioButtons) and (Result <> cbChecked) then
|
|
Result := cbUnchecked;
|
|
end;
|
|
|
|
function TRxCheckListBox.GetItemEnabled(Index: Integer): Boolean;
|
|
begin
|
|
if IsCheckObject(Index) then
|
|
Result := TCheckListBoxItem(GetCheckObject(Index)).Enabled
|
|
else Result := clbDefaultEnabled;
|
|
end;
|
|
|
|
procedure TRxCheckListBox.KeyPress(var Key: Char);
|
|
begin
|
|
inherited KeyPress(Key);
|
|
case Key of
|
|
' ':
|
|
begin
|
|
ToggleClickCheck(ItemIndex);
|
|
Key := #0;
|
|
end;
|
|
'+':
|
|
begin
|
|
ApplyState(cbChecked, True);
|
|
ClickCheck;
|
|
end;
|
|
'-':
|
|
begin
|
|
ApplyState(cbUnchecked, True);
|
|
ClickCheck;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TRxCheckListBox.MouseDown(Button: TMouseButton; Shift: TShiftState;
|
|
X, Y: Integer);
|
|
var
|
|
Index: Integer;
|
|
begin
|
|
inherited MouseDown(Button, Shift, X, Y);
|
|
if Button = mbLeft then begin
|
|
Index := ItemAtPos(Point(X,Y), True);
|
|
if (Index <> -1) then begin
|
|
{$IFDEF RX_D4}
|
|
if not UseRightToLeftAlignment then begin
|
|
if X - ItemRect(Index).Left < GetCheckWidth then
|
|
ToggleClickCheck(Index);
|
|
end
|
|
else begin
|
|
Dec(X, ItemRect(Index).Right - GetCheckWidth);
|
|
if (X > 0) and (X < GetCheckWidth) then
|
|
ToggleClickCheck(Index);
|
|
end;
|
|
{$ELSE}
|
|
if X - ItemRect(Index).Left < GetCheckWidth then
|
|
ToggleClickCheck(Index);
|
|
{$ENDIF}
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TRxCheckListBox.ToggleClickCheck(Index: Integer);
|
|
var
|
|
State: TCheckBoxState;
|
|
begin
|
|
if (Index >= 0) and (Index < Items.Count) and EnabledItem[Index] then begin
|
|
State := Self.State[Index];
|
|
case State of
|
|
cbUnchecked:
|
|
if AllowGrayed then State := cbGrayed else State := cbChecked;
|
|
cbChecked: State := cbUnchecked;
|
|
cbGrayed: State := cbChecked;
|
|
end;
|
|
Self.State[Index] := State;
|
|
ClickCheck;
|
|
end;
|
|
end;
|
|
|
|
procedure TRxCheckListBox.ChangeItemState(Index: Integer);
|
|
begin
|
|
if Assigned(FOnStateChange) then FOnStateChange(Self, Index);
|
|
end;
|
|
|
|
procedure TRxCheckListBox.ClickCheck;
|
|
begin
|
|
if Assigned(FOnClickCheck) then FOnClickCheck(Self);
|
|
end;
|
|
|
|
function TRxCheckListBox.GetItemData(Index: Integer): LongInt;
|
|
var
|
|
Item: TCheckListBoxItem;
|
|
begin
|
|
Result := 0;
|
|
if IsCheckObject(Index) then begin
|
|
Item := TCheckListBoxItem(GetCheckObject(Index));
|
|
if Item <> nil then Result := Item.FData;
|
|
end;
|
|
end;
|
|
|
|
function TRxCheckListBox.GetCheckObject(Index: Integer): TObject;
|
|
begin
|
|
Result := FindCheckObject(Index);
|
|
if Result = nil then Result := CreateCheckObject(Index);
|
|
end;
|
|
|
|
function TRxCheckListBox.FindCheckObject(Index: Integer): TObject;
|
|
var
|
|
ItemData: Longint;
|
|
begin
|
|
Result := nil;
|
|
ItemData := inherited GetItemData(Index);
|
|
if ItemData = LB_ERR then ListIndexError(Index)
|
|
else begin
|
|
Result := TCheckListBoxItem(ItemData);
|
|
if not (Result is TCheckListBoxItem) then Result := nil;
|
|
end;
|
|
end;
|
|
|
|
function TRxCheckListBox.CreateCheckObject(Index: Integer): TObject;
|
|
begin
|
|
Result := TCheckListBoxItem.Create;
|
|
inherited SetItemData(Index, LongInt(Result));
|
|
end;
|
|
|
|
function TRxCheckListBox.IsCheckObject(Index: Integer): Boolean;
|
|
begin
|
|
Result := FindCheckObject(Index) <> nil;
|
|
end;
|
|
|
|
procedure TRxCheckListBox.SetItemData(Index: Integer; AData: LongInt);
|
|
var
|
|
Item: TCheckListBoxItem;
|
|
L: Longint;
|
|
begin
|
|
Item := TCheckListBoxItem(GetCheckObject(Index));
|
|
Item.FData := AData;
|
|
if (FSaveStates <> nil) and (FSaveStates.Count > 0) then begin
|
|
L := Longint(Pointer(FSaveStates[0]));
|
|
Item.FState := TCheckBoxState(LongRec(L).Hi);
|
|
Item.FEnabled := LongRec(L).Lo <> 0;
|
|
FSaveStates.Delete(0);
|
|
end;
|
|
end;
|
|
|
|
procedure TRxCheckListBox.ResetContent;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
for I := Items.Count - 1 downto 0 do begin
|
|
if IsCheckObject(I) then GetCheckObject(I).Free;
|
|
inherited SetItemData(I, 0);
|
|
end;
|
|
inherited ResetContent;
|
|
end;
|
|
|
|
procedure TRxCheckListBox.DeleteString(Index: Integer);
|
|
begin
|
|
if IsCheckObject(Index) then GetCheckObject(Index).Free;
|
|
inherited SetItemData(Index, 0);
|
|
inherited DeleteString(Index);
|
|
end;
|
|
*)
|
|
{ TRxCustomLabel }
|
|
|
|
function DrawShadowText(DC: HDC; Str: PChar; Count: Integer; var Rect: TRect;
|
|
Format: Word; ShadowSize: Byte; ShadowColor: TColorRef;
|
|
ShadowPos: TShadowPosition): Integer;
|
|
var
|
|
RText, RShadow: TRect;
|
|
Color: TColorRef;
|
|
begin
|
|
RText := Rect;
|
|
RShadow := Rect;
|
|
Color := SetTextColor(DC, ShadowColor);
|
|
case ShadowPos of
|
|
spLeftTop: OffsetRect(RShadow, -ShadowSize, -ShadowSize);
|
|
spRightBottom: OffsetRect(RShadow, ShadowSize, ShadowSize);
|
|
spLeftBottom:
|
|
begin
|
|
{OffsetRect(RText, ShadowSize, 0);}
|
|
OffsetRect(RShadow, -ShadowSize, ShadowSize);
|
|
end;
|
|
spRightTop:
|
|
begin
|
|
{OffsetRect(RText, 0, ShadowSize);}
|
|
OffsetRect(RShadow, ShadowSize, -ShadowSize);
|
|
end;
|
|
end; { case }
|
|
Result := DrawText(DC, Str, Count, RShadow, Format);
|
|
if Result > 0 then Inc(Result, ShadowSize);
|
|
SetTextColor(DC, Color);
|
|
DrawText(DC, Str, Count, RText, Format);
|
|
UnionRect(Rect, RText, RShadow);
|
|
end;
|
|
|
|
{ TRxRadioGroup }
|
|
|
|
function TRxRadioGroup.GetItemEnabled(Index: integer): boolean;
|
|
var
|
|
R:TRadioButton;
|
|
begin
|
|
if (Index < -1) or (Index >= Items.Count) then
|
|
RaiseIndexOutOfBounds(Self, Items, Index);
|
|
R:=FindComponent('RadioButton'+IntToStr(Index)) as TRadioButton;
|
|
if Assigned(R) then
|
|
Result:=R.Enabled
|
|
else
|
|
Result:=False;
|
|
end;
|
|
|
|
procedure TRxRadioGroup.SetItemEnabled(Index: integer; AValue: boolean);
|
|
var
|
|
R:TRadioButton;
|
|
begin
|
|
if (Index < -1) or (Index >= Items.Count) then
|
|
RaiseIndexOutOfBounds(Self, Items, Index);
|
|
R:=FindComponent('RadioButton'+IntToStr(Index)) as TRadioButton;
|
|
if Assigned(R) then
|
|
R.Enabled:=AValue;
|
|
end;
|
|
|
|
constructor TRxCustomLabel.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
ControlStyle := ControlStyle + [csOpaque];
|
|
{.$IFDEF WIN32}
|
|
ControlStyle := ControlStyle + [csReplicatable];
|
|
{.$ENDIF}
|
|
Width := 65;
|
|
Height := 17;
|
|
FAutoSize := True;
|
|
FShowAccelChar := True;
|
|
FShadowColor := clBtnHighlight;
|
|
FShadowSize := 1;
|
|
FShadowPos := spLeftTop;
|
|
end;
|
|
|
|
function TRxCustomLabel.GetLabelCaption: string;
|
|
begin
|
|
Result := Caption;
|
|
end;
|
|
|
|
function TRxCustomLabel.GetDefaultFontColor: TColor;
|
|
begin
|
|
Result := Font.Color;
|
|
end;
|
|
|
|
procedure TRxCustomLabel.DoDrawText(var Rect: TRect; Flags: Word);
|
|
var
|
|
AText: string;
|
|
PosShadow: TShadowPosition;
|
|
SizeShadow: Byte;
|
|
ColorShadow: TColor;
|
|
begin
|
|
AText := GetLabelCaption;
|
|
if (Flags and DT_CALCRECT <> 0) and ((AText = '') or FShowAccelChar and
|
|
(AText[1] = '&') and (AText[2] = #0)) then AText := AText + ' ';
|
|
if not FShowAccelChar then Flags := Flags or DT_NOPREFIX;
|
|
{$IFDEF USED_BiDi}
|
|
Flags := DrawTextBiDiModeFlags(Flags);
|
|
{$ENDIF}
|
|
Canvas.Font := Font;
|
|
Canvas.Font.Color := GetDefaultFontColor;
|
|
PosShadow := FShadowPos;
|
|
SizeShadow := FShadowSize;
|
|
ColorShadow := FShadowColor;
|
|
if not Enabled then begin
|
|
if (FShadowSize = 0) and NewStyleControls then begin
|
|
PosShadow := spRightBottom;
|
|
SizeShadow := 1;
|
|
end;
|
|
Canvas.Font.Color := clGrayText;
|
|
ColorShadow := clBtnHighlight;
|
|
end;
|
|
DrawShadowText(Canvas.Handle, PChar(AText), Length(AText), Rect, Flags,
|
|
SizeShadow, ColorToRGB(ColorShadow), PosShadow);
|
|
end;
|
|
|
|
procedure TRxCustomLabel.Paint;
|
|
var
|
|
Rect: TRect;
|
|
DrawStyle: Integer;
|
|
begin
|
|
if not Enabled and not (csDesigning in ComponentState) then
|
|
FDragging := False;
|
|
|
|
with Canvas do
|
|
begin
|
|
if not Transparent then
|
|
begin
|
|
Brush.Color := Self.Color;
|
|
Brush.Style := bsSolid;
|
|
FillRect(ClientRect);
|
|
end;
|
|
Brush.Style := bsClear;
|
|
Rect := ClientRect;
|
|
Inc(Rect.Left, FLeftMargin);
|
|
Dec(Rect.Right, FRightMargin);
|
|
InflateRect(Rect, -1, 0);
|
|
DrawStyle := {DT_EXPANDTABS or }WordWraps[FWordWrap] or Alignments[FAlignment];
|
|
{ Calculate vertical layout }
|
|
if FLayout <> tlTop then
|
|
begin
|
|
DoDrawText(Rect, DrawStyle or DT_CALCRECT);
|
|
Rect.Left := ClientRect.Left + FLeftMargin;
|
|
Rect.Right := ClientRect.Right - FRightMargin;
|
|
if FLayout = tlBottom then OffsetRect(Rect, 0, Height - Rect.Bottom)
|
|
else OffsetRect(Rect, 0, (Height - Rect.Bottom) div 2);
|
|
end;
|
|
DoDrawText(Rect, DrawStyle);
|
|
if FShowFocus and Assigned(FFocusControl) and FFocused and
|
|
not (csDesigning in ComponentState) then
|
|
begin
|
|
InflateRect(Rect, 1, 0);
|
|
Brush.Color := Self.Color;
|
|
// DrawFocusRect(Rect);
|
|
FrameRect(Rect);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TRxCustomLabel.AdjustBounds;
|
|
var
|
|
DC: HDC;
|
|
X: Integer;
|
|
Rect: TRect;
|
|
AAlignment: TAlignment;
|
|
begin
|
|
if AutoSize then
|
|
begin
|
|
Rect := ClientRect;
|
|
Inc(Rect.Left, FLeftMargin);
|
|
Dec(Rect.Right, FRightMargin);
|
|
InflateRect(Rect, -1, 0);
|
|
DC := GetDC(0);
|
|
Canvas.Handle := DC;
|
|
DoDrawText(Rect, {DT_EXPANDTABS or }DT_CALCRECT or WordWraps[FWordWrap]);
|
|
Dec(Rect.Left, FLeftMargin);
|
|
Inc(Rect.Right, FRightMargin);
|
|
Canvas.Handle := 0;
|
|
ReleaseDC(0, DC);
|
|
InflateRect(Rect, 1, 0);
|
|
X := Left;
|
|
AAlignment := FAlignment;
|
|
{$IFDEF USED_BiDi}
|
|
if UseRightToLeftAlignment then ChangeBiDiModeAlignment(AAlignment);
|
|
{$ENDIF}
|
|
if AAlignment = taRightJustify then Inc(X, Width - Rect.Right);
|
|
SetBounds(X, Top, Rect.Right, Rect.Bottom);
|
|
end;
|
|
end;
|
|
|
|
procedure TRxCustomLabel.SetAlignment(Value: TAlignment);
|
|
begin
|
|
if FAlignment <> Value then begin
|
|
FAlignment := Value;
|
|
Invalidate;
|
|
end;
|
|
end;
|
|
|
|
procedure TRxCustomLabel.SetAutoSize(Value: Boolean);
|
|
begin
|
|
if AutoSize <> Value then begin
|
|
FAutoSize := Value;
|
|
AdjustBounds;
|
|
end;
|
|
end;
|
|
|
|
procedure TRxCustomLabel.SetLayout(Value: TTextLayout);
|
|
begin
|
|
if FLayout <> Value then begin
|
|
FLayout := Value;
|
|
Invalidate;
|
|
end;
|
|
end;
|
|
|
|
procedure TRxCustomLabel.SetLeftMargin(Value: Integer);
|
|
begin
|
|
if FLeftMargin <> Value then
|
|
begin
|
|
FLeftMargin := Max(Value, 0);
|
|
AdjustBounds;
|
|
Invalidate;
|
|
end;
|
|
end;
|
|
|
|
procedure TRxCustomLabel.SetRightMargin(Value: Integer);
|
|
begin
|
|
if FRightMargin <> Value then begin
|
|
FRightMargin := Max(Value, 0);
|
|
AdjustBounds;
|
|
Invalidate;
|
|
end;
|
|
end;
|
|
|
|
procedure TRxCustomLabel.SetShadowColor(Value: TColor);
|
|
begin
|
|
if Value <> FShadowColor then begin
|
|
FShadowColor := Value;
|
|
Invalidate;
|
|
end;
|
|
end;
|
|
|
|
procedure TRxCustomLabel.SetShadowSize(Value: Byte);
|
|
begin
|
|
if Value <> FShadowSize then begin
|
|
FShadowSize := Value;
|
|
AdjustBounds;
|
|
Invalidate;
|
|
end;
|
|
end;
|
|
|
|
procedure TRxCustomLabel.SetShadowPos(Value: TShadowPosition);
|
|
begin
|
|
if Value <> FShadowPos then begin
|
|
FShadowPos := Value;
|
|
Invalidate;
|
|
end;
|
|
end;
|
|
|
|
function TRxCustomLabel.GetTransparent: Boolean;
|
|
begin
|
|
Result := not (csOpaque in ControlStyle);
|
|
end;
|
|
|
|
procedure TRxCustomLabel.SetFocusControl(Value: TWinControl);
|
|
begin
|
|
FFocusControl := Value;
|
|
{.$IFDEF WIN32}
|
|
if Value <> nil then Value.FreeNotification(Self);
|
|
{.$ENDIF}
|
|
if FShowFocus then Invalidate;
|
|
end;
|
|
|
|
procedure TRxCustomLabel.SetShowAccelChar(Value: Boolean);
|
|
begin
|
|
if FShowAccelChar <> Value then begin
|
|
FShowAccelChar := Value;
|
|
Invalidate;
|
|
end;
|
|
end;
|
|
|
|
procedure TRxCustomLabel.SetTransparent(Value: Boolean);
|
|
begin
|
|
if Transparent <> Value then begin
|
|
if Value then ControlStyle := ControlStyle - [csOpaque]
|
|
else ControlStyle := ControlStyle + [csOpaque];
|
|
Invalidate;
|
|
end;
|
|
end;
|
|
|
|
procedure TRxCustomLabel.SetShowFocus(Value: Boolean);
|
|
begin
|
|
if FShowFocus <> Value then begin
|
|
FShowFocus := Value;
|
|
Invalidate;
|
|
end;
|
|
end;
|
|
|
|
procedure TRxCustomLabel.SetWordWrap(Value: Boolean);
|
|
begin
|
|
if FWordWrap <> Value then begin
|
|
FWordWrap := Value;
|
|
AdjustBounds;
|
|
end;
|
|
end;
|
|
|
|
procedure TRxCustomLabel.Notification(AComponent: TComponent;
|
|
Operation: TOperation);
|
|
begin
|
|
inherited Notification(AComponent, Operation);
|
|
if (Operation = opRemove) and (AComponent = FFocusControl) then
|
|
FocusControl := nil;
|
|
end;
|
|
|
|
procedure TRxCustomLabel.MouseEnter;
|
|
begin
|
|
if Assigned(FOnMouseEnter) then FOnMouseEnter(Self);
|
|
end;
|
|
|
|
procedure TRxCustomLabel.MouseLeave;
|
|
begin
|
|
if Assigned(FOnMouseLeave) then FOnMouseLeave(Self);
|
|
end;
|
|
|
|
procedure TRxCustomLabel.UpdateTracking;
|
|
var
|
|
P: TPoint;
|
|
OldValue: Boolean;
|
|
begin
|
|
OldValue := FMouseInControl;
|
|
GetCursorPos(P);
|
|
FMouseInControl := Enabled and (FindDragTarget(P, True) = Self) and
|
|
IsForegroundTask;
|
|
if (FMouseInControl <> OldValue) then
|
|
if FMouseInControl then MouseEnter else MouseLeave;
|
|
end;
|
|
|
|
procedure TRxCustomLabel.CMFocusChanged(var Message: TLMessage);
|
|
var
|
|
Active: Boolean;
|
|
begin
|
|
Active := Assigned(FFocusControl) {and (Message.Sender = FFocusControl)};
|
|
if FFocused <> Active then
|
|
begin
|
|
FFocused := Active;
|
|
if FShowFocus then Invalidate;
|
|
end;
|
|
inherited;
|
|
end;
|
|
|
|
procedure TRxCustomLabel.CMTextChanged(var Message: TLMessage);
|
|
begin
|
|
Invalidate;
|
|
AdjustBounds;
|
|
end;
|
|
|
|
procedure TRxCustomLabel.CMFontChanged(var Message: TLMessage);
|
|
begin
|
|
inherited;
|
|
AdjustBounds;
|
|
end;
|
|
|
|
procedure TRxCustomLabel.CMDialogChar(var Message: TCMDialogChar);
|
|
begin
|
|
if (FFocusControl <> nil) and Enabled and ShowAccelChar and
|
|
IsAccel(Message.CharCode, GetLabelCaption) then
|
|
with FFocusControl do
|
|
if CanFocus then begin
|
|
SetFocus;
|
|
Message.Result := 1;
|
|
end;
|
|
end;
|
|
|
|
{procedure TRxCustomLabel.MouseDown(Button: TMouseButton; Shift: TShiftState;
|
|
X, Y: Integer);
|
|
begin
|
|
inherited MouseDown(Button, Shift, X, Y);
|
|
if (Button = mbLeft) and Enabled then
|
|
begin
|
|
FDragging := True;
|
|
end;
|
|
end;
|
|
|
|
procedure TRxCustomLabel.MouseUp(Button: TMouseButton; Shift: TShiftState;
|
|
X, Y: Integer);
|
|
begin
|
|
inherited MouseUp(Button, Shift, X, Y);
|
|
if FDragging and (Button = mbLeft) then FDragging := False;
|
|
UpdateTracking;
|
|
end;
|
|
}
|
|
procedure TRxCustomLabel.MouseDown(Button: TMouseButton; Shift:TShiftState; X,Y:Integer);
|
|
begin
|
|
inherited MouseDown(Button, Shift, X,Y);
|
|
UpdateTracking;
|
|
end;
|
|
|
|
procedure TRxCustomLabel.MouseUp(Button: TMouseButton; Shift:TShiftState; X,Y:Integer);
|
|
begin
|
|
inherited MouseUp(Button, Shift, X,Y);
|
|
UpdateTracking;
|
|
end;
|
|
(*
|
|
procedure TRxCustomLabel.WMRButtonDown(var Message: TWMRButtonDown);
|
|
begin
|
|
inherited;
|
|
UpdateTracking;
|
|
end;
|
|
|
|
procedure TRxCustomLabel.WMRButtonUp(var Message: TWMRButtonUp);
|
|
begin
|
|
inherited;
|
|
UpdateTracking;
|
|
end;
|
|
*)
|
|
procedure TRxCustomLabel.CMEnabledChanged(var Message: TLMessage);
|
|
begin
|
|
inherited;
|
|
UpdateTracking;
|
|
end;
|
|
|
|
procedure TRxCustomLabel.CMVisibleChanged(var Message: TLMessage);
|
|
begin
|
|
inherited;
|
|
if Visible then UpdateTracking;
|
|
end;
|
|
|
|
procedure TRxCustomLabel.CMMouseEnter(var Message: TLMessage);
|
|
begin
|
|
inherited;
|
|
if not FMouseInControl and Enabled and IsForegroundTask then begin
|
|
FMouseInControl := True;
|
|
MouseEnter;
|
|
end;
|
|
end;
|
|
|
|
procedure TRxCustomLabel.CMMouseLeave(var Message: TLMessage);
|
|
begin
|
|
inherited;
|
|
if FMouseInControl and Enabled and not FDragging then begin
|
|
FMouseInControl := False;
|
|
MouseLeave;
|
|
end;
|
|
end;
|
|
|
|
{ TSecretPanel }
|
|
|
|
constructor TSecretPanel.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
FScrollCnt := 0;
|
|
FAlignment := taCenter;
|
|
FActive := False;
|
|
FTxtDivider := 1;
|
|
FGlyphLayout := glGlyphLeft;
|
|
ControlStyle := ControlStyle - [csSetCaption];
|
|
BevelOuter := bvLowered;
|
|
FTextStyle := bvNone;
|
|
FLines := TStringList.Create;
|
|
TStringList(FLines).OnChange := @LinesChanged;
|
|
FGlyph := TBitmap.Create;
|
|
FGlyph.OnChange := @GlyphChanged;
|
|
FHiddenList := TList.Create;
|
|
FTimer := TTimer.Create(Self);
|
|
with FTimer do
|
|
begin
|
|
Enabled := False;
|
|
OnTimer := @TimerExpired;
|
|
Interval := 30;
|
|
{$IFDEF RX_D3}
|
|
// SyncEvent := False;
|
|
FAsyncDrawing := True;
|
|
{$ENDIF}
|
|
end;
|
|
end;
|
|
|
|
destructor TSecretPanel.Destroy;
|
|
begin
|
|
SetActive(False);
|
|
FGlyph.OnChange := nil;
|
|
FGlyph.Free;
|
|
TStringList(FLines).OnChange := nil;
|
|
FLines.Free;
|
|
FHiddenList.Free;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TSecretPanel.GlyphChanged(Sender: TObject);
|
|
begin
|
|
if Active then begin
|
|
UpdateMemoryImage;
|
|
Invalidate;
|
|
end;
|
|
end;
|
|
|
|
procedure TSecretPanel.LinesChanged(Sender: TObject);
|
|
begin
|
|
if Active then begin
|
|
FScrollCnt := 0;
|
|
UpdateMemoryImage;
|
|
Invalidate;
|
|
end;
|
|
end;
|
|
|
|
procedure TSecretPanel.CMFontChanged(var Message: TLMessage);
|
|
begin
|
|
inherited;
|
|
if Active then UpdateMemoryImage;
|
|
end;
|
|
|
|
procedure TSecretPanel.CMColorChanged(var Message: TLMessage);
|
|
begin
|
|
inherited;
|
|
if Active then UpdateMemoryImage;
|
|
end;
|
|
|
|
//procedure TSecretPanel.WMSize(var Message: TLMessage);
|
|
procedure TSecretPanel.WMSize(var Message: TLMSize);
|
|
begin
|
|
inherited;
|
|
if Active then begin
|
|
UpdateMemoryImage;
|
|
Invalidate;
|
|
end;
|
|
end;
|
|
|
|
{$IFDEF RX_D3}
|
|
procedure TSecretPanel.SetAsyncDrawing(Value: Boolean);
|
|
begin
|
|
if FAsyncDrawing <> Value then
|
|
begin
|
|
// FTimer.SyncEvent := not Value;
|
|
FAsyncDrawing := Value;
|
|
end;
|
|
end;
|
|
{$ENDIF RX_D3}
|
|
|
|
procedure TSecretPanel.AlignControls(AControl: TControl; var Rect: TRect);
|
|
begin
|
|
inherited AlignControls(AControl, Rect);
|
|
if (AControl = nil) and Active then UpdateMemoryImage;
|
|
end;
|
|
|
|
function TSecretPanel.GetInflateWidth: Integer;
|
|
begin
|
|
Result := BorderWidth;
|
|
if BevelOuter <> bvNone then Inc(Result, BevelWidth);
|
|
if BevelInner <> bvNone then Inc(Result, BevelWidth);
|
|
end;
|
|
|
|
procedure TSecretPanel.RecalcDrawRect;
|
|
const
|
|
MinOffset = 3;
|
|
var
|
|
InflateWidth: Integer;
|
|
LastLine: Integer;
|
|
begin
|
|
FTxtRect := GetClientRect;
|
|
FPaintRect := FTxtRect;
|
|
InflateWidth := GetInflateWidth;
|
|
InflateRect(FPaintRect, -InflateWidth, -InflateWidth);
|
|
Inc(InflateWidth, MinOffset);
|
|
InflateRect(FTxtRect, -InflateWidth, -InflateWidth);
|
|
with FGlyphOrigin do begin
|
|
case FGlyphLayout of
|
|
glGlyphLeft:
|
|
begin
|
|
X := FTxtRect.Left;
|
|
Y := (FTxtRect.Bottom + FTxtRect.Top - Glyph.Height) div 2;
|
|
if Y < FTxtRect.Top then Y := FTxtRect.Top;
|
|
if Glyph.Width > 0 then begin
|
|
Inc(X, MinOffset);
|
|
FTxtRect.Left := X + Glyph.Width + InflateWidth;
|
|
end;
|
|
end;
|
|
glGlyphRight:
|
|
begin
|
|
Y := (FTxtRect.Bottom + FTxtRect.Top - Glyph.Height) div 2;
|
|
if Y < FTxtRect.Top then Y := FTxtRect.Top;
|
|
X := FTxtRect.Right - Glyph.Width;
|
|
if Glyph.Width > 0 then begin
|
|
Dec(X, MinOffset);
|
|
if X < FTxtRect.Left then X := FTxtRect.Left;
|
|
FTxtRect.Right := X - InflateWidth;
|
|
end;
|
|
end;
|
|
glGlyphTop:
|
|
begin
|
|
Y := FTxtRect.Top;
|
|
X := (FTxtRect.Right + FTxtRect.Left - Glyph.Width) div 2;
|
|
if X < FTxtRect.Left then X := FTxtRect.Left;
|
|
if Glyph.Height > 0 then begin
|
|
Inc(Y, MinOffset);
|
|
FTxtRect.Top := Y + Glyph.Height + (InflateWidth + MinOffset);
|
|
end;
|
|
end;
|
|
glGlyphBottom:
|
|
begin
|
|
X := (FTxtRect.Right + FTxtRect.Left - Glyph.Width) div 2;
|
|
if X < FTxtRect.Left then X := FTxtRect.Left;
|
|
Y := FTxtRect.Bottom - Glyph.Height;
|
|
if Glyph.Height > 0 then begin
|
|
Dec(Y, MinOffset);
|
|
if Y < FTxtRect.Top then Y := FTxtRect.Top;
|
|
FTxtRect.Bottom := Y - (InflateWidth + MinOffset);
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
if FDirection = sdHorizontal then begin
|
|
LastLine := FLines.Count - 1;
|
|
while (LastLine >= 0) and (Trim(FLines[LastLine]) = '') do
|
|
Dec(LastLine);
|
|
InflateWidth := HeightOf(FTxtRect) -
|
|
(LastLine + 1 - FFirstLine) * FTxtDivider;
|
|
if InflateWidth > 0 then
|
|
InflateRect(FTxtRect, 0, - InflateWidth div 2);
|
|
end;
|
|
with FTxtRect do
|
|
if (Left >= Right) or (Top >= Bottom) then FTxtRect := Rect(0, 0, 0, 0);
|
|
end;
|
|
|
|
procedure TSecretPanel.PaintGlyph;
|
|
begin
|
|
if not FGlyph.Empty then
|
|
begin
|
|
RecalcDrawRect;
|
|
//alexs
|
|
{ DrawBitmapTransparent(Canvas, FGlyphOrigin.X, FGlyphOrigin.Y,
|
|
FGlyph, FGlyph.TransparentColor and not PaletteMask);}
|
|
end;
|
|
end;
|
|
|
|
procedure TSecretPanel.PaintText;
|
|
var
|
|
STmp: array[0..255] of Char;
|
|
R: TRect;
|
|
I: Integer;
|
|
Flags: Longint;
|
|
begin
|
|
if (FLines.Count = 0) or IsRectEmpty(FTxtRect) or not HandleAllocated then
|
|
Exit;
|
|
{$IFDEF RX_D3}
|
|
FMemoryImage.Canvas.Lock;
|
|
try
|
|
{$ENDIF}
|
|
with FMemoryImage.Canvas do begin
|
|
I := SaveDC(Handle);
|
|
try
|
|
with FTxtRect do
|
|
MoveWindowOrg(Handle, -Left, -Top);
|
|
Brush.Color := Self.Color;
|
|
PaintClient(FMemoryImage.Canvas, FPaintRect);
|
|
finally
|
|
RestoreDC(Handle, I);
|
|
SetBkMode(Handle, Transparent);
|
|
end;
|
|
end;
|
|
R := Bounds(0, 0, WidthOf(FTxtRect), HeightOf(FTxtRect));
|
|
if FDirection = sdHorizontal then begin
|
|
{$IFDEF RX_D4}
|
|
if IsRightToLeft then begin
|
|
R.Right := R.Left + FScrollCnt;
|
|
R.Left := R.Right - (FMaxScroll - WidthOf(FTxtRect));
|
|
end
|
|
else begin
|
|
R.Left := R.Right - FScrollCnt;
|
|
R.Right := R.Left + (FMaxScroll - WidthOf(FTxtRect));
|
|
end;
|
|
{$ELSE}
|
|
R.Left := R.Right - FScrollCnt;
|
|
R.Right := R.Left + (FMaxScroll - WidthOf(FTxtRect));
|
|
{$ENDIF}
|
|
end
|
|
else
|
|
begin { sdVertical }
|
|
R.Top := R.Bottom - FScrollCnt;
|
|
end;
|
|
R.Bottom := R.Top + FTxtDivider;
|
|
Flags := {DT_EXPANDTABS or }Alignments[FAlignment] or DT_SINGLELINE or
|
|
DT_NOCLIP or DT_NOPREFIX;
|
|
{$IFDEF USED_BiDi}
|
|
Flags := DrawTextBiDiModeFlags(Flags);
|
|
{$ENDIF}
|
|
for I := FFirstLine to FLines.Count do begin
|
|
if I = FLines.Count then StrCopy(STmp, ' ')
|
|
else StrPLCopy(STmp, FLines[I], SizeOf(STmp) - 1);
|
|
if R.Top >= HeightOf(FTxtRect) then Break
|
|
else if R.Bottom > 0 then begin
|
|
if FTextStyle <> bvNone then begin
|
|
FMemoryImage.Canvas.Font.Color := clBtnHighlight;
|
|
case FTextStyle of
|
|
bvLowered:
|
|
begin
|
|
OffsetRect(R, 1, 1);
|
|
DrawText(FMemoryImage.Canvas.Handle, STmp, -1, R, Flags);
|
|
OffsetRect(R, -1, -1);
|
|
end;
|
|
bvRaised:
|
|
begin
|
|
OffsetRect(R, -1, -1);
|
|
DrawText(FMemoryImage.Canvas.Handle, STmp, -1, R, Flags);
|
|
OffsetRect(R, 1, 1);
|
|
end;
|
|
end;
|
|
FMemoryImage.Canvas.Font.Color := Self.Font.Color;
|
|
SetBkMode(FMemoryImage.Canvas.Handle, Transparent);
|
|
end;
|
|
DrawText(FMemoryImage.Canvas.Handle, STmp, -1, R, Flags);
|
|
end;
|
|
OffsetRect(R, 0, FTxtDivider);
|
|
end;
|
|
{$IFDEF RX_D3}
|
|
Canvas.Lock;
|
|
try
|
|
{$ENDIF}
|
|
BitBlt(Canvas.Handle, FTxtRect.Left, FTxtRect.Top, FMemoryImage.Width,
|
|
FMemoryImage.Height, FMemoryImage.Canvas.Handle, 0, 0, SRCCOPY);
|
|
// ValidateRect(Handle, @FTxtRect);
|
|
{$IFDEF RX_D3}
|
|
finally
|
|
Canvas.Unlock;
|
|
end;
|
|
{$ENDIF}
|
|
{$IFDEF RX_D3}
|
|
finally
|
|
FMemoryImage.Canvas.Unlock;
|
|
end;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
procedure TSecretPanel.PaintClient(ACanvas: TCanvas; Rect: TRect);
|
|
begin
|
|
if Assigned(FOnPaintClient) then FOnPaintClient(Self, ACanvas, Rect)
|
|
else ACanvas.FillRect(Rect);
|
|
end;
|
|
|
|
procedure TSecretPanel.Paint;
|
|
var
|
|
Rect: TRect;
|
|
TopColor, BottomColor: TColor;
|
|
SaveIndex: Integer;
|
|
|
|
procedure AdjustColors(Bevel: TPanelBevel);
|
|
begin
|
|
TopColor := clBtnHighlight;
|
|
if Bevel = bvLowered then TopColor := clBtnShadow;
|
|
BottomColor := clBtnShadow;
|
|
if Bevel = bvLowered then BottomColor := clBtnHighlight;
|
|
end;
|
|
|
|
begin
|
|
Rect := GetClientRect;
|
|
if BevelOuter <> bvNone then
|
|
begin
|
|
AdjustColors(BevelOuter);
|
|
// Frame3D(Canvas, Rect, TopColor, BottomColor, BevelWidth);
|
|
WidgetSet.Frame3d(Canvas.Handle, Rect, BevelWidth, BevelOuter);
|
|
end;
|
|
// Frame3D(Canvas, Rect, Color, Color, BorderWidth);
|
|
WidgetSet.Frame3d(Canvas.Handle, Rect, BorderWidth, BevelOuter);
|
|
if BevelInner <> bvNone then
|
|
begin
|
|
AdjustColors(BevelInner);
|
|
// Frame3D(Canvas, Rect, TopColor, BottomColor, BevelWidth);
|
|
WidgetSet.Frame3d(Canvas.Handle, Rect, BorderWidth, BevelInner);
|
|
end;
|
|
SaveIndex := SaveDC(Canvas.Handle);
|
|
try
|
|
with Rect do
|
|
IntersectClipRect(Canvas.Handle, Left, Top, Right, Bottom);
|
|
Canvas.Brush.Color := Self.Color;
|
|
PaintClient(Canvas, Rect);
|
|
finally
|
|
RestoreDC(Canvas.Handle, SaveIndex);
|
|
end;
|
|
if Active then begin
|
|
PaintGlyph;
|
|
{PaintText;}
|
|
end;
|
|
end;
|
|
|
|
procedure TSecretPanel.StartPlay;
|
|
begin
|
|
if Assigned(FOnStartPlay) then FOnStartPlay(Self);
|
|
end;
|
|
|
|
procedure TSecretPanel.StopPlay;
|
|
begin
|
|
if Assigned(FOnStopPlay) then FOnStopPlay(Self);
|
|
end;
|
|
|
|
procedure TSecretPanel.TimerExpired(Sender: TObject);
|
|
begin
|
|
if (FScrollCnt < FMaxScroll) then begin
|
|
Inc(FScrollCnt);
|
|
if Assigned(FMemoryImage) then PaintText;
|
|
end
|
|
else if Cycled then begin
|
|
FScrollCnt := 0;
|
|
if Assigned(FMemoryImage) then PaintText;
|
|
end
|
|
else
|
|
begin
|
|
{.$IFDEF RX_D3}
|
|
// FTimer.Synchronize(Stop);
|
|
{.$ELSE}
|
|
SetActive(False);
|
|
{.$ENDIF}
|
|
end;
|
|
end;
|
|
|
|
procedure TSecretPanel.UpdateMemoryImage;
|
|
var
|
|
Metrics: TTextMetric;
|
|
I: Integer;
|
|
begin
|
|
if FMemoryImage = nil then FMemoryImage := TBitmap.Create;
|
|
{.$IFDEF RX_D3}
|
|
FMemoryImage.Canvas.Lock;
|
|
try
|
|
{.$ENDIF}
|
|
FFirstLine := 0;
|
|
while (FFirstLine < FLines.Count) and (Trim(FLines[FFirstLine]) = '') do
|
|
Inc(FFirstLine);
|
|
Canvas.Font := Self.Font;
|
|
GetTextMetrics(Canvas.Handle, Metrics);
|
|
FTxtDivider := Metrics.tmHeight + Metrics.tmExternalLeading;
|
|
if FTextStyle <> bvNone then Inc(FTxtDivider);
|
|
RecalcDrawRect;
|
|
if FDirection = sdHorizontal then begin
|
|
FMaxScroll := 0;
|
|
for I := FFirstLine to FLines.Count - 1 do
|
|
FMaxScroll := Max(FMaxScroll, Canvas.TextWidth(FLines[I]));
|
|
Inc(FMaxScroll, WidthOf(FTxtRect));
|
|
end
|
|
else begin { sdVertical }
|
|
FMaxScroll := ((FLines.Count - FFirstLine) * FTxtDivider) +
|
|
HeightOf(FTxtRect);
|
|
end;
|
|
FMemoryImage.Width := WidthOf(FTxtRect);
|
|
FMemoryImage.Height := HeightOf(FTxtRect);
|
|
with FMemoryImage.Canvas do begin
|
|
Font := Self.Font;
|
|
Brush.Color := Self.Color;
|
|
SetBkMode(Handle, Transparent);
|
|
end;
|
|
{.$IFDEF RX_D3}
|
|
finally
|
|
FMemoryImage.Canvas.UnLock;
|
|
end;
|
|
{.$ENDIF}
|
|
end;
|
|
|
|
function TSecretPanel.GetInterval: Cardinal;
|
|
begin
|
|
Result := FTimer.Interval;
|
|
end;
|
|
|
|
procedure TSecretPanel.SetInterval(Value: Cardinal);
|
|
begin
|
|
FTimer.Interval := Value;
|
|
end;
|
|
|
|
procedure TSecretPanel.Play;
|
|
begin
|
|
SetActive(True);
|
|
end;
|
|
|
|
procedure TSecretPanel.Stop;
|
|
begin
|
|
SetActive(False);
|
|
end;
|
|
|
|
procedure TSecretPanel.SetActive(Value: Boolean);
|
|
var
|
|
I: Integer;
|
|
begin
|
|
if Value <> FActive then
|
|
begin
|
|
FActive := Value;
|
|
if FActive then
|
|
begin
|
|
FScrollCnt := 0;
|
|
UpdateMemoryImage;
|
|
try
|
|
FTimer.Enabled := True;
|
|
StartPlay;
|
|
except
|
|
FActive := False;
|
|
FTimer.Enabled := False;
|
|
raise;
|
|
end;
|
|
end
|
|
else begin
|
|
{.$IFDEF RX_D3}
|
|
FMemoryImage.Canvas.Lock;
|
|
{ ensure that canvas is locked before timer is disabled }
|
|
{.$ENDIF}
|
|
FTimer.Enabled := False;
|
|
FScrollCnt := 0;
|
|
FMemoryImage.Free;
|
|
FMemoryImage := nil;
|
|
StopPlay;
|
|
if (csDesigning in ComponentState) and
|
|
not (csDestroying in ComponentState) then
|
|
ValidParentForm(Self).Designer.Modified;
|
|
end;
|
|
if not (csDestroying in ComponentState) then
|
|
for I := 0 to Pred(ControlCount) do
|
|
begin
|
|
if FActive then
|
|
begin
|
|
if Controls[I].Visible then FHiddenList.Add(Controls[I]);
|
|
if not (csDesigning in ComponentState) then
|
|
Controls[I].Visible := False
|
|
end
|
|
else
|
|
if FHiddenList.IndexOf(Controls[I]) >= 0 then
|
|
begin
|
|
Controls[I].Visible := True;
|
|
Controls[I].Invalidate;
|
|
if (csDesigning in ComponentState) then Controls[I].Update;
|
|
end;
|
|
end;
|
|
if not FActive then FHiddenList.Clear;
|
|
Invalidate;
|
|
end;
|
|
end;
|
|
|
|
procedure TSecretPanel.SetAlignment(Value: TAlignment);
|
|
begin
|
|
if FAlignment <> Value then
|
|
begin
|
|
FAlignment := Value;
|
|
if Active then Invalidate;
|
|
end;
|
|
end;
|
|
|
|
procedure TSecretPanel.SetGlyph(Value: TBitmap);
|
|
begin
|
|
FGlyph.Assign(Value);
|
|
end;
|
|
|
|
procedure TSecretPanel.SetDirection(Value: TScrollDirection);
|
|
begin
|
|
if FDirection <> Value then
|
|
begin
|
|
FDirection := Value;
|
|
if FActive then
|
|
begin
|
|
FScrollCnt := 0;
|
|
UpdateMemoryImage;
|
|
Invalidate;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TSecretPanel.SetTextStyle(Value: TPanelBevel);
|
|
begin
|
|
if FTextStyle <> Value then
|
|
begin
|
|
FTextStyle := Value;
|
|
if FActive then
|
|
begin
|
|
UpdateMemoryImage;
|
|
Invalidate;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TSecretPanel.SetGlyphLayout(Value: TGlyphLayout);
|
|
begin
|
|
if FGlyphLayout <> Value then
|
|
begin
|
|
FGlyphLayout := Value;
|
|
if FActive then
|
|
begin
|
|
UpdateMemoryImage;
|
|
Invalidate;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TSecretPanel.SetLines(Value: TStrings);
|
|
begin
|
|
FLines.Assign(Value);
|
|
end;
|
|
(*
|
|
{ TGlyphList }
|
|
|
|
type
|
|
TGlyphList = class(TImageList)
|
|
private
|
|
FUsed: TBits;
|
|
FCount: Integer;
|
|
function AllocateIndex: Integer;
|
|
public
|
|
constructor CreateSize(AWidth, AHeight: Integer);
|
|
destructor Destroy; override;
|
|
function Add(Image, Mask: TBitmap): Integer;
|
|
function AddMasked(Image: TBitmap; MaskColor: TColor): Integer;
|
|
{$IFDEF WIN32}
|
|
{$IFNDEF RX_D3} { Delphi 2.0 bug fix }
|
|
procedure ReplaceMasked(Index: Integer; NewImage: TBitmap; MaskColor: TColor);
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
procedure Delete(Index: Integer);
|
|
property Count: Integer read FCount;
|
|
end;
|
|
|
|
{ TGlyphCache }
|
|
|
|
TGlyphCache = class
|
|
private
|
|
FGlyphLists: TList;
|
|
public
|
|
constructor Create;
|
|
destructor Destroy; override;
|
|
function GetList(AWidth, AHeight: Integer): TGlyphList;
|
|
procedure ReturnList(List: TGlyphList);
|
|
function Empty: Boolean;
|
|
end;
|
|
|
|
{ TGlyphList }
|
|
|
|
constructor TGlyphList.CreateSize(AWidth, AHeight: Integer);
|
|
begin
|
|
{$IFDEF WIN32}
|
|
inherited CreateSize(AWidth, AHeight);
|
|
{$ELSE}
|
|
inherited Create(AWidth, AHeight);
|
|
{$ENDIF}
|
|
FUsed := TBits.Create;
|
|
end;
|
|
|
|
destructor TGlyphList.Destroy;
|
|
begin
|
|
FUsed.Free;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TGlyphList.AllocateIndex: Integer;
|
|
begin
|
|
Result := FUsed.OpenBit;
|
|
if Result >= FUsed.Size then begin
|
|
Result := inherited Add(nil, nil);
|
|
FUsed.Size := Result + 1;
|
|
end;
|
|
FUsed[Result] := True;
|
|
end;
|
|
|
|
{$IFDEF WIN32}
|
|
{$IFNDEF RX_D3} { Delphi 2.0 bug fix }
|
|
procedure TGlyphList.ReplaceMasked(Index: Integer; NewImage: TBitmap; MaskColor: TColor);
|
|
var
|
|
TempIndex: Integer;
|
|
Image, Mask: TBitmap;
|
|
begin
|
|
if HandleAllocated then begin
|
|
TempIndex := inherited AddMasked(NewImage, MaskColor);
|
|
if TempIndex <> -1 then
|
|
try
|
|
Image := TBitmap.Create;
|
|
Mask := TBitmap.Create;
|
|
try
|
|
with Image do begin
|
|
Height := Self.Height;
|
|
Width := Self.Width;
|
|
end;
|
|
with Mask do begin
|
|
Monochrome := True; { fix }
|
|
Height := Self.Height;
|
|
Width := Self.Width;
|
|
end;
|
|
ImageList_Draw(Handle, TempIndex, Image.Canvas.Handle, 0, 0, ILD_NORMAL);
|
|
ImageList_Draw(Handle, TempIndex, Mask.Canvas.Handle, 0, 0, ILD_MASK);
|
|
if not ImageList_Replace(Handle, Index, Image.Handle, Mask.Handle) then
|
|
raise EInvalidOperation.Create(LoadStr(SReplaceImage));
|
|
finally
|
|
Image.Free;
|
|
Mask.Free;
|
|
end;
|
|
finally
|
|
inherited Delete(TempIndex);
|
|
end
|
|
else raise EInvalidOperation.Create(LoadStr(SReplaceImage));
|
|
end;
|
|
Change;
|
|
end;
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
|
|
function TGlyphList.Add(Image, Mask: TBitmap): Integer;
|
|
begin
|
|
Result := AllocateIndex;
|
|
Replace(Result, Image, Mask);
|
|
Inc(FCount);
|
|
end;
|
|
|
|
function TGlyphList.AddMasked(Image: TBitmap; MaskColor: TColor): Integer;
|
|
begin
|
|
Result := AllocateIndex;
|
|
ReplaceMasked(Result, Image, MaskColor);
|
|
Inc(FCount);
|
|
end;
|
|
|
|
procedure TGlyphList.Delete(Index: Integer);
|
|
begin
|
|
if FUsed[Index] then begin
|
|
Dec(FCount);
|
|
FUsed[Index] := False;
|
|
end;
|
|
end;
|
|
|
|
{ TGlyphCache }
|
|
|
|
constructor TGlyphCache.Create;
|
|
begin
|
|
inherited Create;
|
|
FGlyphLists := TList.Create;
|
|
end;
|
|
|
|
destructor TGlyphCache.Destroy;
|
|
begin
|
|
FGlyphLists.Free;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TGlyphCache.GetList(AWidth, AHeight: Integer): TGlyphList;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
for I := FGlyphLists.Count - 1 downto 0 do begin
|
|
Result := FGlyphLists[I];
|
|
with Result do
|
|
if (AWidth = Width) and (AHeight = Height) then Exit;
|
|
end;
|
|
Result := TGlyphList.CreateSize(AWidth, AHeight);
|
|
FGlyphLists.Add(Result);
|
|
end;
|
|
|
|
procedure TGlyphCache.ReturnList(List: TGlyphList);
|
|
begin
|
|
if List = nil then Exit;
|
|
if List.Count = 0 then begin
|
|
FGlyphLists.Remove(List);
|
|
List.Free;
|
|
end;
|
|
end;
|
|
|
|
function TGlyphCache.Empty: Boolean;
|
|
begin
|
|
Result := FGlyphLists.Count = 0;
|
|
end;
|
|
|
|
const
|
|
GlyphCache: TGlyphCache = nil;
|
|
|
|
{ TRxButtonGlyph }
|
|
|
|
constructor TRxButtonGlyph.Create;
|
|
var
|
|
I: TRxButtonState;
|
|
begin
|
|
inherited Create;
|
|
FOriginal := TBitmap.Create;
|
|
FOriginal.OnChange := GlyphChanged;
|
|
FTransparentColor := clFuchsia;
|
|
FAlignment := taCenter;
|
|
FNumGlyphs := 1;
|
|
for I := Low(I) to High(I) do FIndexs[I] := -1;
|
|
if GlyphCache = nil then GlyphCache := TGlyphCache.Create;
|
|
end;
|
|
|
|
destructor TRxButtonGlyph.Destroy;
|
|
begin
|
|
FOriginal.Free;
|
|
Invalidate;
|
|
if Assigned(GlyphCache) and GlyphCache.Empty then begin
|
|
GlyphCache.Free;
|
|
GlyphCache := nil;
|
|
end;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TRxButtonGlyph.Invalidate;
|
|
var
|
|
I: TRxButtonState;
|
|
begin
|
|
for I := Low(I) to High(I) do begin
|
|
if Assigned(FGlyphList) then
|
|
if (FIndexs[I] <> -1) then TGlyphList(FGlyphList).Delete(FIndexs[I]);
|
|
FIndexs[I] := -1;
|
|
end;
|
|
GlyphCache.ReturnList(TGlyphList(FGlyphList));
|
|
FGlyphList := nil;
|
|
end;
|
|
|
|
procedure TRxButtonGlyph.GlyphChanged(Sender: TObject);
|
|
var
|
|
Glyphs: Integer;
|
|
begin
|
|
if Sender = FOriginal then begin
|
|
Invalidate;
|
|
if (FOriginal <> nil) and (FOriginal.Height > 0) then begin
|
|
FTransparentColor := FOriginal.TransparentColor and not PaletteMask;
|
|
if FOriginal.Width mod FOriginal.Height = 0 then begin
|
|
Glyphs := FOriginal.Width div FOriginal.Height;
|
|
if Glyphs > (Ord(High(TRxButtonState)) + 1) then Glyphs := 1;
|
|
SetNumGlyphs(Glyphs);
|
|
end;
|
|
end;
|
|
if Assigned(FOnChange) then FOnChange(Self);
|
|
end;
|
|
end;
|
|
|
|
procedure TRxButtonGlyph.SetGlyph(Value: TBitmap);
|
|
begin
|
|
Invalidate;
|
|
FOriginal.Assign(Value);
|
|
end;
|
|
|
|
procedure TRxButtonGlyph.SetNumGlyphs(Value: TRxNumGlyphs);
|
|
begin
|
|
if (Value <> FNumGlyphs) and (Value > 0) then begin
|
|
Invalidate;
|
|
FNumGlyphs := Value;
|
|
end;
|
|
end;
|
|
|
|
function TRxButtonGlyph.MapColor(Color: TColor): TColor;
|
|
var
|
|
Index: Byte;
|
|
begin
|
|
if (Color = FTransparentColor) or (ColorToRGB(Color) =
|
|
ColorToRGB(clBtnFace)) then Result := Color
|
|
else begin
|
|
Color := ColorToRGB(Color);
|
|
Index := Byte(Longint(Word(GetRValue(Color)) * 77 +
|
|
Word(GetGValue(Color)) * 150 + Word(GetBValue(Color)) * 29) shr 8);
|
|
Result := RGB(Index, Index, Index);
|
|
end;
|
|
end;
|
|
|
|
{$IFDEF WIN32}
|
|
function TRxButtonGlyph.CreateImageGlyph(State: TRxButtonState;
|
|
Images: TImageList; Index: Integer): Integer;
|
|
var
|
|
TmpImage, Mask: TBitmap;
|
|
IWidth, IHeight, X, Y: Integer;
|
|
begin
|
|
if (State = rbsDown) then State := rbsUp;
|
|
Result := FIndexs[State];
|
|
if (Result <> -1) or (Images.Width = 0) or (Images.Height = 0) or
|
|
(Images.Count = 0) then Exit;
|
|
IWidth := Images.Width;
|
|
IHeight := Images.Height;
|
|
if FGlyphList = nil then begin
|
|
if GlyphCache = nil then GlyphCache := TGlyphCache.Create;
|
|
FGlyphList := GlyphCache.GetList(IWidth, IHeight);
|
|
end;
|
|
TmpImage := TBitmap.Create;
|
|
try
|
|
TmpImage.Width := IWidth;
|
|
TmpImage.Height := IHeight;
|
|
case State of
|
|
rbsUp, rbsDown, rbsExclusive:
|
|
begin
|
|
with TmpImage.Canvas do begin
|
|
FillRect(Rect(0, 0, IWidth, IHeight));
|
|
ImageList_Draw(Images.Handle, Index, Handle, 0, 0, ILD_NORMAL);
|
|
end;
|
|
Mask := TBitmap.Create;
|
|
try
|
|
with Mask do begin
|
|
Monochrome := True;
|
|
Height := IHeight;
|
|
Width := IWidth;
|
|
end;
|
|
with Mask.Canvas do begin
|
|
FillRect(Rect(0, 0, IWidth, IHeight));
|
|
ImageList_Draw(Images.Handle, Index, Handle, 0, 0, ILD_MASK);
|
|
end;
|
|
FIndexs[State] := TGlyphList(FGlyphList).Add(TmpImage, Mask);
|
|
finally
|
|
Mask.Free;
|
|
end;
|
|
end;
|
|
rbsDisabled:
|
|
begin
|
|
TmpImage.Canvas.Brush.Color := clBtnFace;
|
|
TmpImage.Canvas.FillRect(Rect(0, 0, IWidth, IHeight));
|
|
ImageListDrawDisabled(Images, TmpImage.Canvas, 0, 0, Index,
|
|
clBtnHighlight, clBtnShadow, True);
|
|
FIndexs[State] := TGlyphList(FGlyphList).AddMasked(TmpImage,
|
|
ColorToRGB(clBtnFace));
|
|
end;
|
|
rbsInactive:
|
|
begin
|
|
TmpImage.Canvas.Brush.Color := clBtnFace;
|
|
TmpImage.Canvas.FillRect(Rect(0, 0, IWidth, IHeight));
|
|
ImageList_Draw(Images.Handle, Index, TmpImage.Canvas.Handle, 0, 0,
|
|
ILD_NORMAL);
|
|
with TmpImage do begin
|
|
for X := 0 to Width - 1 do
|
|
for Y := 0 to Height - 1 do
|
|
Canvas.Pixels[X, Y] := MapColor(Canvas.Pixels[X, Y]);
|
|
end;
|
|
FIndexs[State] := TGlyphList(FGlyphList).AddMasked(TmpImage,
|
|
ColorToRGB(clBtnFace));
|
|
end;
|
|
end;
|
|
finally
|
|
TmpImage.Free;
|
|
end;
|
|
Result := FIndexs[State];
|
|
end;
|
|
{$ENDIF}
|
|
|
|
function TRxButtonGlyph.CreateButtonGlyph(State: TRxButtonState): Integer;
|
|
var
|
|
TmpImage, MonoBmp: TBitmap;
|
|
IWidth, IHeight, X, Y: Integer;
|
|
IRect, ORect: TRect;
|
|
I: TRxButtonState;
|
|
begin
|
|
if (State = rbsDown) and (NumGlyphs < 3) then State := rbsUp;
|
|
Result := FIndexs[State];
|
|
if (Result <> -1) or (FOriginal.Width = 0) or (FOriginal.Height = 0) or
|
|
FOriginal.Empty then Exit;
|
|
IWidth := FOriginal.Width div FNumGlyphs;
|
|
IHeight := FOriginal.Height;
|
|
if FGlyphList = nil then begin
|
|
if GlyphCache = nil then GlyphCache := TGlyphCache.Create;
|
|
FGlyphList := GlyphCache.GetList(IWidth, IHeight);
|
|
end;
|
|
TmpImage := TBitmap.Create;
|
|
try
|
|
TmpImage.Width := IWidth;
|
|
TmpImage.Height := IHeight;
|
|
IRect := Rect(0, 0, IWidth, IHeight);
|
|
TmpImage.Canvas.Brush.Color := clBtnFace;
|
|
I := State;
|
|
if Ord(I) >= NumGlyphs then I := rbsUp;
|
|
ORect := Rect(Ord(I) * IWidth, 0, (Ord(I) + 1) * IWidth, IHeight);
|
|
case State of
|
|
rbsUp, rbsDown, rbsExclusive:
|
|
begin
|
|
TmpImage.Canvas.CopyRect(IRect, FOriginal.Canvas, ORect);
|
|
FIndexs[State] := TGlyphList(FGlyphList).AddMasked(TmpImage, FTransparentColor);
|
|
end;
|
|
rbsDisabled:
|
|
if NumGlyphs > 1 then begin
|
|
TmpImage.Canvas.CopyRect(IRect, FOriginal.Canvas, ORect);
|
|
FIndexs[State] := TGlyphList(FGlyphList).AddMasked(TmpImage, FTransparentColor);
|
|
end
|
|
else begin
|
|
MonoBmp := CreateDisabledBitmap(FOriginal, clBlack);
|
|
try
|
|
FIndexs[State] := TGlyphList(FGlyphList).AddMasked(MonoBmp,
|
|
ColorToRGB(clBtnFace));
|
|
finally
|
|
MonoBmp.Free;
|
|
end;
|
|
end;
|
|
rbsInactive:
|
|
if NumGlyphs > 4 then begin
|
|
TmpImage.Canvas.CopyRect(IRect, FOriginal.Canvas, ORect);
|
|
FIndexs[State] := TGlyphList(FGlyphList).AddMasked(TmpImage, FTransparentColor);
|
|
end
|
|
else begin
|
|
with TmpImage do begin
|
|
for X := 0 to Width - 1 do
|
|
for Y := 0 to Height - 1 do
|
|
Canvas.Pixels[X, Y] := MapColor(FOriginal.Canvas.Pixels[X, Y]);
|
|
end;
|
|
FIndexs[State] := TGlyphList(FGlyphList).AddMasked(TmpImage, FTransparentColor);
|
|
end;
|
|
end;
|
|
finally
|
|
TmpImage.Free;
|
|
end;
|
|
Result := FIndexs[State];
|
|
FOriginal.Dormant;
|
|
end;
|
|
|
|
procedure TRxButtonGlyph.DrawPopupMark(Canvas: TCanvas; X, Y: Integer;
|
|
State: TRxButtonState);
|
|
var
|
|
AColor: TColor;
|
|
|
|
procedure DrawMark;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
with Canvas do begin
|
|
for I := 0 to 6 do begin
|
|
Pixels[X + I, Y - 1] := AColor;
|
|
if (I > 0) and (I < 6) then begin
|
|
Pixels[X + I, Y] := AColor;
|
|
if (I > 1) and (I < 5) then Pixels[X + I, Y + 1] := AColor;
|
|
end;
|
|
end;
|
|
Pixels[X + 3, Y + 2] := AColor;
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
if State = rbsDisabled then begin
|
|
AColor := clBtnHighlight;
|
|
Inc(X, 1); Inc(Y, 1);
|
|
DrawMark;
|
|
Dec(X, 1); Dec(Y, 1);
|
|
AColor := clBtnShadow;
|
|
end
|
|
else AColor := clBtnText;
|
|
DrawMark;
|
|
end;
|
|
|
|
function TRxButtonGlyph.DrawButtonGlyph(Canvas: TCanvas; X, Y: Integer;
|
|
State: TRxButtonState): TPoint;
|
|
var
|
|
Index: Integer;
|
|
begin
|
|
Result := Point(0, 0);
|
|
if (FOriginal = nil) or (FOriginal.Width = 0) or (FOriginal.Height = 0) or
|
|
FOriginal.Empty then Exit;
|
|
Index := CreateButtonGlyph(State);
|
|
if Index >= 0 then begin
|
|
{$IFDEF WIN32}
|
|
ImageList_Draw(FGlyphList.Handle, Index, Canvas.Handle, X, Y, ILD_NORMAL);
|
|
{$ELSE}
|
|
FGlyphList.Draw(Canvas, X, Y, Index);
|
|
{$ENDIF}
|
|
Result := Point(FGlyphList.Width, FGlyphList.Height);
|
|
end;
|
|
end;
|
|
|
|
{$IFDEF WIN32}
|
|
function TRxButtonGlyph.DrawButtonImage(Canvas: TCanvas; X, Y: Integer;
|
|
Images: TImageList; ImageIndex: Integer; State: TRxButtonState): TPoint;
|
|
var
|
|
Index: Integer;
|
|
begin
|
|
Result := Point(0, 0);
|
|
if (Images = nil) or (ImageIndex < 0) or (ImageIndex >= Images.Count) then
|
|
Exit;
|
|
if State = rbsDisabled then begin
|
|
ImageListDrawDisabled(Images, Canvas, X, Y, ImageIndex, clBtnHighlight,
|
|
clBtnShadow, True);
|
|
end
|
|
else if State = rbsInactive then begin
|
|
Index := CreateImageGlyph(State, Images, ImageIndex);
|
|
if Index >= 0 then
|
|
ImageList_Draw(FGlyphList.Handle, Index, Canvas.Handle, X, Y, ILD_NORMAL);
|
|
end
|
|
else
|
|
ImageList_Draw(Images.Handle, ImageIndex, Canvas.Handle, X, Y, ILD_NORMAL);
|
|
Result := Point(Images.Width, Images.Height);
|
|
end;
|
|
{$ENDIF}
|
|
|
|
procedure TRxButtonGlyph.MinimizeCaption(Canvas: TCanvas; const Caption: string;
|
|
Buffer: PChar; MaxLen, Width: Integer);
|
|
var
|
|
I: Integer;
|
|
{$IFNDEF WIN32}
|
|
P: PChar;
|
|
{$ENDIF}
|
|
Lines: TStrings;
|
|
begin
|
|
StrPLCopy(Buffer, Caption, MaxLen);
|
|
if FWordWrap then Exit;
|
|
Lines := TStringList.Create;
|
|
try
|
|
{$IFDEF WIN32}
|
|
Lines.Text := Caption;
|
|
for I := 0 to Lines.Count - 1 do
|
|
Lines[I] := MinimizeText(Lines[I], Canvas, Width);
|
|
StrPLCopy(Buffer, TrimRight(Lines.Text), MaxLen);
|
|
{$ELSE}
|
|
Lines.SetText(Buffer);
|
|
for I := 0 to Lines.Count - 1 do
|
|
Lines[I] := MinimizeText(Lines[I], Canvas, Width);
|
|
P := Lines.GetText;
|
|
try
|
|
StrPLCopy(Buffer, TrimRight(StrPas(P)), MaxLen);
|
|
finally
|
|
StrDispose(P);
|
|
end;
|
|
{$ENDIF}
|
|
finally
|
|
Lines.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TRxButtonGlyph.DrawButtonText(Canvas: TCanvas; const Caption: string;
|
|
TextBounds: TRect; State: TRxButtonState; Flags: Word);
|
|
var
|
|
CString: array[0..255] of Char;
|
|
begin
|
|
Canvas.Brush.Style := bsClear;
|
|
StrPLCopy(CString, Caption, SizeOf(CString) - 1);
|
|
Flags := DT_VCENTER or WordWraps[FWordWrap] or Flags;
|
|
if State = rbsDisabled then begin
|
|
with Canvas do begin
|
|
OffsetRect(TextBounds, 1, 1);
|
|
Font.Color := clBtnHighlight;
|
|
DrawText(Handle, CString, Length(Caption), TextBounds, Flags);
|
|
OffsetRect(TextBounds, -1, -1);
|
|
Font.Color := clBtnShadow;
|
|
DrawText(Handle, CString, Length(Caption), TextBounds, Flags);
|
|
end;
|
|
end
|
|
else DrawText(Canvas.Handle, CString, -1, TextBounds, Flags);
|
|
end;
|
|
|
|
procedure TRxButtonGlyph.CalcButtonLayout(Canvas: TCanvas; const Client: TRect;
|
|
var Caption: string; Layout: TButtonLayout; Margin, Spacing: Integer;
|
|
PopupMark: Boolean; var GlyphPos: TPoint; var TextBounds: TRect; Flags: Word
|
|
{$IFDEF WIN32}; Images: TImageList; ImageIndex: Integer {$ENDIF});
|
|
var
|
|
TextPos: TPoint;
|
|
MaxSize, ClientSize, GlyphSize, TextSize: TPoint;
|
|
TotalSize: TPoint;
|
|
CString: array[0..255] of Char;
|
|
begin
|
|
{ calculate the item sizes }
|
|
ClientSize := Point(Client.Right - Client.Left, Client.Bottom - Client.Top);
|
|
{$IFDEF WIN32}
|
|
if Assigned(Images) and (Images.Width > 0) and (ImageIndex >= 0) and
|
|
(ImageIndex < Images.Count) then
|
|
GlyphSize := Point(Images.Width, Images.Height)
|
|
else
|
|
{$ENDIF}
|
|
if FOriginal <> nil then
|
|
GlyphSize := Point(FOriginal.Width div FNumGlyphs, FOriginal.Height)
|
|
else GlyphSize := Point(0, 0);
|
|
if Layout in [blGlyphLeft, blGlyphRight] then begin
|
|
MaxSize.X := ClientSize.X - GlyphSize.X;
|
|
if Margin <> -1 then Dec(MaxSize.X, Margin);
|
|
if Spacing <> -1 then Dec(MaxSize.X, Spacing);
|
|
if PopupMark then Dec(MaxSize.X, 9);
|
|
MaxSize.Y := ClientSize.Y;
|
|
end
|
|
else { blGlyphTop, blGlyphBottom } begin
|
|
MaxSize.X := ClientSize.X;
|
|
MaxSize.Y := ClientSize.Y - GlyphSize.Y;
|
|
if Margin <> -1 then Dec(MaxSize.Y, Margin);
|
|
if Spacing <> -1 then Dec(MaxSize.Y, Spacing);
|
|
end;
|
|
MaxSize.X := Max(0, MaxSize.X);
|
|
MaxSize.Y := Max(0, MaxSize.Y);
|
|
MinimizeCaption(Canvas, Caption, CString, SizeOf(CString) - 1, MaxSize.X);
|
|
Caption := StrPas(CString);
|
|
if Length(Caption) > 0 then begin
|
|
TextBounds := Rect(0, 0, MaxSize.X, 0);
|
|
DrawText(Canvas.Handle, CString, -1, TextBounds, DT_CALCRECT or DT_CENTER
|
|
or DT_VCENTER or WordWraps[FWordWrap] or Flags);
|
|
end
|
|
else TextBounds := Rect(0, 0, 0, 0);
|
|
TextBounds.Bottom := Max(TextBounds.Top, TextBounds.Top +
|
|
Min(MaxSize.Y, HeightOf(TextBounds)));
|
|
TextBounds.Right := Max(TextBounds.Left, TextBounds.Left +
|
|
Min(MaxSize.X, WidthOf(TextBounds)));
|
|
TextSize := Point(TextBounds.Right - TextBounds.Left, TextBounds.Bottom -
|
|
TextBounds.Top);
|
|
if PopupMark then
|
|
if ((GlyphSize.X = 0) or (GlyphSize.Y = 0)) or (Layout = blGlyphLeft) then
|
|
Inc(TextSize.X, 9)
|
|
else if (GlyphSize.X > 0) then
|
|
Inc(GlyphSize.X, 6);
|
|
{ If the layout has the glyph on the right or the left, then both the
|
|
text and the glyph are centered vertically. If the glyph is on the top
|
|
or the bottom, then both the text and the glyph are centered horizontally.}
|
|
if Layout in [blGlyphLeft, blGlyphRight] then begin
|
|
GlyphPos.Y := (ClientSize.Y div 2) - (GlyphSize.Y div 2);
|
|
TextPos.Y := (ClientSize.Y div 2) - (TextSize.Y div 2);
|
|
end
|
|
else begin
|
|
GlyphPos.X := (ClientSize.X div 2) - (GlyphSize.X div 2);
|
|
TextPos.X := (ClientSize.X div 2) - (TextSize.X div 2);
|
|
end;
|
|
{ if there is no text or no bitmap, then Spacing is irrelevant }
|
|
if (TextSize.X = 0) or (GlyphSize.X = 0) then Spacing := 0;
|
|
{ adjust Margin and Spacing }
|
|
if Margin = -1 then begin
|
|
if Spacing = -1 then begin
|
|
TotalSize := Point(GlyphSize.X + TextSize.X, GlyphSize.Y + TextSize.Y);
|
|
if Layout in [blGlyphLeft, blGlyphRight] then
|
|
Margin := (ClientSize.X - TotalSize.X) div 3
|
|
else Margin := (ClientSize.Y - TotalSize.Y) div 3;
|
|
Spacing := Margin;
|
|
end
|
|
else begin
|
|
TotalSize := Point(GlyphSize.X + Spacing + TextSize.X, GlyphSize.Y +
|
|
Spacing + TextSize.Y);
|
|
if Layout in [blGlyphLeft, blGlyphRight] then
|
|
Margin := (ClientSize.X div 2) - (TotalSize.X div 2)
|
|
else Margin := (ClientSize.Y div 2) - (TotalSize.Y div 2);
|
|
end;
|
|
end
|
|
else begin
|
|
if Spacing = -1 then begin
|
|
TotalSize := Point(ClientSize.X - (Margin + GlyphSize.X), ClientSize.Y -
|
|
(Margin + GlyphSize.Y));
|
|
if Layout in [blGlyphLeft, blGlyphRight] then
|
|
Spacing := (TotalSize.X div 2) - (TextSize.X div 2)
|
|
else Spacing := (TotalSize.Y div 2) - (TextSize.Y div 2);
|
|
end;
|
|
end;
|
|
case Layout of
|
|
blGlyphLeft:
|
|
begin
|
|
GlyphPos.X := Margin;
|
|
TextPos.X := GlyphPos.X + GlyphSize.X + Spacing;
|
|
end;
|
|
blGlyphRight:
|
|
begin
|
|
GlyphPos.X := ClientSize.X - Margin - GlyphSize.X;
|
|
TextPos.X := GlyphPos.X - Spacing - TextSize.X;
|
|
end;
|
|
blGlyphTop:
|
|
begin
|
|
GlyphPos.Y := Margin;
|
|
TextPos.Y := GlyphPos.Y + GlyphSize.Y + Spacing;
|
|
end;
|
|
blGlyphBottom:
|
|
begin
|
|
GlyphPos.Y := ClientSize.Y - Margin - GlyphSize.Y;
|
|
TextPos.Y := GlyphPos.Y - Spacing - TextSize.Y;
|
|
end;
|
|
end;
|
|
{ fixup the result variables }
|
|
Inc(GlyphPos.X, Client.Left);
|
|
Inc(GlyphPos.Y, Client.Top);
|
|
OffsetRect(TextBounds, TextPos.X + Client.Left, TextPos.Y + Client.Top);
|
|
end;
|
|
|
|
{$IFDEF WIN32}
|
|
function TRxButtonGlyph.Draw(Canvas: TCanvas; const Client: TRect;
|
|
const Caption: string; Layout: TButtonLayout; Margin, Spacing: Integer;
|
|
PopupMark: Boolean; State: TRxButtonState; Flags: Word): TRect;
|
|
begin
|
|
Result := DrawEx(Canvas, Client, Caption, Layout, Margin, Spacing,
|
|
PopupMark, nil, -1, State, Flags);
|
|
end;
|
|
{$ENDIF}
|
|
|
|
{$IFDEF WIN32}
|
|
function TRxButtonGlyph.DrawEx(Canvas: TCanvas; const Client: TRect;
|
|
const Caption: string; Layout: TButtonLayout; Margin, Spacing: Integer;
|
|
PopupMark: Boolean; Images: TImageList; ImageIndex: Integer;
|
|
State: TRxButtonState; Flags: Word): TRect;
|
|
{$ELSE}
|
|
function TRxButtonGlyph.Draw(Canvas: TCanvas; const Client: TRect;
|
|
const Caption: string; Layout: TButtonLayout; Margin, Spacing: Integer;
|
|
PopupMark: Boolean; State: TRxButtonState; Flags: Word): TRect;
|
|
{$ENDIF}
|
|
var
|
|
{$IFDEF WIN32}
|
|
UseImages: Boolean;
|
|
{$ENDIF}
|
|
GlyphPos, PopupPos: TPoint;
|
|
TextBounds: TRect;
|
|
CaptionText: string;
|
|
begin
|
|
CaptionText := Caption;
|
|
CalcButtonLayout(Canvas, Client, CaptionText, Layout, Margin, Spacing,
|
|
PopupMark, GlyphPos, TextBounds, Flags {$IFDEF WIN32}, Images,
|
|
ImageIndex {$ENDIF});
|
|
{$IFDEF WIN32}
|
|
UseImages := False;
|
|
if Assigned(Images) and (ImageIndex >= 0) and (ImageIndex < Images.Count) and
|
|
(Images.Width > 0) then
|
|
begin
|
|
UseImages := True;
|
|
PopupPos := DrawButtonImage(Canvas, GlyphPos.X, GlyphPos.Y, Images,
|
|
ImageIndex, State);
|
|
end else
|
|
{$ENDIF}
|
|
PopupPos := DrawButtonGlyph(Canvas, GlyphPos.X, GlyphPos.Y, State);
|
|
DrawButtonText(Canvas, CaptionText, TextBounds, State, Flags);
|
|
if PopupMark then
|
|
if (Layout <> blGlyphLeft) and (((FOriginal <> nil) and
|
|
(FOriginal.Width > 0)) {$IFDEF WIN32} or UseImages {$ENDIF}) then
|
|
begin
|
|
PopupPos.X := GlyphPos.X + PopupPos.X + 1;
|
|
PopupPos.Y := GlyphPos.Y + PopupPos.Y div 2;
|
|
DrawPopupMark(Canvas, PopupPos.X, PopupPos.Y, State);
|
|
end
|
|
else begin
|
|
if CaptionText <> '' then
|
|
PopupPos.X := TextBounds.Right + 3
|
|
else
|
|
PopupPos.X := (Client.Left + Client.Right - 7) div 2;
|
|
PopupPos.Y := TextBounds.Top + HeightOf(TextBounds) div 2;
|
|
DrawPopupMark(Canvas, PopupPos.X, PopupPos.Y, State);
|
|
end;
|
|
Result := TextBounds;
|
|
end;
|
|
|
|
const
|
|
{$IFNDEF RX_D4}
|
|
Pattern: TBitmap = nil;
|
|
{$ENDIF}
|
|
ButtonCount: Integer = 0;
|
|
|
|
{ DrawButtonFrame - returns the remaining usable area inside the Client rect }
|
|
|
|
function DrawButtonFrame(Canvas: TCanvas; const Client: TRect;
|
|
IsDown, IsFlat: Boolean; Style: TButtonStyle): TRect;
|
|
var
|
|
NewStyle: Boolean;
|
|
begin
|
|
Result := Client;
|
|
NewStyle := (Style = bsNew) or (NewStyleControls and (Style = bsAutoDetect));
|
|
if IsDown then begin
|
|
if NewStyle then begin
|
|
Frame3D(Canvas, Result, clWindowFrame, clBtnHighlight, 1);
|
|
if not IsFlat then
|
|
Frame3D(Canvas, Result, clBtnShadow, clBtnFace, 1);
|
|
end
|
|
else begin
|
|
if IsFlat then
|
|
Frame3D(Canvas, Result, clWindowFrame, clBtnHighlight, 1)
|
|
else begin
|
|
Frame3D(Canvas, Result, clWindowFrame, clWindowFrame, 1);
|
|
Canvas.Pen.Color := clBtnShadow;
|
|
Canvas.PolyLine([Point(Result.Left, Result.Bottom - 1),
|
|
Point(Result.Left, Result.Top), Point(Result.Right, Result.Top)]);
|
|
end;
|
|
end;
|
|
end
|
|
else begin
|
|
if NewStyle then begin
|
|
if IsFlat then
|
|
Frame3D(Canvas, Result, clBtnHighlight, clBtnShadow, 1)
|
|
else begin
|
|
Frame3D(Canvas, Result, clBtnHighlight, clWindowFrame, 1);
|
|
Frame3D(Canvas, Result, clBtnFace, clBtnShadow, 1);
|
|
end;
|
|
end
|
|
else begin
|
|
if IsFlat then
|
|
Frame3D(Canvas, Result, clBtnHighlight, clWindowFrame, 1)
|
|
else begin
|
|
Frame3D(Canvas, Result, clWindowFrame, clWindowFrame, 1);
|
|
Frame3D(Canvas, Result, clBtnHighlight, clBtnShadow, 1);
|
|
end;
|
|
end;
|
|
end;
|
|
InflateRect(Result, -1, -1);
|
|
end;
|
|
|
|
{ TButtonImage }
|
|
|
|
constructor TButtonImage.Create;
|
|
begin
|
|
FGlyph := TRxButtonGlyph.Create;
|
|
NumGlyphs := 1;
|
|
FButtonSize := Point(24, 23);
|
|
end;
|
|
|
|
destructor TButtonImage.Destroy;
|
|
begin
|
|
FGlyph.Free;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TButtonImage.Invalidate;
|
|
begin
|
|
TRxButtonGlyph(FGlyph).Invalidate;
|
|
end;
|
|
|
|
function TButtonImage.GetNumGlyphs: TRxNumGlyphs;
|
|
begin
|
|
Result := TRxButtonGlyph(FGlyph).NumGlyphs;
|
|
end;
|
|
|
|
procedure TButtonImage.SetNumGlyphs(Value: TRxNumGlyphs);
|
|
begin
|
|
TRxButtonGlyph(FGlyph).NumGlyphs := Value;
|
|
end;
|
|
|
|
function TButtonImage.GetWordWrap: Boolean;
|
|
begin
|
|
Result := TRxButtonGlyph(FGlyph).WordWrap;
|
|
end;
|
|
|
|
procedure TButtonImage.SetWordWrap(Value: Boolean);
|
|
begin
|
|
TRxButtonGlyph(FGlyph).WordWrap := Value;
|
|
end;
|
|
|
|
function TButtonImage.GetGlyph: TBitmap;
|
|
begin
|
|
Result := TRxButtonGlyph(FGlyph).Glyph;
|
|
end;
|
|
|
|
procedure TButtonImage.SetGlyph(Value: TBitmap);
|
|
begin
|
|
TRxButtonGlyph(FGlyph).Glyph := Value;
|
|
end;
|
|
|
|
function TButtonImage.GetAlignment: TAlignment;
|
|
begin
|
|
Result := TRxButtonGlyph(FGlyph).Alignment;
|
|
end;
|
|
|
|
procedure TButtonImage.SetAlignment(Value: TAlignment);
|
|
begin
|
|
TRxButtonGlyph(FGlyph).Alignment := Value;
|
|
end;
|
|
|
|
{$IFDEF WIN32}
|
|
procedure TButtonImage.Draw(Canvas: TCanvas; X, Y, Margin, Spacing: Integer;
|
|
Layout: TButtonLayout; AFont: TFont; Flags: Word);
|
|
begin
|
|
DrawEx(Canvas, X, Y, Margin, Spacing, Layout, AFont, nil, -1, Flags);
|
|
end;
|
|
{$ENDIF}
|
|
|
|
{$IFDEF WIN32}
|
|
procedure TButtonImage.DrawEx(Canvas: TCanvas; X, Y, Margin, Spacing: Integer;
|
|
Layout: TButtonLayout; AFont: TFont; Images: TImageList; ImageIndex: Integer;
|
|
Flags: Word);
|
|
{$ELSE}
|
|
procedure TButtonImage.Draw(Canvas: TCanvas; X, Y, Margin, Spacing: Integer;
|
|
Layout: TButtonLayout; AFont: TFont; Flags: Word);
|
|
{$ENDIF}
|
|
var
|
|
Target: TRect;
|
|
SaveColor: Integer;
|
|
SaveFont: TFont;
|
|
begin
|
|
SaveColor := Canvas.Brush.Color;
|
|
SaveFont := TFont.Create;
|
|
SaveFont.Assign(Canvas.Font);
|
|
try
|
|
Target := Bounds(X, Y, FButtonSize.X, FButtonSize.Y);
|
|
Canvas.Brush.Color := clBtnFace;
|
|
Canvas.FillRect(Target);
|
|
Frame3D(Canvas, Target, clBtnShadow, clWindowFrame, 1);
|
|
Frame3D(Canvas, Target, clBtnHighlight, clBtnShadow, 1);
|
|
if AFont <> nil then Canvas.Font := AFont;
|
|
{$IFDEF WIN32}
|
|
TRxButtonGlyph(FGlyph).DrawEx(Canvas, Target, Caption, Layout, Margin,
|
|
Spacing, False, Images, ImageIndex, rbsUp, Flags);
|
|
{$ELSE}
|
|
TRxButtonGlyph(FGlyph).Draw(Canvas, Target, Caption, Layout, Margin,
|
|
Spacing, False, rbsUp, Flags);
|
|
{$ENDIF}
|
|
finally
|
|
Canvas.Font.Assign(SaveFont);
|
|
SaveFont.Free;
|
|
Canvas.Brush.Color := SaveColor;
|
|
end;
|
|
end;
|
|
|
|
{$ENDIF RX_D4}
|
|
|
|
{$IFDEF WIN32}
|
|
initialization
|
|
FCheckBitmap := nil;
|
|
finalization
|
|
DestroyLocals;
|
|
{$ELSE}
|
|
initialization
|
|
FCheckBitmap := nil;
|
|
AddExitProc(DestroyLocals);
|
|
{$ENDIF}
|
|
*)
|
|
|
|
{ TRxSpeedButton }
|
|
|
|
procedure TRxSpeedButton.SetAllowTimer(const AValue: Boolean);
|
|
begin
|
|
if FAllowTimer=AValue then exit;
|
|
FAllowTimer:=AValue;
|
|
if not FAllowTimer and (FRepeatTimer <> nil) then
|
|
begin
|
|
FRepeatTimer.Enabled := False;
|
|
FRepeatTimer.Free;
|
|
FRepeatTimer := nil;
|
|
end;
|
|
end;
|
|
|
|
procedure TRxSpeedButton.TimerExpired(Sender: TObject);
|
|
begin
|
|
FRepeatTimer.Interval := RepeatInterval;
|
|
if (FState = bsDown) and MouseCapture then
|
|
try
|
|
Click;
|
|
except
|
|
FRepeatTimer.Enabled := False;
|
|
raise;
|
|
end;
|
|
end;
|
|
|
|
procedure TRxSpeedButton.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
|
|
Y: Integer);
|
|
begin
|
|
inherited MouseDown(Button, Shift, X, Y);
|
|
if (Button = mbLeft) and Enabled then
|
|
begin
|
|
if FAllowTimer then begin
|
|
if FRepeatTimer = nil then
|
|
FRepeatTimer := TTimer.Create(nil);
|
|
FRepeatTimer.Interval := InitPause;
|
|
FRepeatTimer.OnTimer := @TimerExpired;
|
|
FRepeatTimer.Enabled := True;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TRxSpeedButton.MouseUp(Button: TMouseButton; Shift: TShiftState; X,
|
|
Y: Integer);
|
|
begin
|
|
inherited MouseUp(Button, Shift, X, Y);
|
|
if FRepeatTimer <> nil then FRepeatTimer.Enabled := False;
|
|
end;
|
|
|
|
constructor TRxSpeedButton.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
FInitRepeatPause := 500;
|
|
FRepeatPause := 100;
|
|
end;
|
|
|
|
destructor TRxSpeedButton.Destroy;
|
|
begin
|
|
inherited Destroy;
|
|
if FRepeatTimer <> nil then FRepeatTimer.Free;
|
|
end;
|
|
|
|
end.
|