1063 lines
29 KiB
ObjectPascal
1063 lines
29 KiB
ObjectPascal
|
|
{*****************************************************************************}
|
|
{ }
|
|
{ Tnt Delphi Unicode Controls }
|
|
{ http://www.tntware.com/delphicontrols/unicode/ }
|
|
{ Version: 2.3.0 }
|
|
{ }
|
|
{ Copyright (c) 2002-2007, Troy Wolbrink (troy.wolbrink@tntware.com) }
|
|
{ }
|
|
{*****************************************************************************}
|
|
|
|
unit TntExtCtrls;
|
|
|
|
{$INCLUDE TntCompilers.inc}
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes, Messages, Controls, ExtCtrls, TntClasses, TntControls, TntStdCtrls, TntGraphics;
|
|
|
|
type
|
|
{TNT-WARN TShape}
|
|
TTntShape = class(TShape{TNT-ALLOW TShape})
|
|
private
|
|
function GetHint: WideString;
|
|
procedure SetHint(const Value: WideString);
|
|
function IsHintStored: Boolean;
|
|
procedure CMHintShow(var Message: TMessage); message CM_HINTSHOW;
|
|
protected
|
|
procedure DefineProperties(Filer: TFiler); override;
|
|
function GetActionLinkClass: TControlActionLinkClass; override;
|
|
procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
|
|
published
|
|
property Hint: WideString read GetHint write SetHint stored IsHintStored;
|
|
end;
|
|
|
|
{TNT-WARN TPaintBox}
|
|
TTntPaintBox = class(TPaintBox{TNT-ALLOW TPaintBox})
|
|
private
|
|
function GetHint: WideString;
|
|
procedure SetHint(const Value: WideString);
|
|
function IsHintStored: Boolean;
|
|
procedure CMHintShow(var Message: TMessage); message CM_HINTSHOW;
|
|
protected
|
|
procedure DefineProperties(Filer: TFiler); override;
|
|
function GetActionLinkClass: TControlActionLinkClass; override;
|
|
procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
|
|
published
|
|
property Hint: WideString read GetHint write SetHint stored IsHintStored;
|
|
end;
|
|
|
|
{TNT-WARN TImage}
|
|
TTntImage = class(TImage{TNT-ALLOW TImage})
|
|
private
|
|
function GetHint: WideString;
|
|
procedure SetHint(const Value: WideString);
|
|
function IsHintStored: Boolean;
|
|
procedure CMHintShow(var Message: TMessage); message CM_HINTSHOW;
|
|
function GetPicture: TTntPicture;
|
|
procedure SetPicture(const Value: TTntPicture);
|
|
protected
|
|
procedure DefineProperties(Filer: TFiler); override;
|
|
function GetActionLinkClass: TControlActionLinkClass; override;
|
|
procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
published
|
|
property Hint: WideString read GetHint write SetHint stored IsHintStored;
|
|
property Picture: TTntPicture read GetPicture write SetPicture;
|
|
end;
|
|
|
|
{TNT-WARN TBevel}
|
|
TTntBevel = class(TBevel{TNT-ALLOW TBevel})
|
|
private
|
|
function GetHint: WideString;
|
|
procedure SetHint(const Value: WideString);
|
|
function IsHintStored: Boolean;
|
|
procedure CMHintShow(var Message: TMessage); message CM_HINTSHOW;
|
|
protected
|
|
procedure DefineProperties(Filer: TFiler); override;
|
|
function GetActionLinkClass: TControlActionLinkClass; override;
|
|
procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
|
|
published
|
|
property Hint: WideString read GetHint write SetHint stored IsHintStored;
|
|
end;
|
|
|
|
{TNT-WARN TCustomPanel}
|
|
TTntCustomPanel = class(TCustomPanel{TNT-ALLOW TCustomPanel})
|
|
private
|
|
function GetCaption: TWideCaption;
|
|
procedure SetCaption(const Value: TWideCaption);
|
|
function GetHint: WideString;
|
|
procedure SetHint(const Value: WideString);
|
|
function IsCaptionStored: Boolean;
|
|
function IsHintStored: Boolean;
|
|
protected
|
|
procedure Paint; override;
|
|
procedure CreateWindowHandle(const Params: TCreateParams); override;
|
|
procedure DefineProperties(Filer: TFiler); override;
|
|
function GetActionLinkClass: TControlActionLinkClass; override;
|
|
procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
|
|
property Caption: TWideCaption read GetCaption write SetCaption stored IsCaptionStored;
|
|
published
|
|
property Hint: WideString read GetHint write SetHint stored IsHintStored;
|
|
end;
|
|
|
|
{TNT-WARN TPanel}
|
|
TTntPanel = class(TTntCustomPanel)
|
|
public
|
|
property DockManager;
|
|
published
|
|
property Align;
|
|
property Alignment;
|
|
property Anchors;
|
|
property AutoSize;
|
|
property BevelEdges;
|
|
property BevelInner;
|
|
property BevelKind;
|
|
property BevelOuter;
|
|
property BevelWidth;
|
|
property BiDiMode;
|
|
property BorderWidth;
|
|
property BorderStyle;
|
|
property Caption;
|
|
property Color;
|
|
property Constraints;
|
|
property Ctl3D;
|
|
property UseDockManager default True;
|
|
property DockSite;
|
|
property DragCursor;
|
|
property DragKind;
|
|
property DragMode;
|
|
property Enabled;
|
|
property FullRepaint;
|
|
property Font;
|
|
property Locked;
|
|
{$IFDEF COMPILER_10_UP}
|
|
property Padding;
|
|
{$ENDIF}
|
|
property ParentBiDiMode;
|
|
{$IFDEF COMPILER_7_UP}
|
|
property ParentBackground;
|
|
{$ENDIF}
|
|
property ParentColor;
|
|
property ParentCtl3D;
|
|
property ParentFont;
|
|
property ParentShowHint;
|
|
property PopupMenu;
|
|
property ShowHint;
|
|
property TabOrder;
|
|
property TabStop;
|
|
{$IFDEF COMPILER_9_UP}
|
|
property VerticalAlignment;
|
|
{$ENDIF}
|
|
property Visible;
|
|
{$IFDEF COMPILER_9_UP}
|
|
property OnAlignInsertBefore;
|
|
property OnAlignPosition;
|
|
{$ENDIF}
|
|
property OnCanResize;
|
|
property OnClick;
|
|
property OnConstrainedResize;
|
|
property OnContextPopup;
|
|
property OnDockDrop;
|
|
property OnDockOver;
|
|
property OnDblClick;
|
|
property OnDragDrop;
|
|
property OnDragOver;
|
|
property OnEndDock;
|
|
property OnEndDrag;
|
|
property OnEnter;
|
|
property OnExit;
|
|
property OnGetSiteInfo;
|
|
{$IFDEF COMPILER_9_UP}
|
|
property OnMouseActivate;
|
|
{$ENDIF}
|
|
property OnMouseDown;
|
|
{$IFDEF COMPILER_10_UP}
|
|
property OnMouseEnter;
|
|
property OnMouseLeave;
|
|
{$ENDIF}
|
|
property OnMouseMove;
|
|
property OnMouseUp;
|
|
property OnResize;
|
|
property OnStartDock;
|
|
property OnStartDrag;
|
|
property OnUnDock;
|
|
end;
|
|
|
|
{TNT-WARN TCustomControlBar}
|
|
TTntCustomControlBar = class(TCustomControlBar{TNT-ALLOW TCustomControlBar})
|
|
private
|
|
function IsHintStored: Boolean;
|
|
function GetHint: WideString;
|
|
procedure SetHint(const Value: WideString);
|
|
protected
|
|
procedure CreateWindowHandle(const Params: TCreateParams); override;
|
|
procedure DefineProperties(Filer: TFiler); override;
|
|
function GetActionLinkClass: TControlActionLinkClass; override;
|
|
procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
|
|
published
|
|
property Hint: WideString read GetHint write SetHint stored IsHintStored;
|
|
end;
|
|
|
|
{TNT-WARN TControlBar}
|
|
TTntControlBar = class(TTntCustomControlBar)
|
|
public
|
|
property Canvas;
|
|
published
|
|
property Align;
|
|
property Anchors;
|
|
property AutoDock;
|
|
property AutoDrag;
|
|
property AutoSize;
|
|
property BevelEdges;
|
|
property BevelInner;
|
|
property BevelOuter;
|
|
property BevelKind;
|
|
property BevelWidth;
|
|
property BorderWidth;
|
|
property Color {$IFDEF COMPILER_7_UP} nodefault {$ENDIF};
|
|
property Constraints;
|
|
{$IFDEF COMPILER_10_UP}
|
|
property CornerEdge;
|
|
{$ENDIF}
|
|
property DockSite;
|
|
property DragCursor;
|
|
property DragKind;
|
|
property DragMode;
|
|
{$IFDEF COMPILER_10_UP}
|
|
property DrawingStyle;
|
|
{$ENDIF}
|
|
property Enabled;
|
|
{$IFDEF COMPILER_10_UP}
|
|
property GradientDirection;
|
|
property GradientEndColor;
|
|
property GradientStartColor;
|
|
{$ENDIF}
|
|
{$IFDEF COMPILER_7_UP}
|
|
property ParentBackground default True;
|
|
{$ENDIF}
|
|
property ParentColor;
|
|
property ParentCtl3D;
|
|
property ParentFont;
|
|
property ParentShowHint;
|
|
property Picture;
|
|
property PopupMenu;
|
|
property RowSize;
|
|
property RowSnap;
|
|
property ShowHint;
|
|
property TabOrder;
|
|
property TabStop;
|
|
property Visible;
|
|
{$IFDEF COMPILER_9_UP}
|
|
property OnAlignInsertBefore;
|
|
property OnAlignPosition;
|
|
{$ENDIF}
|
|
property OnBandDrag;
|
|
property OnBandInfo;
|
|
property OnBandMove;
|
|
property OnBandPaint;
|
|
{$IFDEF COMPILER_9_UP}
|
|
property OnBeginBandMove;
|
|
property OnEndBandMove;
|
|
{$ENDIF}
|
|
property OnCanResize;
|
|
property OnClick;
|
|
property OnConstrainedResize;
|
|
property OnContextPopup;
|
|
property OnDockDrop;
|
|
property OnDockOver;
|
|
property OnDblClick;
|
|
property OnDragDrop;
|
|
property OnDragOver;
|
|
property OnEndDock;
|
|
property OnEndDrag;
|
|
property OnEnter;
|
|
property OnExit;
|
|
property OnGetSiteInfo;
|
|
{$IFDEF COMPILER_9_UP}
|
|
property OnMouseActivate;
|
|
{$ENDIF}
|
|
property OnMouseDown;
|
|
{$IFDEF COMPILER_10_UP}
|
|
property OnMouseEnter;
|
|
property OnMouseLeave;
|
|
{$ENDIF}
|
|
property OnMouseMove;
|
|
property OnMouseUp;
|
|
property OnPaint;
|
|
property OnResize;
|
|
property OnStartDock;
|
|
property OnStartDrag;
|
|
property OnUnDock;
|
|
end;
|
|
|
|
{TNT-WARN TCustomRadioGroup}
|
|
TTntCustomRadioGroup = class(TTntCustomGroupBox)
|
|
private
|
|
FButtons: TList;
|
|
FItems: TTntStrings;
|
|
FItemIndex: Integer;
|
|
FColumns: Integer;
|
|
FReading: Boolean;
|
|
FUpdating: Boolean;
|
|
function GetButtons(Index: Integer): TTntRadioButton;
|
|
procedure ArrangeButtons;
|
|
procedure ButtonClick(Sender: TObject);
|
|
procedure ItemsChange(Sender: TObject);
|
|
procedure SetButtonCount(Value: Integer);
|
|
procedure SetColumns(Value: Integer);
|
|
procedure SetItemIndex(Value: Integer);
|
|
procedure SetItems(Value: TTntStrings);
|
|
procedure UpdateButtons;
|
|
procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
|
|
procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
|
|
procedure WMSize(var Message: TWMSize); message WM_SIZE;
|
|
protected
|
|
procedure Loaded; override;
|
|
procedure ReadState(Reader: TReader); override;
|
|
function CanModify: Boolean; virtual;
|
|
procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
|
|
property Columns: Integer read FColumns write SetColumns default 1;
|
|
property ItemIndex: Integer read FItemIndex write SetItemIndex default -1;
|
|
property Items: TTntStrings read FItems write SetItems;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
procedure FlipChildren(AllLevels: Boolean); override;
|
|
property Buttons[Index: Integer]: TTntRadioButton read GetButtons;
|
|
end;
|
|
|
|
{TNT-WARN TRadioGroup}
|
|
TTntRadioGroup = class(TTntCustomRadioGroup)
|
|
published
|
|
property Align;
|
|
property Anchors;
|
|
property BiDiMode;
|
|
property Caption;
|
|
property Color;
|
|
property Columns;
|
|
property Ctl3D;
|
|
property DragCursor;
|
|
property DragKind;
|
|
property DragMode;
|
|
property Enabled;
|
|
property Font;
|
|
property ItemIndex;
|
|
property Items;
|
|
property Constraints;
|
|
property ParentBiDiMode;
|
|
{$IFDEF COMPILER_7_UP}
|
|
property ParentBackground default True;
|
|
{$ENDIF}
|
|
property ParentColor;
|
|
property ParentCtl3D;
|
|
property ParentFont;
|
|
property ParentShowHint;
|
|
property PopupMenu;
|
|
property ShowHint;
|
|
property TabOrder;
|
|
property TabStop;
|
|
property Visible;
|
|
property OnClick;
|
|
property OnContextPopup;
|
|
property OnDragDrop;
|
|
property OnDragOver;
|
|
property OnEndDock;
|
|
property OnEndDrag;
|
|
property OnEnter;
|
|
property OnExit;
|
|
property OnStartDock;
|
|
property OnStartDrag;
|
|
end;
|
|
|
|
{TNT-WARN TSplitter}
|
|
TTntSplitter = class(TSplitter{TNT-ALLOW TSplitter})
|
|
private
|
|
function GetHint: WideString;
|
|
procedure SetHint(const Value: WideString);
|
|
function IsHintStored: Boolean;
|
|
procedure CMHintShow(var Message: TMessage); message CM_HINTSHOW;
|
|
protected
|
|
procedure DefineProperties(Filer: TFiler); override;
|
|
function GetActionLinkClass: TControlActionLinkClass; override;
|
|
procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
|
|
published
|
|
property Hint: WideString read GetHint write SetHint stored IsHintStored;
|
|
end;
|
|
|
|
implementation
|
|
|
|
uses
|
|
Windows, Graphics, Forms, {$IFDEF THEME_7_UP} Themes, {$ENDIF}
|
|
TntSysUtils, TntWindows, TntActnList;
|
|
|
|
{ TTntShape }
|
|
|
|
procedure TTntShape.DefineProperties(Filer: TFiler);
|
|
begin
|
|
inherited;
|
|
TntPersistent_AfterInherited_DefineProperties(Filer, Self);
|
|
end;
|
|
|
|
function TTntShape.IsHintStored: Boolean;
|
|
begin
|
|
Result := TntControl_IsHintStored(Self)
|
|
end;
|
|
|
|
function TTntShape.GetHint: WideString;
|
|
begin
|
|
Result := TntControl_GetHint(Self)
|
|
end;
|
|
|
|
procedure TTntShape.SetHint(const Value: WideString);
|
|
begin
|
|
TntControl_SetHint(Self, Value);
|
|
end;
|
|
|
|
procedure TTntShape.CMHintShow(var Message: TMessage);
|
|
begin
|
|
ProcessCMHintShowMsg(Message);
|
|
inherited;
|
|
end;
|
|
|
|
procedure TTntShape.ActionChange(Sender: TObject; CheckDefaults: Boolean);
|
|
begin
|
|
TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
|
|
inherited;
|
|
end;
|
|
|
|
function TTntShape.GetActionLinkClass: TControlActionLinkClass;
|
|
begin
|
|
Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
|
|
end;
|
|
|
|
{ TTntPaintBox }
|
|
|
|
procedure TTntPaintBox.DefineProperties(Filer: TFiler);
|
|
begin
|
|
inherited;
|
|
TntPersistent_AfterInherited_DefineProperties(Filer, Self);
|
|
end;
|
|
|
|
function TTntPaintBox.IsHintStored: Boolean;
|
|
begin
|
|
Result := TntControl_IsHintStored(Self)
|
|
end;
|
|
|
|
function TTntPaintBox.GetHint: WideString;
|
|
begin
|
|
Result := TntControl_GetHint(Self)
|
|
end;
|
|
|
|
procedure TTntPaintBox.SetHint(const Value: WideString);
|
|
begin
|
|
TntControl_SetHint(Self, Value);
|
|
end;
|
|
|
|
procedure TTntPaintBox.CMHintShow(var Message: TMessage);
|
|
begin
|
|
ProcessCMHintShowMsg(Message);
|
|
inherited;
|
|
end;
|
|
|
|
procedure TTntPaintBox.ActionChange(Sender: TObject; CheckDefaults: Boolean);
|
|
begin
|
|
TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
|
|
inherited;
|
|
end;
|
|
|
|
function TTntPaintBox.GetActionLinkClass: TControlActionLinkClass;
|
|
begin
|
|
Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
|
|
end;
|
|
|
|
type
|
|
{$IFDEF COMPILER_6} // verified against VCL source in Delphi 6 and BCB 6
|
|
THackImage = class(TGraphicControl)
|
|
protected
|
|
FPicture: TPicture{TNT-ALLOW TPicture};
|
|
end;
|
|
{$ENDIF}
|
|
{$IFDEF DELPHI_7} // verified against VCL source in Delphi 7
|
|
THackImage = class(TGraphicControl)
|
|
protected
|
|
FPicture: TPicture{TNT-ALLOW TPicture};
|
|
end;
|
|
{$ENDIF}
|
|
{$IFDEF DELPHI_9} // verified against VCL source in Delphi 9
|
|
THackImage = class(TGraphicControl)
|
|
private
|
|
FPicture: TPicture{TNT-ALLOW TPicture};
|
|
end;
|
|
{$ENDIF}
|
|
{$IFDEF DELPHI_10} // verified against VCL source in Delphi 10
|
|
THackImage = class(TGraphicControl)
|
|
private
|
|
FPicture: TPicture{TNT-ALLOW TPicture};
|
|
end;
|
|
{$ENDIF}
|
|
|
|
{ TTntImage }
|
|
|
|
constructor TTntImage.Create(AOwner: TComponent);
|
|
var
|
|
OldPicture: TPicture{TNT-ALLOW TPicture};
|
|
begin
|
|
inherited;
|
|
OldPicture := THackImage(Self).FPicture;
|
|
THackImage(Self).FPicture := TTntPicture.Create;
|
|
Picture.OnChange := OldPicture.OnChange;
|
|
Picture.OnProgress := OldPicture.OnProgress;
|
|
OldPicture.Free;
|
|
end;
|
|
|
|
function TTntImage.GetPicture: TTntPicture;
|
|
begin
|
|
Result := inherited Picture as TTntPicture;
|
|
end;
|
|
|
|
procedure TTntImage.SetPicture(const Value: TTntPicture);
|
|
begin
|
|
inherited Picture := Value;
|
|
end;
|
|
|
|
procedure TTntImage.DefineProperties(Filer: TFiler);
|
|
begin
|
|
inherited;
|
|
TntPersistent_AfterInherited_DefineProperties(Filer, Self);
|
|
end;
|
|
|
|
function TTntImage.IsHintStored: Boolean;
|
|
begin
|
|
Result := TntControl_IsHintStored(Self)
|
|
end;
|
|
|
|
function TTntImage.GetHint: WideString;
|
|
begin
|
|
Result := TntControl_GetHint(Self)
|
|
end;
|
|
|
|
procedure TTntImage.SetHint(const Value: WideString);
|
|
begin
|
|
TntControl_SetHint(Self, Value);
|
|
end;
|
|
|
|
procedure TTntImage.CMHintShow(var Message: TMessage);
|
|
begin
|
|
ProcessCMHintShowMsg(Message);
|
|
inherited;
|
|
end;
|
|
|
|
procedure TTntImage.ActionChange(Sender: TObject; CheckDefaults: Boolean);
|
|
begin
|
|
TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
|
|
inherited;
|
|
end;
|
|
|
|
function TTntImage.GetActionLinkClass: TControlActionLinkClass;
|
|
begin
|
|
Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
|
|
end;
|
|
|
|
{ TTntBevel }
|
|
|
|
procedure TTntBevel.DefineProperties(Filer: TFiler);
|
|
begin
|
|
inherited;
|
|
TntPersistent_AfterInherited_DefineProperties(Filer, Self);
|
|
end;
|
|
|
|
function TTntBevel.IsHintStored: Boolean;
|
|
begin
|
|
Result := TntControl_IsHintStored(Self)
|
|
end;
|
|
|
|
function TTntBevel.GetHint: WideString;
|
|
begin
|
|
Result := TntControl_GetHint(Self)
|
|
end;
|
|
|
|
procedure TTntBevel.SetHint(const Value: WideString);
|
|
begin
|
|
TntControl_SetHint(Self, Value);
|
|
end;
|
|
|
|
procedure TTntBevel.CMHintShow(var Message: TMessage);
|
|
begin
|
|
ProcessCMHintShowMsg(Message);
|
|
inherited;
|
|
end;
|
|
|
|
procedure TTntBevel.ActionChange(Sender: TObject; CheckDefaults: Boolean);
|
|
begin
|
|
TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
|
|
inherited;
|
|
end;
|
|
|
|
function TTntBevel.GetActionLinkClass: TControlActionLinkClass;
|
|
begin
|
|
Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
|
|
end;
|
|
|
|
{ TTntCustomPanel }
|
|
|
|
procedure TTntCustomPanel.CreateWindowHandle(const Params: TCreateParams);
|
|
begin
|
|
CreateUnicodeHandle(Self, Params, '');
|
|
end;
|
|
|
|
procedure TTntCustomPanel.DefineProperties(Filer: TFiler);
|
|
begin
|
|
inherited;
|
|
TntPersistent_AfterInherited_DefineProperties(Filer, Self);
|
|
end;
|
|
|
|
function TTntCustomPanel.IsCaptionStored: Boolean;
|
|
begin
|
|
Result := TntControl_IsCaptionStored(Self);
|
|
end;
|
|
|
|
function TTntCustomPanel.GetCaption: TWideCaption;
|
|
begin
|
|
Result := TntControl_GetText(Self)
|
|
end;
|
|
|
|
procedure TTntCustomPanel.SetCaption(const Value: TWideCaption);
|
|
begin
|
|
TntControl_SetText(Self, Value);
|
|
end;
|
|
|
|
procedure TTntCustomPanel.Paint;
|
|
const
|
|
Alignments: array[TAlignment] of Longint = (DT_LEFT, DT_RIGHT, DT_CENTER);
|
|
var
|
|
Rect: TRect;
|
|
TopColor, BottomColor: TColor;
|
|
FontHeight: Integer;
|
|
Flags: Longint;
|
|
|
|
procedure AdjustColors(Bevel: TPanelBevel);
|
|
begin
|
|
TopColor := clBtnHighlight;
|
|
if Bevel = bvLowered then TopColor := clBtnShadow;
|
|
BottomColor := clBtnShadow;
|
|
if Bevel = bvLowered then BottomColor := clBtnHighlight;
|
|
end;
|
|
|
|
begin
|
|
if (not Win32PlatformIsUnicode) then
|
|
inherited
|
|
else begin
|
|
Rect := GetClientRect;
|
|
if BevelOuter <> bvNone then
|
|
begin
|
|
AdjustColors(BevelOuter);
|
|
Frame3D(Canvas, Rect, TopColor, BottomColor, BevelWidth);
|
|
end;
|
|
{$IFDEF THEME_7_UP}
|
|
if ThemeServices.ThemesEnabled {$IFDEF COMPILER_7_UP} and ParentBackground {$ENDIF} then
|
|
InflateRect(Rect, -BorderWidth, -BorderWidth)
|
|
else
|
|
{$ENDIF}
|
|
begin
|
|
Frame3D(Canvas, Rect, Color, Color, BorderWidth);
|
|
end;
|
|
if BevelInner <> bvNone then
|
|
begin
|
|
AdjustColors(BevelInner);
|
|
Frame3D(Canvas, Rect, TopColor, BottomColor, BevelWidth);
|
|
end;
|
|
with Canvas do
|
|
begin
|
|
{$IFDEF THEME_7_UP}
|
|
if not ThemeServices.ThemesEnabled {$IFDEF COMPILER_7_UP} or not ParentBackground {$ENDIF} then
|
|
{$ENDIF}
|
|
begin
|
|
Brush.Color := Color;
|
|
FillRect(Rect);
|
|
end;
|
|
Brush.Style := bsClear;
|
|
Font := Self.Font;
|
|
FontHeight := WideCanvasTextHeight(Canvas, 'W');
|
|
with Rect do
|
|
begin
|
|
Top := ((Bottom + Top) - FontHeight) div 2;
|
|
Bottom := Top + FontHeight;
|
|
end;
|
|
Flags := DT_EXPANDTABS or DT_VCENTER or Alignments[Alignment];
|
|
Flags := DrawTextBiDiModeFlags(Flags);
|
|
Tnt_DrawTextW(Handle, PWideChar(Caption), -1, Rect, Flags);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TTntCustomPanel.IsHintStored: Boolean;
|
|
begin
|
|
Result := TntControl_IsHintStored(Self)
|
|
end;
|
|
|
|
function TTntCustomPanel.GetHint: WideString;
|
|
begin
|
|
Result := TntControl_GetHint(Self);
|
|
end;
|
|
|
|
procedure TTntCustomPanel.SetHint(const Value: WideString);
|
|
begin
|
|
TntControl_SetHint(Self, Value);
|
|
end;
|
|
|
|
procedure TTntCustomPanel.ActionChange(Sender: TObject; CheckDefaults: Boolean);
|
|
begin
|
|
TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
|
|
inherited;
|
|
end;
|
|
|
|
function TTntCustomPanel.GetActionLinkClass: TControlActionLinkClass;
|
|
begin
|
|
Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
|
|
end;
|
|
|
|
{ TTntCustomControlBar }
|
|
|
|
procedure TTntCustomControlBar.CreateWindowHandle(const Params: TCreateParams);
|
|
begin
|
|
CreateUnicodeHandle(Self, Params, '');
|
|
end;
|
|
|
|
procedure TTntCustomControlBar.DefineProperties(Filer: TFiler);
|
|
begin
|
|
inherited;
|
|
TntPersistent_AfterInherited_DefineProperties(Filer, Self);
|
|
end;
|
|
|
|
function TTntCustomControlBar.IsHintStored: Boolean;
|
|
begin
|
|
Result := TntControl_IsHintStored(Self);
|
|
end;
|
|
|
|
function TTntCustomControlBar.GetHint: WideString;
|
|
begin
|
|
Result := TntControl_GetHint(Self);
|
|
end;
|
|
|
|
procedure TTntCustomControlBar.SetHint(const Value: WideString);
|
|
begin
|
|
TntControl_SetHint(Self, Value);
|
|
end;
|
|
|
|
procedure TTntCustomControlBar.ActionChange(Sender: TObject; CheckDefaults: Boolean);
|
|
begin
|
|
TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
|
|
inherited;
|
|
end;
|
|
|
|
function TTntCustomControlBar.GetActionLinkClass: TControlActionLinkClass;
|
|
begin
|
|
Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
|
|
end;
|
|
|
|
{ TTntGroupButton }
|
|
|
|
type
|
|
TTntGroupButton = class(TTntRadioButton)
|
|
private
|
|
FInClick: Boolean;
|
|
procedure CNCommand(var Message: TWMCommand); message CN_COMMAND;
|
|
protected
|
|
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
|
|
procedure KeyPress(var Key: Char{TNT-ALLOW Char}); override;
|
|
public
|
|
constructor InternalCreate(RadioGroup: TTntCustomRadioGroup);
|
|
destructor Destroy; override;
|
|
end;
|
|
|
|
constructor TTntGroupButton.InternalCreate(RadioGroup: TTntCustomRadioGroup);
|
|
begin
|
|
inherited Create(RadioGroup);
|
|
RadioGroup.FButtons.Add(Self);
|
|
Visible := False;
|
|
Enabled := RadioGroup.Enabled;
|
|
ParentShowHint := False;
|
|
OnClick := RadioGroup.ButtonClick;
|
|
Parent := RadioGroup;
|
|
end;
|
|
|
|
destructor TTntGroupButton.Destroy;
|
|
begin
|
|
TTntCustomRadioGroup(Owner).FButtons.Remove(Self);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TTntGroupButton.CNCommand(var Message: TWMCommand);
|
|
begin
|
|
if not FInClick then
|
|
begin
|
|
FInClick := True;
|
|
try
|
|
if ((Message.NotifyCode = BN_CLICKED) or
|
|
(Message.NotifyCode = BN_DOUBLECLICKED)) and
|
|
TTntCustomRadioGroup(Parent).CanModify then
|
|
inherited;
|
|
except
|
|
Application.HandleException(Self);
|
|
end;
|
|
FInClick := False;
|
|
end;
|
|
end;
|
|
|
|
procedure TTntGroupButton.KeyPress(var Key: Char{TNT-ALLOW Char});
|
|
begin
|
|
inherited KeyPress(Key);
|
|
TTntCustomRadioGroup(Parent).KeyPress(Key);
|
|
if (Key = #8) or (Key = ' ') then
|
|
begin
|
|
if not TTntCustomRadioGroup(Parent).CanModify then Key := #0;
|
|
end;
|
|
end;
|
|
|
|
procedure TTntGroupButton.KeyDown(var Key: Word; Shift: TShiftState);
|
|
begin
|
|
inherited KeyDown(Key, Shift);
|
|
TTntCustomRadioGroup(Parent).KeyDown(Key, Shift);
|
|
end;
|
|
|
|
{ TTntCustomRadioGroup }
|
|
|
|
constructor TTntCustomRadioGroup.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
ControlStyle := [csSetCaption, csDoubleClicks {$IFDEF COMPILER_7_UP}, csParentBackground {$ENDIF}];
|
|
FButtons := TList.Create;
|
|
FItems := TTntStringList.Create;
|
|
TTntStringList(FItems).OnChange := ItemsChange;
|
|
FItemIndex := -1;
|
|
FColumns := 1;
|
|
end;
|
|
|
|
destructor TTntCustomRadioGroup.Destroy;
|
|
begin
|
|
SetButtonCount(0);
|
|
TTntStringList(FItems).OnChange := nil;
|
|
FItems.Free;
|
|
FButtons.Free;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TTntCustomRadioGroup.FlipChildren(AllLevels: Boolean);
|
|
begin
|
|
{ The radio buttons are flipped using BiDiMode }
|
|
end;
|
|
|
|
procedure TTntCustomRadioGroup.ArrangeButtons;
|
|
var
|
|
ButtonsPerCol, ButtonWidth, ButtonHeight, TopMargin, I: Integer;
|
|
DC: HDC;
|
|
SaveFont: HFont;
|
|
Metrics: TTextMetric;
|
|
DeferHandle: THandle;
|
|
ALeft: Integer;
|
|
begin
|
|
if (FButtons.Count <> 0) and not FReading then
|
|
begin
|
|
DC := GetDC(0);
|
|
SaveFont := SelectObject(DC, Font.Handle);
|
|
GetTextMetrics(DC, Metrics);
|
|
SelectObject(DC, SaveFont);
|
|
ReleaseDC(0, DC);
|
|
ButtonsPerCol := (FButtons.Count + FColumns - 1) div FColumns;
|
|
ButtonWidth := (Width - 10) div FColumns;
|
|
I := Height - Metrics.tmHeight - 5;
|
|
ButtonHeight := I div ButtonsPerCol;
|
|
TopMargin := Metrics.tmHeight + 1 + (I mod ButtonsPerCol) div 2;
|
|
DeferHandle := BeginDeferWindowPos(FButtons.Count);
|
|
try
|
|
for I := 0 to FButtons.Count - 1 do
|
|
with TTntGroupButton(FButtons[I]) do
|
|
begin
|
|
BiDiMode := Self.BiDiMode;
|
|
ALeft := (I div ButtonsPerCol) * ButtonWidth + 8;
|
|
if UseRightToLeftAlignment then
|
|
ALeft := Self.ClientWidth - ALeft - ButtonWidth;
|
|
DeferHandle := DeferWindowPos(DeferHandle, Handle, 0,
|
|
ALeft,
|
|
(I mod ButtonsPerCol) * ButtonHeight + TopMargin,
|
|
ButtonWidth, ButtonHeight,
|
|
SWP_NOZORDER or SWP_NOACTIVATE);
|
|
Visible := True;
|
|
end;
|
|
finally
|
|
EndDeferWindowPos(DeferHandle);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TTntCustomRadioGroup.ButtonClick(Sender: TObject);
|
|
begin
|
|
if not FUpdating then
|
|
begin
|
|
FItemIndex := FButtons.IndexOf(Sender);
|
|
Changed;
|
|
Click;
|
|
end;
|
|
end;
|
|
|
|
procedure TTntCustomRadioGroup.ItemsChange(Sender: TObject);
|
|
begin
|
|
if not FReading then
|
|
begin
|
|
if FItemIndex >= FItems.Count then FItemIndex := FItems.Count - 1;
|
|
UpdateButtons;
|
|
end;
|
|
end;
|
|
|
|
procedure TTntCustomRadioGroup.Loaded;
|
|
begin
|
|
inherited Loaded;
|
|
ArrangeButtons;
|
|
end;
|
|
|
|
procedure TTntCustomRadioGroup.ReadState(Reader: TReader);
|
|
begin
|
|
FReading := True;
|
|
inherited ReadState(Reader);
|
|
FReading := False;
|
|
UpdateButtons;
|
|
end;
|
|
|
|
procedure TTntCustomRadioGroup.SetButtonCount(Value: Integer);
|
|
begin
|
|
while FButtons.Count < Value do TTntGroupButton.InternalCreate(Self);
|
|
while FButtons.Count > Value do TTntGroupButton(FButtons.Last).Free;
|
|
end;
|
|
|
|
procedure TTntCustomRadioGroup.SetColumns(Value: Integer);
|
|
begin
|
|
if Value < 1 then Value := 1;
|
|
if Value > 16 then Value := 16;
|
|
if FColumns <> Value then
|
|
begin
|
|
FColumns := Value;
|
|
ArrangeButtons;
|
|
Invalidate;
|
|
end;
|
|
end;
|
|
|
|
procedure TTntCustomRadioGroup.SetItemIndex(Value: Integer);
|
|
begin
|
|
if FReading then FItemIndex := Value else
|
|
begin
|
|
if Value < -1 then Value := -1;
|
|
if Value >= FButtons.Count then Value := FButtons.Count - 1;
|
|
if FItemIndex <> Value then
|
|
begin
|
|
if FItemIndex >= 0 then
|
|
TTntGroupButton(FButtons[FItemIndex]).Checked := False;
|
|
FItemIndex := Value;
|
|
if FItemIndex >= 0 then
|
|
TTntGroupButton(FButtons[FItemIndex]).Checked := True;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TTntCustomRadioGroup.SetItems(Value: TTntStrings);
|
|
begin
|
|
FItems.Assign(Value);
|
|
end;
|
|
|
|
procedure TTntCustomRadioGroup.UpdateButtons;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
SetButtonCount(FItems.Count);
|
|
for I := 0 to FButtons.Count - 1 do
|
|
TTntGroupButton(FButtons[I]).Caption := FItems[I];
|
|
if FItemIndex >= 0 then
|
|
begin
|
|
FUpdating := True;
|
|
TTntGroupButton(FButtons[FItemIndex]).Checked := True;
|
|
FUpdating := False;
|
|
end;
|
|
ArrangeButtons;
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TTntCustomRadioGroup.CMEnabledChanged(var Message: TMessage);
|
|
var
|
|
I: Integer;
|
|
begin
|
|
inherited;
|
|
for I := 0 to FButtons.Count - 1 do
|
|
TTntGroupButton(FButtons[I]).Enabled := Enabled;
|
|
end;
|
|
|
|
procedure TTntCustomRadioGroup.CMFontChanged(var Message: TMessage);
|
|
begin
|
|
inherited;
|
|
ArrangeButtons;
|
|
end;
|
|
|
|
procedure TTntCustomRadioGroup.WMSize(var Message: TWMSize);
|
|
begin
|
|
inherited;
|
|
ArrangeButtons;
|
|
end;
|
|
|
|
function TTntCustomRadioGroup.CanModify: Boolean;
|
|
begin
|
|
Result := True;
|
|
end;
|
|
|
|
procedure TTntCustomRadioGroup.GetChildren(Proc: TGetChildProc; Root: TComponent);
|
|
begin
|
|
end;
|
|
|
|
function TTntCustomRadioGroup.GetButtons(Index: Integer): TTntRadioButton;
|
|
begin
|
|
Result := TTntRadioButton(FButtons[Index]);
|
|
end;
|
|
|
|
{ TTntSplitter }
|
|
|
|
procedure TTntSplitter.DefineProperties(Filer: TFiler);
|
|
begin
|
|
inherited;
|
|
TntPersistent_AfterInherited_DefineProperties(Filer, Self);
|
|
end;
|
|
|
|
function TTntSplitter.IsHintStored: Boolean;
|
|
begin
|
|
Result := TntControl_IsHintStored(Self)
|
|
end;
|
|
|
|
function TTntSplitter.GetHint: WideString;
|
|
begin
|
|
Result := TntControl_GetHint(Self)
|
|
end;
|
|
|
|
procedure TTntSplitter.SetHint(const Value: WideString);
|
|
begin
|
|
TntControl_SetHint(Self, Value);
|
|
end;
|
|
|
|
procedure TTntSplitter.CMHintShow(var Message: TMessage);
|
|
begin
|
|
ProcessCMHintShowMsg(Message);
|
|
inherited;
|
|
end;
|
|
|
|
procedure TTntSplitter.ActionChange(Sender: TObject; CheckDefaults: Boolean);
|
|
begin
|
|
TntControl_BeforeInherited_ActionChange(Self, Sender, CheckDefaults);
|
|
inherited;
|
|
end;
|
|
|
|
function TTntSplitter.GetActionLinkClass: TControlActionLinkClass;
|
|
begin
|
|
Result := TntControl_GetActionLinkClass(Self, inherited GetActionLinkClass);
|
|
end;
|
|
|
|
end.
|