Delphi控件源码

开发平台：

Delphi

bsSkinCtrls.pas：源码内容

{*******************************************************************}
{ }
{ Almediadev Visual Component Library }
{ BusinessSkinForm }
{ Version 2.90 }
{ }
{ }
{ Home: http://www.almdev.com }
{ Support: support@almdev.com }
{ }
{*******************************************************************}
unit bsSkinCtrls;
{$P+,S-,W-,R-}
{$WARNINGS OFF}
{$HINTS OFF}
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Menus, ExtCtrls, bsSkinData, StdCtrls, bsSkinMenus, ComCtrls, CommCtrl,
ImgList;
type
TbsControlButton = record
R: TRect;
MouseIn: Boolean;
Down: Boolean;
Visible: Boolean;
end;
TbsSkinControl = class(TCustomControl)
protected
FSD: TbsSkinData;
FSkinDataName: String;
FRgn: HRgn;
FOnMouseEnter, FOnMouseLeave: TNotifyEvent;
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
procedure GetSkinData; virtual;
procedure WMMOVE(var Msg: TWMMOVE); message WM_MOVE;
procedure WMEraseBkgnd(var Msg: TWMEraseBkgnd); message WM_ERASEBKGND;
procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
procedure SetSkinDataName(Value: String); virtual;
procedure SetSkinData(Value: TbsSkinData); virtual;
procedure CreateControlDefaultImage(B: TBitMap); virtual;
procedure CreateControlSkinImage(B: TBitMap); virtual;
public
FIndex: Integer;
procedure Paint; override;
procedure ChangeSkinData; virtual;
procedure BeforeChangeSkinData; virtual;
procedure AfterChangeSkinData; virtual;
destructor Destroy; override;
constructor Create(AOwner: TComponent); override;
published
property Anchors;
property TabOrder;
property Visible;
property SkinData: TbsSkinData read FSD write SetSkinData;
property SkinDataName: String read FSkinDataName write SetSkinDataName;
property OnMouseEnter: TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
property OnMouseLeave: TNotifyEvent read FOnMouseLeave write FOnMouseLeave;
end;
TbsSkinCustomControl = class(TbsSkinControl)
protected
FDefaultWidth: Integer;
FDefaultHeight: Integer;
FDefaultFont: TFont;
FUseSkinFont: Boolean;
LTPt, RTPt, LBPt, RBPt: TPoint;
SkinRect, ClRect: TRect;
NewLTPoint, NewRTPoint, NewLBPoint, NewRBPoint: TPoint;
NewClRect: TRect;
Picture, MaskPicture: TBitMap;
ResizeMode: Integer;
procedure OnDefaultFontChange(Sender: TObject);
procedure SetDefaultWidth(Value: Integer);
procedure SetDefaultHeight(Value: Integer);
procedure SetDefaultFont(Value: TFont);
procedure DefaultFontChange; virtual;
function GetNewRect(R: TRect): TRect;
function GetResizeMode: Integer;
procedure CalcSize(var W, H: Integer); virtual;
procedure CreateSkinControlImage(B, SB: TBitMap; R: TRect);
procedure GetSkinData; override;
procedure CreateControlRegion;
procedure SetControlRegion; virtual;
procedure CreateControlDefaultImage(B: TBitMap); override;
procedure CreateControlSkinImage(B: TBitMap); override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
procedure ChangeSkinData; override;
published
property DefaultFont: TFont read FDefaultFont write SetDefaultFont;
property DefaultWidth: Integer read FDefaultWidth write SetDefaultWidth;
property DefaultHeight: Integer read FDefaultHeight write SetDefaultHeight;
property UseSkinFont: Boolean read FUseSkinFont write FUseSkinFont;
end;
TbsSkinBevel = class(TBevel)
protected
FSD: TbsSkinData;
FSkinDataName: String;
FIndex: Integer;
FDividerMode: Boolean;
procedure SetDividerMode(Value: Boolean);
procedure SetSkinData(Value: TbsSkinData);
public
LightColor, DarkColor: TColor;
constructor Create(AOwner: TComponent); override;
procedure Paint; override;
procedure ChangeSkinData;
published
property SkinData: TbsSkinData read FSD write SetSkinData;
property SkinDataName: String read FSkinDataName write FSkinDataName;
property DividerMode: Boolean read FDividerMode write SetDividerMode;
end;
TbsSkinBorderStyle = (bvFrame, bvRaised, bvLowered, bvNone);
TbsSkinPanelNumGlyphs = 1..2;
TbsSkinPanel = class(TbsSkinCustomControl)
protected
FCheckedMode: Boolean;
FChecked: Boolean;
FOnChecked: TNotifyEvent;
FGlyph: TBitMap;
FNumGlyphs: TbsSkinPanelNumGlyphs;
FSpacing: Integer;
FRealHeight: Integer;
FRollUpState: Boolean;
FRollUpMode: Boolean;
FCaptionMode: Boolean;
FBorderStyle: TbsSkinBorderStyle;
FDefaultCaptionHeight: Integer;
FDefaultAlignment: TAlignment;
VisibleControls: TList;
FAutoEnabledControls: Boolean;
procedure SetCheckedMode(Value: Boolean);
procedure SetChecked(Value: Boolean);
procedure SetGlyph(Value: TBitMap);
procedure SetNumGlyphs(Value: TbsSkinPanelNumGlyphs);
procedure SetSpacing(Value: Integer);
procedure SetRollUpMode(Value: Boolean);
procedure SetDefaultAlignment(Value: TAlignment);
procedure SetDefaultCaptionHeight(Value: Integer); virtual;
procedure SetBorderStyle(Value: TbsSkinBorderStyle);
procedure SetRollUpState(Value: Boolean);
procedure SetCaptionMode(Value: Boolean); virtual;
procedure CreateParams(var Params: TCreateParams); override;
procedure AdjustClientRect(var Rect: TRect); override;
procedure GetSkinData; override;
procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); override;
procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
procedure CreateControlDefaultImage(B: TBitMap); override;
procedure CreateControlSkinImage(B: TBitMap); override;
procedure HideControls;
procedure ShowControls;
procedure SkinDrawCheckImage(X, Y: Integer; Cnvs: TCanvas; IR: TRect; DestCnvs: TCanvas);
public
FontName: String;
FontStyle: TFontStyles;
FontHeight: Integer;
FontColor: TColor;
Alignment: TAlignment;
CaptionRect: TRect;
NewCaptionRect: TRect;
NewRollUpMarkerRect: TRect;
BGPictureIndex: Integer;
CheckImageRect, UnCheckImageRect: TRect;
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure ChangeSkinData; override;
procedure DoRollUp(ARollUp: Boolean);
procedure Paint; override;
procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
published
property RealHeight: Integer read FRealHeight write FRealHeight;
property AutoEnabledControls: Boolean
read FAutoEnabledControls write FAutoEnabledControls;
property CheckedMode: Boolean read FCheckedMode write SetCheckedMode;
property Checked: Boolean read FChecked write SetChecked;
property DefaultAlignment: TAlignment
read FDefaultAlignment write SetDefaultAlignment;
property DefaultCaptionHeight: Integer
read FDefaultCaptionHeight write SetDefaultCaptionHeight;
property BorderStyle: TbsSkinBorderStyle
read FBorderStyle write SetBorderStyle;
property CaptionMode: Boolean read FCaptionMode write SetCaptionMode;
property RollUpMode: Boolean read FRollUpMode write SetRollUpMode;
property RollUpState: Boolean read FRollUpState write SetRollUpState;
property Glyph: TBitMap read FGlyph write SetGlyph;
property NumGlyphs: TbsSkinPanelNumGlyphs read FNumGlyphs write SetNumGlyphs;
property Spacing: Integer read FSpacing write SetSpacing;
property Caption;
property Constraints;
property Align;
property DockSite;
property DragCursor;
property DragKind;
property DragMode;
property Enabled;
property ParentShowHint;
property PopupMenu;
property ShowHint;
property TabOrder;
property TabStop;
property Visible;
property OnChecked: TNotifyEvent read FOnChecked write FOnChecked;
property OnCanResize;
property OnClick;
property OnConstrainedResize;
property OnDockDrop;
property OnDockOver;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnEndDock;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnGetSiteInfo;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnResize;
property OnStartDock;
property OnStartDrag;
property OnUnDock;
end;
TbsSkinStatusBar = class(TbsSkinPanel)
protected
procedure SetSkinData(Value: TbsSkinData); override;
public
constructor Create(AOwner: TComponent); override;
end;
TbsSkinToolBar = class(TbsSkinPanel)
private
// scroll
FCanScroll: Boolean;
FHotScroll: Boolean;
TimerMode: Integer;
SMax, SPosition, SPage, SOldPosition: Integer;
FHSizeOffset: Integer;
FScrollOffset: Integer;
FScrollTimerInterval: Integer;
Buttons: array[0..1] of TbsControlButton;
ButtonData: TbsDataSkinButtonControl;
//
FImages: TCustomImageList;
FDisabledImages: TCustomImageList;
FHotImages: TCustomImageList;
FFlat: Boolean;
FAutoShowHideCaptions: Boolean;
FShowCaptions: Boolean;
FWidthWithCaptions: Integer;
FWidthWithoutCaptions: Integer;
procedure SetFlat(Value: Boolean);
procedure SetDisabledImages(Value: TCustomImageList);
procedure SetHotImages(Value: TCustomImageList);
procedure SetImages(Value: TCustomImageList);
procedure SetShowCaptions(Value: Boolean);
// scroll
procedure SetScrollOffset(Value: Integer);
procedure SetScrollTimerInterval(Value: Integer);
procedure DrawButton(Cnvs: TCanvas; i: Integer);
protected
procedure CreateControlSkinImage(B: TBitMap); override;
procedure GetSkinData; override;
procedure Notification(AComponent: TComponent;
Operation: TOperation); override;
procedure SetSkinData(Value: TbsSkinData); override;
procedure SetSkinDataName(Value: String); override;
// scroll
procedure WMTimer(var Message: TWMTimer); message WM_Timer;
procedure WMNCCALCSIZE(var Message: TWMNCCalcSize); message WM_NCCALCSIZE;
procedure WMNCPAINT(var Message: TMessage); message WM_NCPAINT;
procedure WMSIZE(var Message: TWMSIZE); message WM_SIZE;
procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
procedure WndProc(var Message: TMessage); override;
procedure SetButtonsVisible(AVisible: Boolean);
procedure ButtonClick(I: Integer);
procedure ButtonDown(I: Integer);
procedure ButtonUp(I: Integer);
procedure GetHRange;
procedure GetScrollInfo;
procedure HScrollControls(AOffset: Integer);
procedure AdjustClientRect(var Rect: TRect); override;
procedure StartTimer;
procedure StopTimer;
public
constructor Create(AOwner: TComponent); override;
procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
published
// scroll
property CanScroll: Boolean read FCanScroll write FCanScroll;
property HotScroll: Boolean read FHotScroll write FHotScroll;
property ScrollOffset: Integer read FScrollOffset write SetScrollOffset;
property ScrollTimerInterval: Integer
read FScrollTimerInterval write SetScrollTimerInterval;
//
property WidthWithCaptions: Integer
read FWidthWithCaptions write FWidthWithCaptions;
property WidthWithoutCaptions: Integer
read FWidthWithoutCaptions write FWidthWithoutCaptions;
property AutoShowHideCaptions: Boolean
read FAutoShowHideCaptions write FAutoShowHideCaptions;
property ShowCaptions: Boolean read FShowCaptions write SetShowCaptions;
property Flat: Boolean read FFlat write SetFlat;
property Images: TCustomImageList read FImages write SetImages;
property HotImages: TCustomImageList read FHotImages write SetHotImages;
property DisabledImages: TCustomImageList read FDisabledImages write SetDisabledImages;
end;
TbsSkinGroupBox = class(TbsSkinPanel)
public
constructor Create(AOwner: TComponent); override;
end;
TbsExPanelRollKind = (rkRollHorizontal, rkRollVertical);
TbsSkinExPanel = class(TbsSkinCustomControl)
private
FGlyph: TBitMap;
FNumGlyphs: TbsSkinPanelNumGlyphs;
FSpacing: Integer;
FOnChangeRollState: TNotifyEvent;
FOnClose: TNotifyEvent;
StopCheckSize: Boolean;
FRollState: Boolean;
FRollKind: TbsExPanelRollKind;
FDefaultCaptionHeight: Integer;
VisibleControls: TList;
FRealWidth, FRealHEight: Integer;
FShowRollButton: Boolean;
FShowCloseButton: Boolean;
function GetRollWidth: Integer;
function GetRollHeight: Integer;
procedure SetShowRollButton(Value: Boolean);
procedure SetShowCloseButton(Value: Boolean);
procedure SetGlyph(Value: TBitMap);
procedure SetNumGlyphs(Value: TbsSkinPanelNumGlyphs);
procedure SetSpacing(Value: Integer);
protected
Buttons: array[0..1] of TbsControlButton;
OldActiveButton, ActiveButton, CaptureButton: Integer;
procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); override;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); override;
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
procedure CreateControlDefaultImage(B: TBitMap); override;
procedure CreateControlSkinImage(B: TBitMap); override;
procedure SetDefaultCaptionHeight(Value: Integer);
procedure AdjustClientRect(var Rect: TRect); override;
procedure HideControls;
procedure ShowControls;
procedure SetRollState(Value: Boolean);
procedure SetRollKind(Value: TbsExPanelRollKind);
//
procedure ButtonDown(I: Integer; X, Y: Integer);
procedure ButtonUp(I: Integer; X, Y: Integer);
procedure ButtonEnter(I: Integer);
procedure ButtonLeave(I: Integer);
procedure DrawButton(Cnvs: TCanvas; i: Integer);
procedure TestActive(X, Y: Integer);
procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
procedure GetSkinData; override;
{ property RealWidth: Integer read FRealWidth write FRealWidth;
property RealHeight:Integer read FRealHeight write FRealHeight;}
public
//
RollHSkinRect, RollVSkinRect: TRect;
RollLeftOffset, RollRightOffset,
RollTopOffset, RollBottomOffset: Integer;
RollVCaptionRect, RollHCaptionRect: TRect;
CloseButtonRect, CloseButtonActiveRect, CloseButtonDownRect: TRect;
HRollButtonRect, HRollButtonActiveRect, HRollButtonDownRect: TRect;
HRestoreButtonRect, HRestoreButtonActiveRect, HRestoreButtonDownRect: TRect;
VRollButtonRect, VRollButtonActiveRect, VRollButtonDownRect: TRect;
VRestoreButtonRect, VRestoreButtonActiveRect, VRestoreButtonDownRect: TRect;
CaptionRect: TRect;
FontName: String;
FontStyle: TFontStyles;
FontHeight: Integer;
FontColor: TColor;
//
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
procedure ChangeSkinData; override;
procedure Close;
published
property Glyph: TBitMap read FGlyph write SetGlyph;
property NumGlyphs: TbsSkinPanelNumGlyphs read FNumGlyphs write SetNumGlyphs;
property Spacing: Integer read FSpacing write SetSpacing;
property RealWidth: Integer read FRealWidth write FRealWidth;
property RealHeight: Integer read FRealHeight write FRealHeight;
property ShowRollButton: Boolean
read FShowRollButton write SetShowRollButton;
property ShowCloseButton: Boolean
read FShowCloseButton write SetShowCloseButton;
property DefaultCaptionHeight: Integer
read FDefaultCaptionHeight write SetDefaultCaptionHeight;
property RollState: Boolean read FRollState write SetRollState;
property RollKind: TbsExPanelRollKind read FRollKind write SetRollKind;
property Align;
property Caption;
property DockSite;
property Constraints;
property DragCursor;
property DragKind;
property DragMode;
property Enabled;
property ParentShowHint;
property PopupMenu;
property ShowHint;
property TabOrder;
property TabStop;
property Visible;
property OnCanResize;
property OnClick;
property OnConstrainedResize;
property OnDockDrop;
property OnDockOver;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnEndDock;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnGetSiteInfo;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnResize;
property OnStartDock;
property OnStartDrag;
property OnUnDock;
property OnChangeRollState: TNotifyEvent
read FOnChangeRollState write FOnChangeRollState;
property OnClose: TNotifyEvent read FOnClose write FOnClose;
end;
TbsNumGlyphs = 1..4;
TbsButtonLayout = (blGlyphLeft, blGlyphRight, blGlyphTop, blGlyphBottom);
TbsSkinButton = class(TbsSkinCustomControl)
protected
RepeatTimer: TTimer;
FRepeatMode: Boolean;
FRepeatInterval: Integer;
FActive: Boolean;
FAllowAllUp: Boolean;
FAllowAllUpCheck: Boolean;
FDefault: Boolean;
FCancel: Boolean;
FModalResult: TModalResult;
FClicksDisabled: Boolean;
FCanFocused: Boolean;
FDown: Boolean;
FMouseIn, FMouseDown: Boolean;
FGroupIndex: Integer;
FGlyph: TBitMap;
FNumGlyphs: TbsNumGlyphs;
FMargin: Integer;
FSpacing: Integer;
FLayout: TbsButtonLayout;
FOnClick: TNotifyEvent;
//
MorphTimer: TTimer;
FMorphKf: Double;
procedure RepeatTimerProc(Sender: TObject);
procedure StartRepeat;
procedure StopRepeat;
procedure StartMorph;
procedure StopMorph;
procedure DoMorph(Sender: TObject);
//
procedure SetDefault(Value: Boolean);
function GetGlyphNum(AIsDown, AIsMouseIn: Boolean): Integer;
function IsFocused: Boolean;
procedure SetCanFocused(Value: Boolean);
procedure CreateButtonImage(B: TBitMap; R: TRect;
ADown, AMouseIn: Boolean); virtual;
procedure SetLayout(Value : TbsButtonLayout);
procedure SetMargin(Value: Integer);
procedure SetSpacing(Value: Integer);
procedure SetGroupIndex(Value: Integer);
procedure SetDown(Value: Boolean);
procedure DoAllUp;
procedure SetNumGlyphs(Value: TbsNumGlyphs);
procedure SetGlyph(Value: TBitMap);
procedure GetSkinData; override;
procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
procedure CMDialogKey(var Message: TCMDialogKey); message CM_DIALOGKEY;
procedure CMFocusChanged(var Message: TCMFocusChanged); message CM_FOCUSCHANGED;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); override;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); override;
procedure CreateControlDefaultImage(B: TBitMap); override;
procedure CreateControlSkinImage(B: TBitMap); override;
procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
procedure WMSETFOCUS(var Message: TWMSETFOCUS); message WM_SETFOCUS;
procedure WMKILLFOCUS(var Message: TWMKILLFOCUS); message WM_KILLFOCUS;
procedure WndProc(var Message: TMessage); override;
procedure CMDialogChar(var Message: TCMDialogChar); message CM_DIALOGCHAR;
procedure ReDrawControl;
procedure CreateWnd; override;
public
FontName: String;
FontStyle: TFontStyles;
FontHeight: Integer;
FontColor, ActiveFontColor, DownFontColor, DisabledFontColor: TColor;
ActiveSkinRect, DownSkinRect, DisabledSkinRect: TRect;
Morphing: Boolean;
MorphKind: TbsMorphKind;
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure ChangeSkinData; override;
procedure Click; override;
procedure Paint; override;
procedure ButtonClick; virtual;
published
property RepeatMode: Boolean read FRepeatMode write FRepeatMode;
property RepeatInterval: Integer
read FRepeatInterval write FRepeatInterval;
property AllowAllUp: Boolean read FAllowAllUp write FAllowAllUp;
property PopupMenu;
property ShowHint;
property TabStop;
property TabOrder;
property CanFocused: Boolean read FCanFocused write SetCanFocused;
property Action;
property ParentShowHint;
property Down: Boolean read FDown write SetDown;
property GroupIndex: Integer read FGroupIndex write SetGroupIndex;
property Caption;
property Glyph: TBitMap read FGlyph write SetGlyph;
property NumGlyphs: TbsNumGlyphs read FNumGlyphs write SetNumGlyphs;
property Margin: Integer read FMargin write SetMargin default -1;
property Spacing: Integer read FSpacing write SetSpacing default 4;
property Layout: TbsButtonLayout read FLayout write SetLayout default blGlyphLeft;
property Align;
property Enabled;
property Cancel: Boolean read FCancel write FCancel default False;
property Default: Boolean read FDefault write SetDefault default False;
property ModalResult: TModalResult read FModalResult write FModalResult default 0;
property OnClick: TNotifyEvent read FOnClick write FOnClick;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnResize;
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
end;
TbsSkinMenuButton = class(TbsSkinButton)
protected
FOnShowTrackMenu: TNotifyEvent;
FOnHideTrackMenu: TNotifyEvent;
FTrackButtonMode: Boolean;
FMenuTracked: Boolean;
FSkinPopupMenu: TbsSkinPopupMenu;
procedure CreateButtonImage(B: TBitMap; R: TRect;
ADown, AMouseIn: Boolean); override;
function CanMenuTrack(X, Y: Integer): Boolean;
procedure TrackMenu;
procedure SetTrackButtonMode(Value: Boolean);
procedure GetSkinData; override;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); override;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); override;
procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
procedure Notification(AComponent: TComponent;
Operation: TOperation); override;
procedure WMCLOSESKINMENU(var Message: TMessage); message WM_CLOSESKINMENU;
function GetNewTrackButtonRect: TRect;
procedure WndProc(var Message: TMessage); override;
procedure CMDialogChar(var Message: TCMDialogChar); message CM_DIALOGCHAR;
procedure CreateControlDefaultImage(B: TBitMap); override;
public
TrackButtonRect: TRect;
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property SkinPopupMenu: TbsSkinPopupMenu read FSkinPopupMenu
write FSkinPopupMenu;
property TrackButtonMode: Boolean read FTrackButtonMode
write SetTrackButtonMode;
property OnShowTrackMenu: TNotifyEvent read FOnShowTrackMenu
write FOnShowTrackMenu;
property OnHideTrackMenu: TNotifyEvent read FOnHideTrackMenu
write FOnHideTrackMenu;
end;
TbsSkinCheckRadioBox = class(TbsSkinCustomControl)
protected
FImages: TCustomImageList;
FImageIndex: Integer;
FFLat: Boolean;
FClicksDisabled: Boolean;
FCanFocused: Boolean;
FMouseIn: Boolean;
FGroupIndex: Integer;
FOnClick: TNotifyEvent;
FChecked: Boolean;
CIRect, NewTextArea: TRect;
FRadio: Boolean;
MorphTimer: TTimer;
FMorphKf: Double;
procedure SetImageIndex(Value: Integer);
procedure SetImages(Value: TCustomImageList);
procedure SetFlat(Value: Boolean);
procedure DoMorph(Sender: TObject);
procedure StartMorph;
procedure StopMorph;
function IsFocused: Boolean;
procedure SkinDrawCheckImage(X, Y: Integer; Cnvs: TCanvas; IR: TRect; DestCnvs: TCanvas);
procedure SetCheckState; virtual;
procedure SetCanFocused(Value: Boolean);
procedure SetRadio(Value: Boolean);
procedure SetChecked(Value: Boolean);
procedure CreateImage(B: TBitMap; R: TRect; AMouseIn: Boolean);
procedure UnCheckAll;
procedure GetSkinData; override;
procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); override;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); override;
procedure ReDrawControl;
procedure CalcSize(var W, H: Integer); override;
procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
procedure WMSETFOCUS(var Message: TWMSETFOCUS); message WM_SETFOCUS;
procedure WMKILLFOCUS(var Message: TWMKILLFOCUS); message WM_KILLFOCUS;
procedure WMMOVE(var Msg: TWMMOVE); message WM_MOVE;
procedure WndProc(var Message: TMessage); override;
procedure CMDialogChar(var Message: TCMDialogChar); message CM_DIALOGCHAR;
procedure CreateControlDefaultImage(B: TBitMap); override;
procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
procedure Notification(AComponent: TComponent;
Operation: TOperation); override;
public
FontName: String;
FontStyle: TFontStyles;
FontHeight: Integer;
FontColor, ActiveFontColor, FrameFontColor, UnEnabledFontColor: TColor;
ActiveSkinRect, CheckImageArea, TextArea,
CheckImageRect, UnCheckImageRect: TRect;
ActiveCheckImageRect, ActiveUnCheckImageRect: TRect;
UnEnabledCheckImageRect, UnEnabledUnCheckImageRect: TRect;
Morphing: Boolean;
MorphKind: TbsMorphKind;
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure ChangeSkinData; override;
procedure Paint; override;
published
property Images: TCustomImageList read FImages write SetImages;
property ImageIndex: Integer read FImageIndex write SetImageIndex;
property Flat: Boolean read FFlat write SetFlat;
property PopupMenu;
property ShowHint;
property TabStop;
property TabOrder;
property CanFocused: Boolean read FCanFocused write SetCanFocused;
property Action;
property Radio: Boolean read FRadio write SetRadio;
property Checked: Boolean read FChecked write SetChecked;
property GroupIndex: Integer read FGroupIndex write FGroupIndex;
property Caption;
property OnClick: TNotifyEvent read FOnClick write FOnClick;
property Align;
property Enabled;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnResize;
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
end;
TbsSkinGauge = class(TbsSkinCustomControl)
protected
FUseSkinSize: Boolean;
FMinValue, FMaxValue, FValue: Integer;
FVertical: Boolean;
FProgressText: String;
FShowPercent: Boolean;
FShowProgressText: Boolean;
procedure SetShowProgressText(Value: Boolean);
procedure SetShowPercent(Value: Boolean);
procedure SetProgressText(Value: String);
procedure SetVertical(AValue: Boolean);
procedure SetMinValue(AValue: Integer);
procedure SetMaxValue(AValue: Integer);
procedure SetValue(AValue: Integer);
procedure GetSkinData; override;
procedure CreateImage(B: TBitMap);
procedure CalcSize(var W, H: Integer); override;
procedure DrawProgressText(C: TCanvas);
procedure CreateControlDefaultImage(B: TBitMap); override;
procedure CreateControlSkinImage(B: TBitMap); override;
public
ProgressRect, ProgressArea: TRect;
NewProgressArea: TRect;
BeginOffset, EndOffset: Integer;
FontName: String;
FontStyle: TFontStyles;
FontHeight: Integer;
FontColor: TColor;
constructor Create(AOwner: TComponent); override;
function CalcProgressRect(R: TRect; AV: Boolean): TRect;
procedure Paint; override;
published
property UseSkinSize: Boolean read FUseSkinSize write FUseSkinSize;
property ProgressText: String read FProgressText write SetProgressText;
property ShowProgressText: Boolean read FShowProgressText write SetShowProgressText;
property ShowPercent: Boolean read FShowPercent write SetShowPercent;
property MinValue: Integer read FMinValue write SetMinValue;
property MaxValue: Integer read FMaxValue write SetMaxValue;
property Value: Integer read FValue write SetValue;
property Vertical: Boolean read FVertical write SetVertical;
property Align;
property Enabled;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnResize;
property PopupMenu;
property ShowHint;
end;
TbsSkinTextLabel = class(TGraphicControl)
private
FIndex: Integer;
FSD: TbsSkinData;
FSkinDataName: String;
FDefaultFont: TFont;
FUseSkinFont: Boolean;
//
FLines: TStrings;
FAlignment: TAlignment;
FAutoSize: Boolean;
FLayout: TTextLayout;
FWordWrap: Boolean;
procedure SetSkinData(Value: TbsSkinData);
procedure SetDefaultFont(Value: TFont);
procedure SetLines(Value: TStrings);
procedure SetAlignment(Value: TAlignment);
procedure SetLayout(Value: TTextLayout);
procedure SetWordWrap(Value: Boolean);
procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
protected
function GetLabelText: string; virtual;
procedure Loaded; override;
procedure Notification(AComponent: TComponent;
Operation: TOperation); override;
procedure SetAutoSize(Value: Boolean); virtual;
procedure DoDrawText(var Rect: TRect; Flags: Longint);
public
FontName: String;
FontStyle: TFontStyles;
FontHeight: Integer;
FontColor: TColor;
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
property Canvas;
procedure AdjustBounds; dynamic;
procedure ChangeSkinData;
procedure GetSkinData;
procedure Paint; override;
published
property UseSkinFont: Boolean read FUseSkinFont write FUseSkinFont;
property Lines: TStrings read FLines write SetLines;
property DefaultFont: TFont read FDefaultFont write SetDefaultFont;
property SkinData: TbsSkinData read FSD write SetSkinData;
property SkinDataName: String read FSkinDataName write FSkinDataName;
property Font;
property Align;
property Alignment: TAlignment read FAlignment write SetAlignment
default taLeftJustify;
property AutoSize: Boolean read FAutoSize write SetAutoSize default True;
property Layout: TTextLayout read FLayout write SetLayout default tlTop;
property WordWrap: Boolean read FWordWrap write SetWordWrap default False;
property Anchors;
property BiDiMode;
property Constraints;
property DragCursor;
property DragKind;
property DragMode;
property Enabled;
property ParentBiDiMode;
property ParentColor;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ShowHint;
property Visible;
property OnClick;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnEndDock;
property OnEndDrag;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnStartDock;
property OnStartDrag;
end;
TbsSkinLinkImage = class(TImage)
private
FURL: String;
protected
procedure Click; override;
public
constructor Create(AOwner : TComponent); override;
published
property URL: string read FURL write FURL;
end;
TbsSkinLinkLabel = class(TCustomLabel)
protected
FMouseIn: Boolean;
FIndex: Integer;
FSD: TbsSkinData;
FSkinDataName: String;
FDefaultFont: TFont;
FUseSkinFont: Boolean;
FDefaultActiveFontColor: TColor;
FURL: String;
procedure Notification(AComponent: TComponent;
Operation: TOperation); override;
procedure SetSkinData(Value: TbsSkinData);
procedure SetDefaultFont(Value: TFont);
property Transparent;
procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
procedure GetSkinData;
procedure DoDrawText(var Rect: TRect; Flags: Longint); override;
public
FontName: String;
FontStyle: TFontStyles;
FontHeight: Integer;
FontColor, ActiveFontColor: TColor;
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure ChangeSkinData;
procedure Click; override;
published
property UseSkinFont: Boolean read FUseSkinFont write FUseSkinFont;
property DefaultActiveFontColor: TColor
read FDefaultActiveFontColor write FDefaultActiveFontColor;
property URL: String read FURL write FURL;
property DefaultFont: TFont read FDefaultFont write SetDefaultFont;
property SkinData: TbsSkinData read FSD write SetSkinData;
property SkinDataName: String read FSkinDataName write FSkinDataName;
property Font;
property Align;
property Alignment;
property Anchors;
property AutoSize;
property BiDiMode;
property Caption;
property Color;
property Constraints;
property DragCursor;
property DragKind;
property DragMode;
property Enabled;
property FocusControl;
property ParentBiDiMode;
property ParentColor;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ShowAccelChar;
property ShowHint;
property Layout;
property Visible;
property WordWrap;
property OnClick;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnEndDock;
property OnEndDrag;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnStartDock;
property OnStartDrag;
end;
TbsSkinButtonLabel = class(TGraphicControl)
protected
FMouseIn, FDown: Boolean;
FIndex: Integer;
FSD: TbsSkinData;
FSkinDataName: String;
FDefaultFont: TFont;
FUseSkinFont: Boolean;
FDefaultActiveFontColor: TColor;
FGlyph: TBitMap;
FNumGlyphs: TbsNumGlyphs;
FMargin: Integer;
FSpacing: Integer;
FLayout: TbsButtonLayout;
procedure Notification(AComponent: TComponent;
Operation: TOperation); override;
procedure SetSkinData(Value: TbsSkinData);
procedure SetDefaultFont(Value: TFont);
procedure SetLayout(Value : TbsButtonLayout);
procedure SetMargin(Value: Integer);
procedure SetSpacing(Value: Integer);
procedure SetNumGlyphs(Value: TbsNumGlyphs);
procedure SetGlyph(Value: TBitMap);
procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); override;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); override;
public
FontColor: TColor;
ActiveFontColor: TColor;
FontName: String;
FontHeight: Integer;
FontStyle: TFontStyles;
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure ChangeSkinData;
procedure Paint; override;
published
property Glyph: TBitMap read FGlyph write SetGlyph;
property NumGlyphs: TbsNumGlyphs read FNumGlyphs write SetNumGlyphs;
property Margin: Integer read FMargin write SetMargin default -1;
property Spacing: Integer read FSpacing write SetSpacing default 4;
property Layout: TbsButtonLayout read FLayout write SetLayout default blGlyphLeft;
property UseSkinFont: Boolean read FUseSkinFont write FUseSkinFont;
property DefaultActiveFontColor: TColor
read FDefaultActiveFontColor write FDefaultActiveFontColor;
property DefaultFont: TFont read FDefaultFont write SetDefaultFont;
property SkinData: TbsSkinData read FSD write SetSkinData;
property SkinDataName: String read FSkinDataName write FSkinDataName;
property Align;
property Anchors;
property AutoSize;
property BiDiMode;
property Caption;
property Constraints;
property DragCursor;
property DragKind;
property DragMode;
property Enabled;
property ParentBiDiMode;
property ParentColor;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ShowHint;
property Visible;
property OnClick;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnEndDock;
property OnEndDrag;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnStartDock;
property OnStartDrag;
end;
TbsSkinStdLabel = class(TCustomLabel)
protected
FIndex: Integer;
FSD: TbsSkinData;
FSkinDataName: String;
FDefaultFont: TFont;
FUseSkinFont: Boolean;
procedure Notification(AComponent: TComponent;
Operation: TOperation); override;
procedure SetSkinData(Value: TbsSkinData);
procedure SetDefaultFont(Value: TFont);
property Transparent;
procedure DoDrawText(var Rect: TRect; Flags: Longint); override;
public
FontName: String;
FontStyle: TFontStyles;
FontHeight: Integer;
FontColor: TColor;
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure GetSkinData;
procedure ChangeSkinData;
published
property UseSkinFont: Boolean read FUseSkinFont write FUseSkinFont;
property DefaultFont: TFont read FDefaultFont write SetDefaultFont;
property SkinData: TbsSkinData read FSD write SetSkinData;
property SkinDataName: String read FSkinDataName write FSkinDataName;
property Font;
property Align;
property Alignment;
property Anchors;
property AutoSize;
property BiDiMode;
property Caption;
property Color;
property Constraints;
property DragCursor;
property DragKind;
property DragMode;
property Enabled;
property FocusControl;
property ParentBiDiMode;
property ParentColor;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ShowAccelChar;
property ShowHint;
property Layout;
property Visible;
property WordWrap;
property OnClick;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnEndDock;
property OnEndDrag;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnStartDock;
property OnStartDrag;
end;
TbsSkinLabel = class(TbsSkinCustomControl)
protected
FAlignment: TAlignment;
FAutoSize: Boolean;
FBorderStyle: TbsSkinBorderStyle;
procedure SetBorderStyle(Value: TbsSkinBorderStyle);
procedure DrawLabelText(Cnvs: TCanvas; R: TRect);
function CalcWidthOffset: Integer; virtual;
procedure AdjustBounds;
procedure PaintLabel(B: TBitMap);
procedure SetAutoSizeX(Value: Boolean);
procedure SetAlignment(Value: TAlignment);
procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
procedure CalcSize(var W, H: Integer); override;
procedure GetSkinData; override;
procedure CreateControlDefaultImage(B: TBitMap); override;
procedure CreateControlSkinImage(B: TBitMap); override;
public
FontName: String;
FontStyle: TFontStyles;
FontHeight: Integer;
FontColor: TColor;
constructor Create(AOwner: TComponent); override;
published
property BorderStyle: TbsSkinBorderStyle
read FBorderStyle write SetBorderStyle;
property Alignment: TAlignment read FAlignment write SetAlignment
default taLeftJustify;
property Align;
property Caption;
property DragCursor;
property BiDiMode;
property DragKind;
property DragMode;
property Enabled;
property PopupMenu;
property ShowHint;
property Visible;
property AutoSize: Boolean read FAutoSize write SetAutoSizeX;
property OnClick;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnEndDock;
property OnEndDrag;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnStartDock;
property OnStartDrag;
end;
TbsSkinTrackBar = class(TbsSkinCustomControl)
protected
FClicksDisabled: Boolean;
FCanFocused: Boolean;
Offset1, Offset2, BOffset: Integer;
BR: TRect;
FMinValue, FMaxValue, FValue: Integer;
FVertical: Boolean;
FMouseSupport, FDown: Boolean;
OMPos: Integer;
OldBOffset: Integer;
FOnChange: TNotifyEvent;
FJumpWhenClick: Boolean;
function IsFocused: Boolean;
procedure SetCanFocused(Value: Boolean);
procedure SetVertical(AValue: Boolean);
procedure SetMinValue(AValue: Integer);
procedure SetMaxValue(AValue: Integer);
procedure SetValue(AValue: Integer);
procedure GetSkinData; override;
procedure CreateImage(B: TBitMap);
procedure CalcSize(var W, H: Integer); override;
function CalcButtonRect(R: TRect): TRect;
function CalcValue(AOffset: Integer): Integer;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); override;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); override;
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
procedure WMMOUSEWHEEL(var Message: TMessage); message WM_MOUSEWHEEL;
procedure WMSETFOCUS(var Message: TWMSETFOCUS); message WM_SETFOCUS;
procedure WMKILLFOCUS(var Message: TWMKILLFOCUS); message WM_KILLFOCUS;
procedure WndProc(var Message: TMessage); override;
procedure CMWantSpecialKey(var Msg: TCMWantSpecialKey); message CM_WANTSPECIALKEY;
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
procedure CreateControlDefaultImage(B: TBitMap); override;
procedure CreateControlSkinImage(B: TBitMap); override;
public
TrackArea, NewTrackArea, ButtonRect, ActiveButtonRect: TRect;
constructor Create(AOwner: TComponent); override;
published
property JumpWhenClick: Boolean read FJumpWhenClick write FJumpWhenClick;
property PopupMenu;
property ShowHint;
property TabStop;
property TabOrder;
property CanFocused: Boolean read FCanFocused write SetCanFocused;
property MouseSupport: Boolean read FMouseSupport write FMouseSupport;
property MinValue: Integer read FMinValue write SetMinValue;
property MaxValue: Integer read FMaxValue write SetMaxValue;
property Value: Integer read FValue write SetValue;
property Vertical: Boolean read FVertical write SetVertical;
property Align;
property Enabled;
property OnChange: TNotifyEvent read FOnChange write FOnChange;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnResize;
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
end;
TbsSkinScrollBar = class(TbsSkinCustomControl)
private
FNormalSkinDataName: String;
FBothSkinDataName: String;
Offset1, Offset2, BOffset: Integer;
NewTrackArea: TRect;
FDown: Boolean;
OMPos, OldPosition, FScrollWidth: Integer;
OldBOffset: Integer;
MX, MY: Integer;
MouseD: Boolean;
protected
WaitMode: Boolean;
FBothMarkerWidth: Integer;
FClicksDisabled: Boolean;
FCanFocused: Boolean;
//
FOnChange: TNotifyEvent;
FOnUpButtonClick: TNotifyEvent;
FOnDownButtonClick: TNotifyEvent;
FOnLastChange: TNotifyEvent;
FOnPageUp: TNotifyEvent;
FOnPageDown: TNotifyEvent;
//
TimerMode: Integer;
ActiveButton, OldActiveButton, CaptureButton: Integer;
Buttons: array[0..2] of TbsControlButton;
FMin, FMax, FSmallChange,
FLargeChange, FPosition: Integer;
FKind: TScrollBarKind;
FPageSize: Integer;
procedure SetBoth(Value: Boolean);
procedure SetBothMarkerWidth(Value: Integer);
function IsFocused: Boolean;
procedure SetCanFocused(Value: Boolean);
procedure TestActive(X, Y: Integer);
procedure SetPageSize(AValue: Integer);
procedure ButtonDown(I: Integer; X, Y: Integer);
procedure ButtonUp(I: Integer; X, Y: Integer);
procedure ButtonEnter(I: Integer);
procedure ButtonLeave(I: Integer);
procedure CalcRects;
function CalcValue(AOffset: Integer): Integer;
procedure SetKind(AValue: TScrollBarKind);
procedure SetPosition(AValue: Integer);
procedure SetMin(AValue: Integer);
procedure SetMax(AValue: Integer);
procedure SetSmallChange(AValue: Integer);
procedure SetLargeChange(AValue: Integer);
procedure CalcSize(var W, H: Integer); override;
procedure GetSkinData; override;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); override;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); override;
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
procedure WMTimer(var Message: TWMTimer); message WM_Timer;
procedure StartScroll;
procedure StopTimer;
procedure DrawButton(Cnvs: TCanvas; i: Integer);
procedure WMMOUSEWHEEL(var Message: TMessage); message WM_MOUSEWHEEL;
procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
procedure WMSETFOCUS(var Message: TWMSETFOCUS); message WM_SETFOCUS;
procedure WMKILLFOCUS(var Message: TWMKILLFOCUS); message WM_KILLFOCUS;
procedure WndProc(var Message: TMessage); override;
procedure CMWantSpecialKey(var Msg: TCMWantSpecialKey); message CM_WANTSPECIALKEY;
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
procedure CreateControlDefaultImage(B: TBitMap); override;
procedure CreateControlSkinImage(B: TBitMap); override;
public
FBoth: Boolean;
TrackArea: TRect;
UpButtonRect, ActiveUpButtonRect, DownUpButtonRect: TRect;
DownButtonRect, ActiveDownButtonRect, DownDownButtonRect: TRect;
ThumbRect, ActiveThumbRect, DownThumbRect: TRect;
ThumbOffset1, ThumbOffset2: Integer;
GlyphRect, ActiveGlyphRect, DownGlyphRect: TRect;
procedure SimplySetPosition(AValue: Integer);
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure SetRange(AMin, AMax, APosition, APageSize: Integer);
published
property Enabled;
property Both: Boolean read FBoth write SetBoth;
property BothMarkerWidth: Integer
read FBothMarkerWidth write SetBothMarkerWidth;
property BothSkinDataName: String
read FBothSkinDataName write FBothSkinDataName;
property TabStop;
property TabOrder;
property CanFocused: Boolean read FCanFocused write SetCanFocused;
property Align;
property Kind: TScrollBarKind read FKind write SetKind;
property PageSize: Integer read FPageSize write SetPageSize;
property Min: Integer read FMin write SetMin;
property Max: Integer read FMax write SetMax;
property Position: Integer read FPosition write SetPosition;
property SmallChange: Integer read FSmallChange write SetSmallChange;
property LargeChange: Integer read FLargeChange write SetLargeChange;
property OnChange: TNotifyEvent read FOnChange write FOnChange;
property OnLastChange: TNotifyEvent read FOnLastChange write FOnLastChange;
property OnUpButtonClick: TNotifyEvent read FOnUpButtonClick write FOnUpButtonClick;
property OnDownButtonClick: TNotifyEvent read FOnDownButtonClick write FOnDownButtonClick;
property OnPageUp: TNotifyEvent read FOnPageUp write FOnPageUp;
property OnPageDown: TNotifyEvent read FOnPageDown write FOnPageDown;
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnResize;
end;
TbsSkinControlBar = class(TCustomControlBar)
protected
FSkinBevel: Boolean;
FIndex: Integer;
FSD: TbsSkinData;
FSkinDataName: String;
procedure PaintNCSkin;
procedure SetSkinBevel(Value: Boolean);
procedure SetSkinData(Value: TbsSkinData);
procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
procedure CreateParams(var Params: TCreateParams); override;
procedure WMNCCALCSIZE(var Message: TWMNCCalcSize); message WM_NCCALCSIZE;
procedure WMSIZE(var Message: TWMSIZE); message WM_SIZE;
procedure WMNCPAINT(var Message: TMessage); message WM_NCPAINT;
procedure Notification(AComponent: TComponent;
Operation: TOperation); override;
procedure PaintControlFrame(Canvas: TCanvas; AControl: TControl;
var ARect: TRect); override;
public
LTPt, RTPt, LBPt, RBPt: TPoint;
SkinRect, ClRect, NewClRect, ItemRect: TRect;
NewLTPoint, NewRTPoint, NewLBPoint, NewRBPoint: TPoint;
FSkinPicture: TBitMap;
BGPictureIndex: Integer;
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Paint; override;
property Canvas;
procedure GetSkinData;
procedure ChangeSkinData;
published
property SkinDataName: String read FSkinDataName write FSkinDataName;
property SkinData: TbsSkinData read FSD write SetSkinData;
property SkinBevel: Boolean read FSkinBevel write SetSkinBevel;
property Align;
property Anchors;
property AutoDrag;
property AutoSize;
property BevelEdges;
property BevelInner;
property BevelOuter;
property BevelKind;
property BevelWidth;
property BorderWidth;
property Color;
property Constraints;
property DockSite;
property DragCursor;
property DragKind;
property DragMode;
property Enabled;
property ParentColor;
property ParentCtl3D;
property ParentFont;
property ParentShowHint;
property Picture;
property PopupMenu;
property RowSize;
property RowSnap;
property ShowHint;
property TabOrder;
property TabStop;
property Visible;
property OnBandDrag;
property OnBandInfo;
property OnBandMove;
property OnBandPaint;
property OnCanResize;
property OnClick;
property OnConstrainedResize;
property OnDockDrop;
property OnDockOver;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnEndDock;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnGetSiteInfo;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnPaint;
property OnResize;
property OnStartDock;
property OnStartDrag;
property OnUnDock;
end;
TbsSkinSplitter = class(TSPlitter)
protected
FDefaultSize: Integer;
FIndex: Integer;
FSD: TbsSkinData;
FSkinDataName: String;
procedure SetSkinData(Value: TbsSkinData);
procedure Notification(AComponent: TComponent;
Operation: TOperation); override;
public
LTPt, RTPt, LBPt: TPoint;
SkinRect: TRect;
FSkinPicture: TBitMap;
procedure GetSkinData;
procedure ChangeSkinData;
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Paint; override;
published
property DefaultSize: Integer read FDefaultSize write FDefaultSize;
property SkinDataName: String read FSkinDataName write FSkinDataName;
property SkinData: TbsSkinData read FSD write SetSkinData;
property OnClick;
property OnDblClick;
end;
TbsSkinCustomRadioGroup = class(TbsSkinGroupBox)
private
FImages: TCustomImageList;
FButtonSkinDataName: String;
FButtons: TList;
FItems: TStrings;
FItemIndex: Integer;
FColumns: Integer;
FReading: Boolean;
FUpdating: Boolean;
FButtonDefaultFont: TFont;
procedure SetImages(Value: TCustomImageList);
procedure SetButtonDefaultFont(Value: TFont);
procedure SetButtonSkinDataName(Value: String);
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: TStrings);
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 SetSkinData(Value: TbsSkinData); override;
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: TStrings read FItems write SetItems;
procedure Notification(AComponent: TComponent;
Operation: TOperation); override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure ChangeSkinData; override;
procedure FlipChildren(AllLevels: Boolean); override;
property ButtonDefaultFont: TFont
read FButtonDefaultFont write SetButtonDefaultFont;
property ButtonSkinDataName: String
read FButtonSkinDataName write SetButtonSkinDataName;
property Images: TCustomImageList read FImages write SetImages;
end;
TbsSkinCustomCheckGroup = class(TbsSkinGroupBox)
private
FImages: TCustomImageList;
FItemIndex: Integer;
FButtonSkinDataName: String;
FButtons: TList;
FItems: TStrings;
FColumns: Integer;
FReading: Boolean;
FUpdating: Boolean;
FButtonDefaultFont: TFont;
procedure SetButtonDefaultFont(Value: TFont);
procedure SetButtonSkinDataName(Value: String);
procedure ArrangeButtons;
procedure ButtonClick(Sender: TObject);
procedure ItemsChange(Sender: TObject);
procedure SetButtonCount(Value: Integer);
procedure SetColumns(Value: Integer);
procedure SetItems(Value: TStrings);
procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
procedure WMSize(var Message: TWMSize); message WM_SIZE;
procedure SetImages(Value: TCustomImageList);
protected
procedure UpdateButtons;
procedure SetSkinData(Value: TbsSkinData); override;
procedure Loaded; override;
procedure ReadState(Reader: TReader); override;
function CanModify: Boolean; virtual;
procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
function GetCheckedStatus(Index: Integer): Boolean;
procedure SetCheckedStatus(Index: Integer; Value: Boolean);
property Columns: Integer read FColumns write SetColumns default 1;
property Items: TStrings read FItems write SetItems;
procedure Notification(AComponent: TComponent;
Operation: TOperation); override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure ChangeSkinData; override;
procedure FlipChildren(AllLevels: Boolean); override;
property ButtonDefaultFont: TFont
read FButtonDefaultFont write SetButtonDefaultFont;
property ButtonSkinDataName: String
read FButtonSkinDataName write SetButtonSkinDataName;
property Checked[Index: Integer]: Boolean read GetCheckedStatus write SetCheckedStatus;
property ItemIndex: Integer read FItemIndex;
property Images: TCustomImageList read FImages write SetImages;
end;
TbsSkinCheckGroup = class(TbsSkinCustomCheckGroup)
published
property Images;
property ButtonSkinDataName;
property ButtonDefaultFont;
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 Items;
property ItemIndex;
property Constraints;
property ParentBiDiMode;
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;
TbsSkinRadioGroup = class(TbsSkinCustomRadioGroup)
published
property Images;
property ButtonSkinDataName;
property ButtonDefaultFont;
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;
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;
TbsSkinCustomTreeView = class(TCustomTreeView)
protected
FInCheckScrollBars: Boolean;
FSD: TbsSkinData;
FSkinDataName: String;
FIndex: Integer;
FDefaultFont: TFont;
FUseSkinFont: Boolean;
FDefaultColor: TColor;
FVScrollBar: TbsSkinScrollBar;
FHScrollBar: TbsSkinScrollBar;
procedure Notification(AComponent: TComponent;
Operation: TOperation); override;
procedure SetDefaultColor(Value: TColor);
procedure SetDefaultFont(Value: TFont);
procedure SetSkinData(Value: TbsSkinData);
procedure SetVScrollBar(Value: TbsSkinScrollBar);
procedure SetHScrollBar(Value: TbsSkinScrollBar);
procedure WMNCCALCSIZE(var Message: TWMNCCalcSize); message WM_NCCALCSIZE;
procedure WMNCPAINT(var Message: TWMNCPAINT); message WM_NCPAINT;
procedure WndProc(var Message: TMessage); override;
procedure CMVisibleChanged(var Message: TMessage); message CM_VISIBLECHANGED;
procedure OnVScrollBarChange(Sender: TObject);
procedure OnHScrollBarChange(Sender: TObject);
procedure CreateParams(var Params: TCreateParams); override;
procedure Change(Node: TTreeNode); override;
procedure Loaded; override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure ChangeSkinData; virtual;
procedure UpDateScrollBars;
property HScrollBar: TbsSkinScrollBar read FHScrollBar
write SetHScrollBar;
property VScrollBar: TbsSkinScrollBar read FVScrollBar
write SetVScrollBar;
property DefaultFont: TFont read FDefaultFont write SetDefaultFont;
property SkinData: TbsSkinData read FSD write SetSkinData;
property SkinDataName: String read FSkinDataName write FSkinDataName;
property DefaultColor: TColor read FDefaultColor write SetDefaultColor;
property UseSkinFont: Boolean read FUseSkinFont write FUseSkinFont;
end;
TbsSkinTreeView = class(TbsSkinCustomTreeView)
published
property Items;
property HScrollBar;
property VScrollBar;
property DefaultFont;
property UseSkinFont;
property SkinData;
property SkinDataName;
property DefaultColor;
property Align;
property Anchors;
property AutoExpand;
property BiDiMode;
property ChangeDelay;
property Color;
property Constraints;
property DragKind;
property DragCursor;
property DragMode;
property Enabled;
property Font;
property HideSelection;
property HotTrack;
property Images;
property Indent;
{$IFDEF VER140}
property MultiSelect;
property MultiSelectStyle;
{$ENDIF}
{$IFDEF VER150}
property MultiSelect;
property MultiSelectStyle;
{$ENDIF}
property ParentBiDiMode;
property ParentColor default False;
property ParentCtl3D;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ReadOnly;
property RightClickSelect;
property RowSelect;
property ShowButtons;
property ShowHint;
property ShowLines;
property ShowRoot;
property SortType;
property StateImages;
property TabOrder;
property TabStop default True;
property ToolTips;
property Visible;
{$IFDEF VER140}
property OnAddition;
{$ENDIF}
{$IFDEF VER150}
property OnAddition;
{$ENDIF}
property OnAdvancedCustomDraw;
property OnAdvancedCustomDrawItem;
property OnChange;
property OnChanging;
property OnClick;
property OnCollapsed;
property OnCollapsing;
property OnCompare;
property OnContextPopup;
{$IFDEF VER140}
property OnCreateNodeClass;
{$ENDIF}
{$IFDEF VER150}
property OnCreateNodeClass;
{$ENDIF}
property OnCustomDraw;
property OnCustomDrawItem;
property OnDblClick;
property OnDeletion;
property OnDragDrop;
property OnDragOver;
property OnEdited;
property OnEditing;
property OnEndDock;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnExpanding;
property OnExpanded;
property OnGetImageIndex;
property OnGetSelectedIndex;
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnStartDock;
property OnStartDrag;
end;
TbsDrawHeaderSectionEvent = procedure (Cnvs: TCanvas; Column: TListColumn;
Pressed: Boolean; R: TRect) of object;
TbsSkinCustomListView = class(TCustomListView)
protected
FHeaderSkinDataName: String;
FInCheckScrollBars: Boolean;
FromSB: Boolean;
FSD: TbsSkinData;
FSkinDataName: String;
FIndex: Integer;
FDefaultFont: TFont;
FUseSkinFont: Boolean;
FDefaultColor: TColor;
//
FVScrollBar: TbsSkinScrollBar;
FHScrollBar: TbsSkinScrollBar;
FOldVScrollBarPos: Integer;
FOldHScrollBarPos: Integer;
//
FHeaderHandle: HWND;
FHeaderInstance: Pointer;
FDefHeaderProc: Pointer;
FActiveSection: Integer;
FHeaderDown: Boolean;
FHeaderInDivider: Boolean;
//
FHIndex: Integer;
HLTPt, HRTPt, HLBPt, HRBPt: TPoint;
HSkinRect, HClRect: TRect;
HNewLTPoint, HNewRTPoint, HNewLBPoint, HNewRBPoint: TPoint;
HNewClRect: TRect;
HPicture: TBitMap;
HFontColor, HActiveFontColor, HDownFontColor: TColor;
HActiveSkinRect, HDownSkinRect: TRect;
//
FOnDrawHeaderSection: TbsDrawHeaderSectionEvent;
//
procedure HGetSkinData;
function GetHeaderSectionRect(Index: Integer): TRect;
procedure Notification(AComponent: TComponent;
Operation: TOperation); override;
procedure SetDefaultColor(Value: TColor);
procedure SetDefaultFont(Value: TFont);
procedure SetSkinData(Value: TbsSkinData);
procedure UpDateScrollBars1;
procedure UpDateScrollBars2;
procedure UpDateScrollBars3;
procedure SetVScrollBar(Value: TbsSkinScrollBar);
procedure SetHScrollBar(Value: TbsSkinScrollBar);
procedure WMNCCALCSIZE(var Message: TWMNCCalcSize); message WM_NCCALCSIZE;
procedure WMNCPAINT(var Message: TWMNCPAINT); message WM_NCPAINT;
procedure CMVisibleChanged(var Message: TMessage); message CM_VISIBLECHANGED;
procedure WndProc(var Message: TMessage); override;
procedure OnVScrollBarChange(Sender: TObject);
procedure OnHScrollBarChange(Sender: TObject);
procedure CreateParams(var Params: TCreateParams); override;
procedure Loaded; override;
//
procedure HeaderWndProc(var Message: TMessage);
procedure DrawHeaderSection(Cnvs: TCanvas; Column: TListColumn;
Active, Pressed: Boolean; R: TRect);
procedure PaintHeader(DC: HDC);
procedure CreateWnd; override;
//
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure UpDateScrollBars;
procedure ChangeSkinData;
property HScrollBar: TbsSkinScrollBar read FHScrollBar
write SetHScrollBar;
property VScrollBar: TbsSkinScrollBar read FVScrollBar
write SetVScrollBar;
property DefaultFont: TFont read FDefaultFont write SetDefaultFont;
property UseSkinFont: Boolean read FUseSkinFont write FUseSkinFont;
property SkinData: TbsSkinData read FSD write SetSkinData;
property SkinDataName: String read FSkinDataName write FSkinDataName;
property DefaultColor: TColor read FDefaultColor write SetDefaultColor;
property HeaderSkinDataName: String
read FHeaderSkinDataName write FHeaderSkinDataName;
property OnDrawHeaderSection: TbsDrawHeaderSectionEvent
read FOnDrawHeaderSection write FOnDrawHeaderSection;
end;
TbsSkinListView = class(TbsSkinCustomListView)
published
property Action;
property Align;
property AllocBy;
property Anchors;
property BiDiMode;
property Checkboxes;
property Color;
property Columns;
property ColumnClick;
property Constraints;
property DragCursor;
property DragKind;
property DragMode;
property Enabled;
property Font;
property FullDrag;
property GridLines;
property HideSelection;
property HotTrack;
property HotTrackStyles;
property HoverTime;
property IconOptions;
property Items;
property LargeImages;
property MultiSelect;
property OwnerData;
property OwnerDraw;
property ReadOnly default False;
property RowSelect;
property ParentBiDiMode;
property ParentColor default False;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ShowColumnHeaders;
property ShowWorkAreas;
property ShowHint;
property SmallImages;
property SortType;
property StateImages;
property TabOrder;
property TabStop default True;
property ViewStyle;
property Visible;
property HeaderSkinDataName;
property HScrollBar;
property VScrollBar;
property DefaultFont;
property UseSkinFont;
property SkinData;
property SkinDataName;
property DefaultColor;
property OnAdvancedCustomDraw;
property OnAdvancedCustomDrawItem;
property OnAdvancedCustomDrawSubItem;
property OnChange;
property OnChanging;
property OnClick;
property OnColumnClick;
property OnColumnDragged;
property OnColumnRightClick;
property OnCompare;
property OnContextPopup;
property OnCustomDraw;
property OnCustomDrawItem;
property OnCustomDrawSubItem;
property OnDrawHeaderSection;
property OnData;
property OnDataFind;
property OnDataHint;
property OnDataStateChange;
property OnDblClick;
property OnDeletion;
property OnDrawItem;
property OnEdited;
property OnEditing;
property OnEndDock;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnGetImageIndex;
property OnGetSubItemImage;
property OnDragDrop;
property OnDragOver;
property OnInfoTip;
property OnInsert;
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnResize;
property OnSelectItem;
property OnStartDock;
property OnStartDrag;
end;
TbsSkinRichEdit = class(TCustomRichEdit)
protected
FSkinSupport: Boolean;
FSD: TbsSkinData;
FSkinDataName: String;
FIndex: Integer;
FDefaultFont: TFont;
FDefaultColor: TColor;
//
FVScrollBar: TbsSkinScrollBar;
FHScrollBar: TbsSkinScrollBar;
FOldVScrollBarPos: Integer;
FOldHScrollBarPos: Integer;
procedure Notification(AComponent: TComponent;
Operation: TOperation); override;
procedure SetDefaultColor(Value: TColor);
procedure SetDefaultFont(Value: TFont);
procedure SetSkinData(Value: TbsSkinData);
procedure SetVScrollBar(Value: TbsSkinScrollBar);
procedure SetHScrollBar(Value: TbsSkinScrollBar);
procedure WMNCCALCSIZE(var Message: TWMNCCalcSize); message WM_NCCALCSIZE;
procedure WMMOUSEWHEEL(var Message: TMessage); message WM_MOUSEWHEEL;
procedure WMNCPAINT(var Message: TWMNCPAINT); message WM_NCPAINT;
procedure WndProc(var Message: TMessage); override;
procedure OnVScrollBarChange(Sender: TObject);
procedure OnHScrollBarChange(Sender: TObject);
procedure Loaded; override;
procedure CreateParams(var Params: TCreateParams); override;
procedure OnVScrollBarUpButtonClick(Sender: TObject);
procedure OnVScrollBarDownButtonClick(Sender: TObject);
procedure Change; override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure UpDateScrollBars;
procedure ChangeSkinData;
published
property Align;
property Alignment;
property Anchors;
property BiDiMode;
property Color;
property DragCursor;
property DragKind;
property DragMode;
property Enabled;
property Font;
property HideSelection;
property ImeMode;
property ImeName;
property Constraints;
property Lines;
property MaxLength;
property ParentBiDiMode;
property ParentFont;
property ParentShowHint;
property PlainText;
property PopupMenu;
property ReadOnly;
property ShowHint;
property TabOrder;
property TabStop default True;
property Visible;
property WantTabs;
property WantReturns;
property WordWrap;
property SkinSupport: Boolean read FSkinSupport write FSkinSupport;
property HScrollBar: TbsSkinScrollBar read FHScrollBar
write SetHScrollBar;
property VScrollBar: TbsSkinScrollBar read FVScrollBar
write SetVScrollBar;
property DefaultFont: TFont read FDefaultFont write SetDefaultFont;
property SkinData: TbsSkinData read FSD write SetSkinData;
property SkinDataName: String read FSkinDataName write FSkinDataName;
property DefaultColor: TColor read FDefaultColor write SetDefaultColor;
property OnChange;
property OnContextPopup;
property OnDragDrop;
property OnDragOver;
property OnEndDock;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnMouseWheel;
property OnMouseWheelDown;
property OnMouseWheelUp;
property OnProtectChange;
property OnResizeRequest;
property OnSaveClipboard;
property OnSelectionChange;
property OnStartDock;
property OnStartDrag;
end;
TbsStatusPanelNumGlyphs = 1..2;
TbsSkinStatusPanel = class(TbsSkinLabel)
private
FGlyph: TBitMap;
FNumGlyphs: TbsStatusPanelNumGlyphs;
procedure SetNumGlyphs(Value: TbsStatusPanelNumGlyphs);
procedure SetGlyph(Value: TBitMap);
protected
procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
procedure CreateControlDefaultImage(B: TBitMap); override;
procedure CreateControlSkinImage(B: TBitMap); override;
function CalcWidthOffset: Integer; override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property Glyph: TBitMap read FGlyph write SetGlyph;
property NumGlyphs: TbsStatusPanelNumGlyphs read FNumGlyphs write SetNumGlyphs;
end;
TbsGraphicSkinControl = class(TGraphicControl)
protected
FSD: TbsSkinData;
FSkinDataName: String;
FOnMouseEnter, FOnMouseLeave: TNotifyEvent;
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
procedure GetSkinData; virtual;
procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
procedure SetSkinData(Value: TbsSkinData); virtual;
procedure CreateControlDefaultImage(B: TBitMap); virtual;
procedure CreateControlSkinImage(B: TBitMap); virtual;
public
FIndex: Integer;
procedure Paint; override;
procedure ChangeSkinData; virtual;
procedure BeforeChangeSkinData; virtual;
destructor Destroy; override;
constructor Create(AOwner: TComponent); override;
published
property Anchors;
property Visible;
property SkinData: TbsSkinData read FSD write SetSkinData;
property SkinDataName: String read FSkinDataName write FSkinDataName;
property OnMouseEnter: TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
property OnMouseLeave: TNotifyEvent read FOnMouseLeave write FOnMouseLeave;
end;
TbsGraphicSkinCustomControl = class(TbsGraphicSkinControl)
protected
FDefaultWidth: Integer;
FDefaultHeight: Integer;
FDefaultFont: TFont;
FUseSkinFont: Boolean;
LTPt, RTPt, LBPt, RBPt: TPoint;
SkinRect, ClRect: TRect;
NewLTPoint, NewRTPoint, NewLBPoint, NewRBPoint: TPoint;
NewClRect: TRect;
Picture: TBitMap;
ResizeMode: Integer;
procedure OnDefaultFontChange(Sender: TObject);
procedure SetDefaultWidth(Value: Integer);
procedure SetDefaultHeight(Value: Integer);
procedure SetDefaultFont(Value: TFont);
procedure DefaultFontChange; virtual;
function GetNewRect(R: TRect): TRect;
function GetResizeMode: Integer;
procedure CalcSize(var W, H: Integer); virtual;
procedure CreateSkinControlImage(B, SB: TBitMap; R: TRect);
procedure GetSkinData; override;
procedure CreateControlDefaultImage(B: TBitMap); override;
procedure CreateControlSkinImage(B: TBitMap); override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
procedure ChangeSkinData; override;
published
property DefaultFont: TFont read FDefaultFont write SetDefaultFont;
property DefaultWidth: Integer read FDefaultWidth write SetDefaultWidth;
property DefaultHeight: Integer read FDefaultHeight write SetDefaultHeight;
property UseSkinFont: Boolean read FUseSkinFont write FUseSkinFont;
end;
TbsSkinSpeedButton = class(TbsGraphicSkinCustomControl)
protected
FImageIndex: Integer;
RepeatTimer: TTimer;
FRepeatMode: Boolean;
FRepeatInterval: Integer;
FFlat: Boolean;
FAllowAllUp: Boolean;
FAllowAllUpCheck: Boolean;
FDown: Boolean;
FMouseIn, FMouseDown: Boolean;
FGroupIndex: Integer;
FGlyph: TBitMap;
FNumGlyphs: TbsNumGlyphs;
FMargin: Integer;
FSpacing: Integer;
FLayout: TbsButtonLayout;
MorphTimer: TTimer;
FMorphKf: Double;
FShowCaption: Boolean;
FWidthWithCaption: Integer;
FWidthWithoutCaption: Integer;
procedure SetShowCaption(const Value: Boolean);
procedure SetImageIndex(Value: Integer);
procedure RepeatTimerProc(Sender: TObject);
procedure StartRepeat;
procedure StopRepeat;
procedure StartMorph;
procedure StopMorph;
procedure DoMorph(Sender: TObject);
function GetTransparent: Boolean;
procedure SetTransparent(Value: Boolean);
procedure SetFlat(Value: Boolean);
function GetGlyphNum(AIsDown, AIsMouseIn: Boolean): Integer;
procedure CreateButtonImage(B: TBitMap; R: TRect; ADown, AMouseIn: Boolean); virtual;
procedure SetLayout(Value : TbsButtonLayout);
procedure SetGroupIndex(Value: Integer);
procedure SetDown(Value: Boolean);
procedure SetMargin(Value: Integer);
procedure SetSpacing(Value: Integer);
procedure DoAllUp;
procedure SetNumGlyphs(Value: TbsNumGlyphs);
procedure SetGlyph(Value: TBitMap);
procedure GetSkinData; override;
procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); override;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); override;
procedure ReDrawControl;
procedure CreateControlDefaultImage(B: TBitMap); override;
procedure CreateControlSkinImage(B: TBitMap); override;
procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
public
FontName: String;
FontStyle: TFontStyles;
FontHeight: Integer;
FontColor, ActiveFontColor, DownFontColor, DisabledFontColor: TColor;
ActiveSkinRect, DownSkinRect, DisabledSkinRect: TRect;
Morphing: Boolean;
MorphKind: TbsMorphKind;
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure ChangeSkinData; override;
procedure Paint; override;
procedure ButtonClick; virtual;
published
property WidthWithCaption: Integer
read FWidthWithCaption write FWidthWithCaption;
property WidthWithoutCaption: Integer
read FWidthWithoutCaption write FWidthWithoutCaption;
property ImageIndex: Integer read FImageIndex write SetImageIndex;
property RepeatMode: Boolean read FRepeatMode write FRepeatMode;
property RepeatInterval: Integer
read FRepeatInterval write FRepeatInterval;
property Transparent: Boolean read GetTransparent write SetTransparent;
property Flat: Boolean read FFlat write SetFlat;
property AllowAllUp: Boolean read FAllowAllUp write FAllowAllUp;
property PopupMenu;
property ShowHint;
property Action;
property ParentShowHint;
property Down: Boolean read FDown write SetDown;
property GroupIndex: Integer read FGroupIndex write SetGroupIndex;
property Caption;
property ShowCaption: Boolean read FShowCaption write SetShowCaption;
property Glyph: TBitMap read FGlyph write SetGlyph;
property NumGlyphs: TbsNumGlyphs read FNumGlyphs write SetNumGlyphs;
property Align;
property Margin: Integer read FMargin write SetMargin default -1;
property Spacing: Integer read FSpacing write SetSpacing default 4;
property Layout: TbsButtonLayout read FLayout write SetLayout default blGlyphLeft;
property Enabled;
property OnClick;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnResize;
end;
TbsSkinMenuSpeedButton = class(TbsSkinSpeedButton)
protected
FOnShowTrackMenu: TNotifyEvent;
FOnHideTrackMenu: TNotifyEvent;
FTrackButtonMode: Boolean;
FMenuTracked: Boolean;
FSkinPopupMenu: TbsSkinPopupMenu;
procedure CreateButtonImage(B: TBitMap; R: TRect; ADown, AMouseIn: Boolean); override;
function CanMenuTrack(X, Y: Integer): Boolean;
procedure TrackMenu;
procedure SetTrackButtonMode(Value: Boolean);
procedure GetSkinData; override;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); override;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); override;
procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
procedure Notification(AComponent: TComponent;
Operation: TOperation); override;
procedure WMCLOSESKINMENU(var Message: TMessage); message WM_CLOSESKINMENU;
function GetNewTrackButtonRect: TRect;
procedure CreateControlDefaultImage(B: TBitMap); override;
public
TrackButtonRect: TRect;
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Paint; override;
published
property SkinPopupMenu: TbsSkinPopupMenu read FSkinPopupMenu
write FSkinPopupMenu;
property TrackButtonMode: Boolean read FTrackButtonMode
write SetTrackButtonMode;
property OnShowTrackMenu: TNotifyEvent read FOnShowTrackMenu
write FOnShowTrackMenu;
property OnHideTrackMenu: TNotifyEvent read FOnHideTrackMenu
write FOnHideTrackMenu;
end;
TbsCustomDrawSkinSectionEvent = procedure(HeaderControl: THeaderControl;
Section: THeaderSection; const Rect: TRect; Active, Pressed: Boolean;
Cnvs: TCanvas) of object;
TbsSkinHeaderControl = class(THeaderControl)
protected
//
FSD: TbsSkinData;
FSkinDataName: String;
FIndex: Integer;
FDefaultFont: TFont;
FUseSkinFont: Boolean;
FDefaultHeight: Integer;
//
InDivider: Boolean;
FDown: Boolean;
FInTracking: Boolean;
FActiveSection, FOldActiveSection: Integer;
FOnSkinSectionClick: TSectionNotifyEvent;
FOnDrawSkinSection: TbsCustomDrawSkinSectionEvent;
procedure SetDefaultHeight(Value: Integer);
function GetSkinItemRect(Index: Integer): TRect;
procedure PaintWindow(DC: HDC); override;
procedure WMPaint(var Msg: TWMPaint); message WM_PAINT;
procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
function DrawSkinSection(Cnvs: TCanvas; Index: Integer; Active, Pressed: Boolean): TRect;
procedure DrawSkinSectionR(Cnvs: TCanvas; Section: THeaderSection; Active, Pressed: Boolean; R: TRect);
procedure CreateParams(var Params: TCreateParams); override;
procedure TestActive(X, Y: Integer);
procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); override;
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); override;
procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
procedure WndProc(var Message:TMessage); override;
procedure CreateWnd; override;
procedure DrawSection(Section: THeaderSection; const Rect: TRect;
Pressed: Boolean); override;
procedure SetDefaultFont(Value: TFont);
procedure SetSkinData(Value: TbsSkinData);
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
public
LTPt, RTPt, LBPt, RBPt: TPoint;
SkinRect, ClRect: TRect;
NewLTPoint, NewRTPoint, NewLBPoint, NewRBPoint: TPoint;
NewClRect: TRect;
Picture: TBitMap;
FontName: String;
FontStyle: TFontStyles;
FontHeight: Integer;
FontColor, ActiveFontColor, DownFontColor: TColor;
ActiveSkinRect, DownSkinRect: TRect;
//
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure GetSkinData;
procedure ChangeSkinData;
procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
published
property DefaultFont: TFont read FDefaultFont write SetDefaultFont;
property DefaultHeight: Integer read FDefaultHeight write SetDefaultHeight;
property UseSkinFont: Boolean read FUseSkinFont write FUseSkinFont;
property SkinData: TbsSkinData read FSD write SetSkinData;
property SkinDataName: String read FSkinDataName write FSkinDataName;
property OnSkinSectionClick: TSectionNotifyEvent
read FOnSkinSectionClick write FOnSkinSectionClick;
property OnDrawSkinSection: TbsCustomDrawSkinSectionEvent
read FOnDrawSkinSection write FOnDrawSkinSection;
end;
TbsNumThumbStates = 1..2;
TbsSliderOrientation = (soHorizontal, soVertical);
TbsSliderOption = (soShowFocus, soShowPoints, soSmooth,
soRulerOpaque, soThumbOpaque);
TbsSliderOptions = set of TbsSliderOption;
TbsSliderImage = (siHThumb, siHRuler, siVThumb, siVRuler);
TbsSliderImages = set of TbsSliderImage;
TbsSliderImageArray = array[TbsSliderImage] of TBitmap;
TbsJumpMode = (jmNone, jmHome, jmEnd, jmNext, jmPrior);
TbsSkinCustomSlider = class(TbsSkinControl)
private
FUseSkinThumb: Boolean;
FTransparent: Boolean;
FUserImages: TbsSliderImages;
FImages: TbsSliderImageArray;
FEdgeSize: Integer;
FRuler: TBitmap;
FPaintBuffered: Boolean;
FRulerOrg: TPoint;
FThumbRect: TRect;
FThumbDown: Boolean;
FNumThumbStates: TbsNumThumbStates;
FPointsRect: TRect;
FOrientation: TbsSliderOrientation;
FOptions: TbsSliderOptions;
FBevelWidth: Integer;
FMinValue: Longint;
FMaxValue: Longint;
FIncrement: Longint;
FValue: Longint;
FHit: Integer;
FFocused: Boolean;
FSliding: Boolean;
FTracking: Boolean;
FTimerActive: Boolean;
FMousePos: TPoint;
FStartJump: TbsJumpMode;
FReadOnly: Boolean;
FOnChange: TNotifyEvent;
FOnChanged: TNotifyEvent;
FOnDrawPoints: TNotifyEvent;
procedure SetTransparent(Value: Boolean);
function GetImage(Index: Integer): TBitmap;
procedure SetImage(Index: Integer; Value: TBitmap);
procedure SliderImageChanged(Sender: TObject);
procedure SetEdgeSize(Value: Integer);
function GetNumThumbStates: TbsNumThumbStates;
procedure SetNumThumbStates(Value: TbsNumThumbStates);
procedure SetOrientation(Value: TbsSliderOrientation);
procedure SetOptions(Value: TbsSliderOptions);
procedure SetMinValue(Value: Longint);
procedure SetMaxValue(Value: Longint);
procedure SetIncrement(Value: Longint);
procedure SetReadOnly(Value: Boolean);
function GetThumbOffset: Integer;
procedure SetThumbOffset(Value: Integer);
procedure SetValue(Value: Longint);
procedure ThumbJump(Jump: TbsJumpMode);
function GetThumbPosition(var Offset: Integer): TPoint;
function JumpTo(X, Y: Integer): TbsJumpMode;
procedure InvalidateThumb;
procedure StopTracking;
procedure TimerTrack;
function StoreImage(Index: Integer): Boolean;
procedure CreateElements;
procedure BuildRuler(R: TRect);
procedure BuildSkinRuler(R: TRect);
procedure AdjustElements;
procedure ReadUserImages(Stream: TStream);
procedure WriteUserImages(Stream: TStream);
procedure InternalDrawPoints(ACanvas: TCanvas; PointsStep, PointsHeight,
ExtremePointsHeight: Longint);
procedure DrawThumb(Canvas: TCanvas; Origin: TPoint; Highlight: Boolean);
procedure DrawSkinThumb(Canvas: TCanvas; Origin: TPoint; Highlight: Boolean);
function GetValueByOffset(Offset: Integer): Longint;
function GetOffsetByValue(Value: Longint): Integer;
function GetRulerLength: Integer;
procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
procedure CMFocusChanged(var Message: TCMFocusChanged); message CM_FOCUSCHANGED;
procedure WMGetDlgCode(var Msg: TWMGetDlgCode); message WM_GETDLGCODE;
procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
procedure WMSize(var Message: TWMSize); message WM_SIZE;
procedure WMTimer(var Message: TMessage); message WM_TIMER;
procedure WMMOVE(var Msg: TWMMOVE); message WM_MOVE;
protected
procedure AlignControls(AControl: TControl; var Rect: TRect); override;
procedure DefineProperties(Filer: TFiler); override;
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
procedure Loaded; override;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); override;
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); override;
function CanModify: Boolean; virtual;
function GetSliderRect: TRect; virtual;
function GetSliderValue: Longint; virtual;
procedure Change; dynamic;
procedure Changed; dynamic;
procedure Sized; virtual;
procedure RangeChanged; virtual;
procedure SetRange(Min, Max: Longint);
procedure ThumbMouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); virtual;
procedure ThumbMouseMove(Shift: TShiftState; X, Y: Integer); virtual;
procedure ThumbMouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); virtual;
property ThumbOffset: Integer read GetThumbOffset write SetThumbOffset;
property SliderRect: TRect read GetSliderRect;
property ImageHThumb: TBitmap index Ord(siHThumb) read GetImage
write SetImage stored StoreImage;
property ImageHRuler: TBitmap index Ord(siHRuler) read GetImage
write SetImage stored StoreImage;
property ImageVThumb: TBitmap index Ord(siVThumb) read GetImage
write SetImage stored StoreImage;
property ImageVRuler: TBitmap index Ord(siVRuler) read GetImage
write SetImage stored StoreImage;
property NumThumbStates: TbsNumThumbStates read GetNumThumbStates
write SetNumThumbStates default 2;
property Orientation: TbsSliderOrientation read FOrientation
write SetOrientation default soHorizontal;
property EdgeSize: Integer read FEdgeSize write SetEdgeSize default 2;
property Options: TbsSliderOptions read FOptions write SetOptions
default [soShowFocus, soShowPoints, soSmooth];
property ReadOnly: Boolean read FReadOnly write SetReadOnly default False;
property OnChange: TNotifyEvent read FOnChange write FOnChange;
property OnChanged: TNotifyEvent read FOnChanged write FOnChanged;
property OnDrawPoints: TNotifyEvent read FOnDrawPoints write FOnDrawPoints;
procedure GetSkinData; override;
public
HRulerRect: TRect;
HThumbRect: TRect;
VRulerRect: TRect;
VThumbRect: TRect;
SkinEdgeSize: Integer;
BGColor: TColor;
PointsColor: TColor;
Picture: TBitMap;
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Paint; override;
procedure DefaultDrawPoints(PointsStep, PointsHeight,
ExtremePointsHeight: Longint); virtual;
procedure ChangeSkinData; override;
property Canvas;
property Increment: Longint read FIncrement write SetIncrement default 10;
property MinValue: Longint read FMinValue write SetMinValue default 0;
property MaxValue: Longint read FMaxValue write SetMaxValue default 100;
property Value: Longint read FValue write SetValue default 0;
property Transparent: Boolean read FTransparent write SetTransparent;
property UseSkinThumb: Boolean read FUseSkinThumb write FUseSkinThumb;
end;
{ TbsSlider }
TbsSkinSlider = class(TbsSkinCustomSlider)
published
property Align;
property Color;
property Cursor;
property DragMode;
property DragCursor;
property Enabled;
property ImageHThumb;
property ImageHRuler;
property ImageVThumb;
property ImageVRuler;
property Increment;
property MinValue;
property MaxValue;
property NumThumbStates;
property Orientation;
property EdgeSize;
property Options;
property ParentColor;
property ParentShowHint;
property PopupMenu;
property ShowHint;
property TabOrder;
property TabStop default True;
property Value;
property Transparent;
property UseSkinThumb;
property Visible;
property Anchors;
property Constraints;
property DragKind;
property OnChange;
property OnChanged;
property OnDrawPoints;
property OnClick;
property OnDblClick;
property OnEnter;
property OnExit;
property OnMouseMove;
property OnMouseDown;
property OnMouseUp;
property OnKeyDown;
property OnKeyUp;
property OnKeyPress;
property OnDragOver;
property OnDragDrop;
property OnEndDrag;
property OnStartDrag;
property OnContextPopup;
property OnMouseWheelDown;
property OnMouseWheelUp;
property OnEndDock;
property OnStartDock;
end;
TbsSkinButtonsBar = class;
TbsButtonBarSection = class;
TbsButtonBarItems = class;
TbsButtonBarItem = class(TCollectionItem)
private
FText: String;
FImageIndex: Integer;
FOnClick: TNotifyEvent;
FTag: Integer;
FLayout: TbsButtonLayout;
FMargin: Integer;
FSpacing: Integer;
FHint: String;
procedure SetText(const Value: string);
procedure SetImageIndex(const Value: Integer);
procedure ItemClick(const Value: TNotifyEvent);
procedure SetLayout(Value: TbsButtonLayout);
procedure SetMargin(Value: Integer);
procedure SetSpacing(Value: Integer);
protected
function GetDisplayName: string; override;
procedure Click;
public
constructor Create(Collection: TCollection); override;
procedure Assign(Source: TPersistent); override;
published
property Text: string read FText write SetText;
property Hint: string read FHint write FHint;
property ImageIndex:integer read FImageIndex write SetImageIndex;
property Tag: Integer read FTag write FTag;
property Layout: TbsButtonLayout read FLayout write SetLayout;
property Margin: Integer read FMargin write SetMargin;
property Spacing: Integer read FSpacing write SetSpacing;
property OnClick:TNotifyEvent read FonClick write ItemClick;
end;
TbsButtonBarItems = class(TCollection)
private
FSection: TbsButtonBarSection;
function GetItem(Index: Integer): TbsButtonBarItem;
procedure SetItem(Index: Integer; Value: TbsButtonBarItem);
protected
function GetOwner: TPersistent; override;
procedure Update(Item: TCollectionItem); override;
public
constructor Create(Section: TbsButtonBarSection);
function Add: TbsButtonBarItem;
property Items[Index: Integer]: TbsButtonBarItem read GetItem write SetItem; default;
end;
TbsButtonBarSection = class(TCollectionItem)
private
FText: string;
FItems: TbsButtonBarItems;
FOnClick: TNotifyEvent;
FImageIndex: Integer;
FTag: Integer;
FHint: String;
FMargin: Integer;
FSpacing: Integer;
procedure SetText(const Value: string);
procedure SetItems(const Value: TbsButtonBarItems);
procedure SectionClick(const Value: TNotifyEvent);
procedure SetImageIndex(Value: Integer);
procedure SetMargin(Value: Integer);
procedure SetSpacing(Value: Integer);
protected
function GetDisplayName: string; override;
procedure Click;
public
constructor Create(Collection: TCollection); override;
destructor Destroy;override;
procedure Assign(Source: TPersistent); override;
published
property Text: string read FText write SetText;
property Hint: string read FHint write FHint;
property Items: TbsButtonBarItems read FItems write SetItems;
property Tag: Integer read FTag write FTag;
property ImageIndex: Integer read FImageIndex write SetImageIndex;
property Margin: Integer read FMargin write SetMargin;
property Spacing: Integer read FSpacing write SetSpacing;
property OnClick:TNotifyEvent read FOnClick write SectionClick;
end;
TbsButtonBarSections = class(TCollection)
private
FButtonsBar: TbsSkinButtonsBar;
function GetItem(Index: Integer): TbsButtonBarSection;
procedure SetItem(Index: Integer; Value: TbsButtonBarSection);
protected
function GetOwner: TPersistent; override;
procedure Update(Item: TCollectionItem); override;
public
function GetButtonsBar: TbsSkinButtonsBar;
constructor Create(ButtonsBar: TbsSkinButtonsBar);
function Add: TbsButtonBarSection;
property Items[Index: Integer]: TbsButtonBarSection read GetItem write SetItem; default;
end;
TbsSectionButton = class(TbsSkinSpeedButton)
private
FItemIndex: Integer;
FButtonsBar: TbsSkinButtonsBar;
public
constructor CreateEx(AOwner: TComponent; AButtonsBar: TbsSkinButtonsBar; AIndex: Integer);
procedure ButtonClick; override;
end;
TbsSectionItem = class(TbsSkinSpeedButton)
private
FItemIndex: Integer;
FButtonsBar: TbsSkinButtonsBar;
FSectionIndex: Integer;
public
constructor CreateEx(AOwner: TComponent; AButtonsBar: TbsSkinButtonsBar; ASectionIndex, AIndex: Integer);
procedure ButtonClick; override;
end;
TbsSkinButtonsBar = class(TbsSkinPanel)
private
FShowItemHint: Boolean;
FShowButtons: Boolean;
FDefaultSectionFont: TFont;
FDefaultItemFont: TFont;
FUpButton, FDownButton: TbsSkinButton;
TopIndex: Integer;
VisibleCount: Integer;
FItemHeight: Integer;
FItemsTransparent: Boolean;
FItemsPanel: TbsSkinPanel;
FSections: TbsButtonBarSections;
FSectionIndex: Integer;
FItemImages: TImagelist;
FSectionImages: TImageList;
FSectionButtons: TList;
FSectionItems: TList;
FSectionButtonSkinDataName: String;
FDefaultButtonHeight: Integer;
procedure SetShowButtons(Value: Boolean);
procedure SetDefaultButtonHeight(Value: Integer);
procedure SetDefaultSectionFont(Value: TFont);
procedure SetDefaultItemFont(Value: TFont);
procedure SetItemHeight(Value: Integer);
procedure SetItemsTransparent(Value: Boolean);
procedure SetSections(Value: TbsButtonBarSections);
procedure UpdateSection(Index: Integer);
procedure UpdateSections;
procedure UpdateItems;
procedure SetSectionIndex(const Value: integer);
procedure SetItemImages(const Value: TImagelist);
procedure SetSectionImages(const Value: TImageList);
procedure CheckVisibleItems;
procedure OnItemPanelResize(Sender: TObject);
protected
procedure CreateWnd; override;
procedure SetSkinData(Value: TbsSkinData); override;
procedure ClearSections;
procedure ClearItems;
procedure OpenSection(Index: Integer);
procedure ArangeItems;
procedure ShowUpButton;
procedure ShowDownButton;
procedure HideUpButton;
procedure HideDownButton;
procedure UpButtonClick(Sender: TObject);
procedure DownButtonClick(Sender: TObject);
public
procedure ScrollUp;
procedure ScrollDown;
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Notification(AComponent:TComponent; Operation:TOperation);override;
procedure UpDateSectionButtons;
procedure ChangeSkinData; override;
published
property ShowItemHint: Boolean read FShowItemHint write FShowItemHint;
property ShowButtons: Boolean read FShowButtons write SetShowButtons;
property DefaultSectionFont: TFont read FDefaultSectionFont write SetDefaultSectionFont;
property DefaultButtonHeight: Integer
read FDefaultButtonHeight write SetDefaultButtonHeight;
property DefaultItemFont: TFont read FDefaultItemFont write SetDefaultItemFont;
property Align default alLeft;
property Enabled;
property SectionButtonSkinDataName: String
read FSectionButtonSkinDataName
write FSectionButtonSkinDataName;
property ItemHeight: Integer read FItemHeight write SetItemHeight;
property ItemsTransparent: Boolean read FItemsTransparent write SetItemsTransparent;
property ItemImages: TImagelist read FItemImages write SetItemImages;
property SectionImages:TImageList read FSectionImages write SetSectionImages;
property Sections: TbsButtonBarSections read FSections write SetSections;
property SectionIndex:integer read FSectionIndex write SetSectionIndex;
property PopupMenu;
property ShowHint;
property Hint;
property Visible;
property OnClick;
property OnContextPopup;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnResize;
end;
{TbsSkinNoteBook}
TbsSkinPage = class(TbsSkinPanel)
private
procedure WMNCHitTest(var Message: TWMNCHitTest); message WM_NCHITTEST;
protected
FImageIndex: Integer;
procedure ReadState(Reader: TReader); override;
public
constructor Create(AOwner: TComponent); override;
published
property ImageIndex: Integer read FImageIndex write FImageIndex;
property Caption;
property Height stored False;
property TabOrder stored False;
property Visible stored False;
property Width stored False;
end;
TbsSkinNotebook = class(TbsSkinPanel)
private
FAccess: TStrings;
FPageIndex: Integer;
FOnPageChanged: TNotifyEvent;
FButtonsMode: Boolean;
FButtons: TList;
FImages: TImageList;
FButtonSkinDataName: String;
procedure SetImages(const Value: TImageList);
procedure ClearButtons;
procedure SetPages(Value: TStrings);
procedure SetActivePage(const Value: string);
function GetActivePage: string;
procedure SetPageIndex(Value: Integer);
procedure SetButtonsMode(Value: Boolean);
protected
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
procedure CreateParams(var Params: TCreateParams); override;
function GetChildOwner: TComponent; override;
procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
procedure ReadState(Reader: TReader); override;
procedure ShowControl(AControl: TControl); override;
procedure UpdateButtons;
public
FPageList: TList;
procedure UpdateButton(APageIndex: Integer; ACaption: String);
procedure Loaded; override;
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property ActivePage: string read GetActivePage write SetActivePage stored False;
property ButtonsMode: Boolean read FButtonsMode write SetButtonsMode;
property ButtonSkinDataName: String
read FButtonSkinDataName
write FButtonSkinDataName;
property Images: TImageList read FImages write SetImages;
property Align;
property Anchors;
property DragCursor;
property DragKind;
property DragMode;
property Font;
property Enabled;
property Constraints;
property PageIndex: Integer read FPageIndex write SetPageIndex default 0;
property Pages: TStrings read FAccess write SetPages stored False;
property ParentShowHint;
property PopupMenu;
property ShowHint;
property TabOrder;
property TabStop;
property Visible;
property OnClick;
property OnContextPopup;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnEndDock;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnPageChanged: TNotifyEvent read FOnPageChanged write FOnPageChanged;
property OnStartDock;
property OnStartDrag;
end;
TbsPageButton = class(TbsSkinSpeedButton)
private
FPageIndex: Integer;
FNoteBook: TbsSkinNoteBook;
public
constructor CreateEx(AOwner: TComponent; ANoteBook: TbsSkinNoteBook; APageIndex: Integer);
procedure ButtonClick; override;
end;
TbsSkinXFormButton = class(TbsSkinButton)
private
FDefImage: TBitMap;
FDefActiveImage: TBitMap;
FDefDownImage: TBitMap;
FDefMask: TBitMap;
FDefActiveFontColor: TColor;
FDefDownFontColor: TColor;
procedure SetDefImage(Value: TBitMap);
procedure SetDefActiveImage(Value: TBitMap);
procedure SetDefDownImage(Value: TBitMap);
procedure SetDefMask(Value: TBitMap);
protected
procedure SetControlRegion; override;
procedure DrawDefaultButton(C: TCanvas);
procedure CreateControlDefaultImage(B: TBitMap); override;
procedure Loaded; override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure ChangeSkinData; override;
procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
published
property DefImage: TBitMap read FDefImage write SetDefImage;
property DefActiveImage: TBitMap read FDefActiveImage write SetDefActiveImage;
property DefDownImage: TBitMap read FDefDownImage write SetDefDownImage;
property DefMask: TBitMap read FDefMask write SetDefMask;
property DefActiveFontColor: TColor
read FDefActiveFontColor write FDefActiveFontColor;
property DefDownFontColor: TColor
read FDefDownFontColor write FDefDownFontColor;
end;
TbsScrollType = (stHorizontal, stVertical);
TbsSkinScrollPanel = class(TbsSkinControl)
private
FClicksDisabled: Boolean;
FCanFocused: Boolean;
FHotScroll: Boolean;
TimerMode: Integer;
SMax, SPosition, SPage, SOldPosition: Integer;
FAutoSize: Boolean;
FVSizeOffset: Integer;
FHSizeOffset: Integer;
FScrollType: TbsScrollType;
FScrollOffset: Integer;
FScrollTimerInterval: Integer;
Buttons: array[0..1] of TbsControlButton;
PanelData: TbsDataSkinPanelControl;
ButtonData: TbsDataSkinButtonControl;
procedure SetScrollType(Value: TbsScrollType);
procedure SetScrollOffset(Value: Integer);
procedure SetScrollTimerInterval(Value: Integer);
procedure DrawButton(Cnvs: TCanvas; i: Integer);
protected
procedure GetSkinData; override;
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
procedure WMMOUSEWHEEL(var Message: TMessage); message WM_MOUSEWHEEL;
procedure WMTimer(var Message: TWMTimer); message WM_Timer;
procedure WMNCCALCSIZE(var Message: TWMNCCalcSize); message WM_NCCALCSIZE;
procedure WMNCPAINT(var Message: TMessage); message WM_NCPAINT;
procedure WMSIZE(var Message: TWMSIZE); message WM_SIZE;
procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
procedure CMWantSpecialKey(var Msg: TCMWantSpecialKey); message CM_WANTSPECIALKEY;
procedure CreateControlDefaultImage(B: TBitMap); override;
procedure CreateControlSkinImage(B: TBitMap); override;
procedure WndProc(var Message: TMessage); override;
procedure SetButtonsVisible(AVisible: Boolean);
procedure ButtonClick(I: Integer);
procedure ButtonDown(I: Integer);
procedure ButtonUp(I: Integer);
procedure GetHRange;
procedure GetVRange;
procedure VScrollControls(AOffset: Integer);
procedure HScrollControls(AOffset: Integer);
procedure AdjustClientRect(var Rect: TRect); override;
procedure StartTimer;
procedure StopTimer;
procedure Loaded; override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Paint; override;
procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
procedure UpDateSize;
procedure GetScrollInfo;
property Position: integer read SPosition;
published
property CanFocused: Boolean read FCanFocused write FCanFocused;
property HotScroll: Boolean read FHotScroll write FHotScroll;
property AutoSize: Boolean read FAutoSize write FAutoSize;
property Align;
property ScrollType: TbsScrollType read FScrollType write SetScrollType;
property ScrollOffset: Integer read FScrollOffset write SetScrollOffset;
property ScrollTimerInterval: Integer
read FScrollTimerInterval write SetScrollTimerInterval;
end;
procedure NotebookHandlesNeeded(Notebook: TbsSkinNotebook);
implementation
{$R *.res}
Uses bsUtils, ActnList, bsEffects, ShellAPI;
type
TParentControl = class(TWinControl);
const
MorphTimerInterval = 20;
MorphInc = 0.2;
ImagesResNames: array[TbsSliderImage] of PChar =
('BS_HTB', 'BS_HRL', 'BS_VTB', 'BS_VRL');
Indent = 6;
JumpInterval = 400;
ButtonSize = 12;
HTBUTTON1 = HTOBJECT + 100;
HTBUTTON2 = HTOBJECT + 101;
procedure NotebookHandlesNeeded(Notebook: TbsSkinNotebook);
var
I: Integer;
begin
if Notebook <> nil then
for I := 0 to Notebook.FPageList.Count - 1 do
with TbsSkinPage(Notebook.FPageList[I]) do
begin
DisableAlign;
try
HandleNeeded;
ControlState := ControlState - [csAlignmentNeeded];
finally
EnableAlign;
end;
end;
end;
procedure CalcLCoord(Layout: TbsButtonLayout; R: TRect; gw, gh, tw, th: Integer;
Spacing, Margin: Integer; var tx, ty, gx, gy: Integer);
var
H, W, H1, W1: Integer;
begin
H := R.Top + RectHeight(R) div 2;
W := R.Left + RectWidth(R) div 2;
if Margin = -1
then
begin
W1 := (tw + gw + Spacing) div 2;
H1 := (th + gh + Spacing) div 2;
case Layout of
blGlyphRight:
begin
tx := W - W1;
ty := H - th div 2;
gx := W + W1 - gw;
gy := H - gh div 2;
end;
blGlyphLeft:
begin
gx := W - W1;
gy := H - gh div 2;
tx := W + W1 - tw;
ty := H - th div 2;
end;
blGlyphTop:
begin
tx := W - tw div 2;
ty := H + H1 - th;
gx := W - gw div 2;
gy := H - H1;
end;
blGlyphBottom:
begin
gx := W - gw div 2;
gy := H + H1 - gh;
tx := W - tw div 2;
ty := H - H1;
end;
end;
end
else
begin
case Layout of
blGlyphRight:
begin
gy := H - gh div 2;
gx := R.Right - gw - Margin;
tx := gx - Spacing - tw;
ty := H - th div 2;
end;
blGlyphLeft:
begin
gy := H - gh div 2;
gx := R.Left + Margin;
tx := gx + gw + Spacing;
ty := H - th div 2;
end;
blGlyphTop:
begin
gy := R.Top + Margin;
gx := W - gw div 2;
ty := gy + gh + Spacing;
tx := W - tw div 2;
end;
blGlyphBottom:
begin
gy := R.Bottom - gh - Margin;
gx := W - gw div 2;
ty := gy - Spacing - th;
tx := W - tw div 2;
end;
end;
end;
end;
procedure DrawImageAndText(Cnvs: TCanvas; R: TRect; Margin, Spacing: Integer;
Layout: TbsButtonLayout;
Caption: String; ImageIndex: Integer; IL: TCustomIMageList; ADown: Boolean;
AEnabled: Boolean);
var
gw, gh: Integer;
tw, th: Integer;
TX, TY, GX, GY: Integer;
TR: TRect;
begin
if (ImageIndex < 0) or (IL = nil) or (ImageIndex >= IL.Count)
then
begin
gw := 0;
gh := 0;
end
else
begin
gw := IL.Width;
gh := IL.Height;
end;
with Cnvs do
begin
TR := NullRect;
DrawText(Handle, PChar(Caption), Length(Caption), TR,
DT_CALCRECT);
tw := RectWidth(TR);
th := RectHeight(TR);
Brush.Style := bsClear;
end;
CalcLCoord(Layout, R, gw, gh, tw, th, Spacing, Margin, TX, TY, GX, GY);
if ADown
then
begin
Inc(GX); Inc(GY);
Inc(TX); Inc(TY);
end;
TR := Rect(TX, TY, TX, TY);
DrawText(Cnvs.Handle, PChar(Caption), Length(Caption), TR, DT_CALCRECT);
Inc(TR.Right, 2);
DrawText(Cnvs.Handle, PChar(Caption), Length(Caption), TR, DT_VCENTER or DT_CENTER);
if gw <> 0 then IL.Draw(Cnvs, GX, GY, ImageIndex, AEnabled);
end;
procedure DrawGlyphAndText(Cnvs: TCanvas;
R: TRect; Margin, Spacing: Integer; Layout: TbsButtonLayout;
Caption: String; Glyph: TBitMap; NumGlyphs, GlyphNum: Integer; ADown: Boolean);
var
gw, gh: Integer;
tw, th: Integer;
TX, TY, GX, GY: Integer;
TR: TRect;
begin
if Glyph.Empty
then
begin
gw := 0;
gh := 0;
end
else
begin
gw := Glyph.Width div NumGlyphs;
gh := Glyph.Height;
end;
with Cnvs do
begin
TR := NullRect;
DrawText(Handle, PChar(Caption), Length(Caption), TR,
DT_CALCRECT);
tw := RectWidth(TR);
th := RectHeight(TR);
Brush.Style := bsClear;
end;
CalcLCoord(Layout, R, gw, gh, tw, th, Spacing, Margin, TX, TY, GX, GY);
if ADown
then
begin
Inc(GX); Inc(GY);
Inc(TX); Inc(TY);
end;
TR := Rect(TX, TY, TX, TY);
DrawText(Cnvs.Handle, PChar(Caption), Length(Caption), TR, DT_CALCRECT);
Inc(TR.Right, 2);
DrawText(Cnvs.Handle, PChar(Caption), Length(Caption), TR, DT_VCENTER or DT_CENTER);
if not Glyph.Empty then DrawGlyph(Cnvs, GX, GY, Glyph, NumGlyphs, GlyphNum);
end;
constructor TbsSkinControl.Create;
begin
inherited Create(AOwner);
FSD := nil;
Frgn := 0;
FIndex := -1;
end;
destructor TbsSkinControl.Destroy;
begin
inherited Destroy;
end;
procedure TbsSkinControl.CMMouseEnter;
begin
inherited;
if (csDesigning in ComponentState) then Exit;
if Assigned(FOnMouseEnter) then FOnMouseEnter(Self);
end;
procedure TbsSkinControl.CMMouseLeave;
begin
inherited;
if (csDesigning in ComponentState) then Exit;
if Assigned(FOnMouseLeave) then FOnMouseLeave(Self);
end;
procedure TbsSkinControl.WMEraseBkGnd;
begin
end;
procedure TbsSkinControl.WMMOVE;
begin
inherited;
end;
procedure TbsSkinControl.BeforeChangeSkinData;
begin
FIndex := -1;
end;
procedure TbsSkinControl.AfterChangeSkinData;
begin
end;
procedure TbsSkinControl.ChangeSkinData;
begin
GetSkinData;
RePaint;
end;
procedure TbsSkinControl.SetSkinDataName;
begin
FSkinDataName := Value;
end;
procedure TbsSkinControl.SetSkinData;
begin
FSD := Value;
if (FSD <> nil) then
if not FSD.Empty and not (csDesigning in ComponentState)
then
ChangeSkinData;
end;
procedure TbsSkinControl.GetSkinData;
begin
if (FSD = nil) or FSD.Empty
then
FIndex := -1
else
FIndex := FSD.GetControlIndex(FSkinDataName);
end;
procedure TbsSkinControl.Paint;
var
Buffer: TBitMap;
begin
if (Width <= 0) or (Height <= 0) then Exit;
GetSkinData;
Buffer := TBitMap.Create;
Buffer.Width := Width;
Buffer.Height := Height;
if FIndex <> -1
then
CreateControlSkinImage(Buffer)
else
CreateControlDefaultImage(Buffer);
Canvas.Draw(0, 0, Buffer);
Buffer.Free;
end;
procedure TbsSkinControl.CreateControlDefaultImage;
begin
end;
procedure TbsSkinControl.CreateControlSkinImage;
begin
end;
procedure TbsSkinControl.Notification;
begin
inherited Notification(AComponent, Operation);
if (Operation = opRemove) and (AComponent = FSD) then FSD := nil;
end;
constructor TbsSkinCustomControl.Create;
begin
inherited Create(AOwner);
FDefaultWidth := 0;
FDefaultHeight := 0;
FDefaultFont := TFont.Create;
FDefaultFont.OnChange := OnDefaultFontChange;
with FDefaultFont do
begin
Name := 'Arial';
Style := [];
Height := 14;
end;
FUseSkinFont := True;
end;
destructor TbsSkinCustomControl.Destroy;
begin
if FRgn <> 0
then
begin
DeleteObject(FRgn);
FRgn := 0;
end;
FDefaultFont.Free;
inherited Destroy;
end;
procedure TbsSkinCustomControl.SetDefaultWidth;
begin
FDefaultWidth := Value;
if (FIndex = -1) and (FDefaultWidth > 0) then Width := FDefaultWidth;
end;
procedure TbsSkinCustomControl.SetDefaultHeight;
begin
FDefaultHeight := Value;
if (FIndex = -1) and (FDefaultHeight > 0) then Height := FDefaultHeight;
end;
procedure TbsSkinCustomControl.DefaultFontChange;
begin
end;
procedure TbsSkinCustomControl.SetDefaultFont;
begin
FDefaultFont.Assign(Value);
DefaultFontChange;
end;
procedure TbsSkinCustomControl.OnDefaultFontChange;
begin
DefaultFontChange;
if FIndex = -1 then RePaint;
end;
procedure TbsSkinCustomControl.CreateControlDefaultImage;
var
R: TRect;
begin
with B.Canvas do
begin
Brush.Color := clBtnFace;
R := ClientRect;
FillRect(R);
end;
end;
procedure TbsSkinCustomControl.ChangeSkinData;
var
W, H: Integer;
UpDate: Boolean;
begin
GetSkinData;
W := Width;
H := Height;
if FIndex <> -1
then
begin
CalcSize(W, H);
Update := (W <> Width) or (H <> Height);
if W <> Width then Width := W;
if H <> Height then Height := H;
end
else
begin
UpDate := False;
if FDefaultWidth > 0 then Width := FDefaultWidth;
if FDefaultHeight > 0 then Height := FDefaultHeight;
end;
if (not UpDate) or (FIndex = -1)
then
begin
SetControlRegion;
RePaint;
end;
end;
procedure TbsSkinCustomControl.SetBounds;
var
UpDate: Boolean;
begin
GetSkinData;
UpDate := ((Width <> AWidth) or (Height <> AHeight)) and (FIndex <> -1);
if UpDate
then
begin
CalcSize(AWidth, AHeight);
if ResizeMode = 0 then NewClRect := ClRect;
end;
inherited;
if UpDate
then
begin
SetControlRegion;
RePaint;
end;
end;
procedure TbsSkinCustomControl.CalcSize;
var
XO, YO: Integer;
begin
if ResizeMode > 0
then
begin
XO := W - RectWidth(SkinRect);
YO := H - RectHeight(SkinRect);
NewLTPoint := LTPt;
case ResizeMode of
1:
begin
NewRTPoint := Point(RTPt.X + XO, RTPt.Y);
NewLBPoint := Point(LBPt.X, LBPt.Y + YO);
NewRBPoint := Point(RBPt.X + XO, RBPt.Y + YO);
NewClRect := Rect(CLRect.Left, ClRect.Top,
CLRect.Right + XO, ClRect.Bottom + YO);
end;
2:
begin
H := RectHeight(SkinRect);
NewRTPoint := Point(RTPt.X + XO, RTPt.Y );
NewClRect := ClRect;
Inc(NewClRect.Right, XO);
end;
3:
begin
W := RectWidth(SkinRect);
NewLBPoint := Point(LBPt.X, LBPt.Y + YO);
NewClRect := ClRect;
Inc(NewClRect.Bottom, YO);
end;
end;
end
else
if (FIndex <> -1) and (ResizeMode = 0)
then
begin
W := RectWidth(SkinRect);
H := RectHeight(SkinRect);
NewClRect := CLRect;
end;
end;
procedure TbsSkinCustomControl.CreateControlSkinImage;
begin
CreateSkinControlImage(B, Picture, SkinRect);
end;
procedure TbsSkinCustomControl.CreateSkinControlImage;
begin
case ResizeMode of
0:
begin
B.Width := RectWidth(R);
B.Height := RectHeight(R);
B.Canvas.CopyRect(Rect(0, 0, B.Width, B.Height), SB.Canvas, R);
end;
1: CreateSkinImage(LTPt, RTPt, LBPt, RBPt, CLRect,
NewLtPoint, NewRTPoint, NewLBPoint, NewRBPoint, NewCLRect,
B, SB, R, Width, Height, True);
2: CreateHSkinImage(LTPt.X, RectWidth(SkinRect) - RTPt.X,
B, SB, R, Width, Height);
3: CreateVSkinImage(LTPt.Y, RectHeight(SkinRect) - LBPt.Y,
B, SB, R, Width, Height);
end;
end;
function TbsSkinCustomControl.GetResizeMode;
begin
if IsNullRect(SkinRect)
then
Result := -1
else
if (RBPt.X <> 0) and (RBPt.Y <> 0)
then
Result := 1
else
if (RTPt.X <> 0) or (RTPT.Y <> 0)
then
Result := 2
else
if (LBPt.X <> 0) or (LBPt.Y <> 0)
then
Result := 3
else
Result := 0;
end;
function TbsSkinCustomControl.GetNewRect;
var
XO, YO: Integer;
LeftTop, LeftBottom, RightTop, RightBottom: TRect;
function CorrectResizeRect: TRect;
var
NR: TRect;
begin
NR := R;
if PointInRect(LeftTop, R.TopLeft) and
PointInRect(RightBottom, R.BottomRight)
then
begin
Inc(NR.Right, XO);
Inc(NR.Bottom, YO);
end
else
if PointInRect(LeftTop, R.TopLeft) and
PointInRect(RightTop, R.BottomRight)
then
Inc(NR.Right, XO)
else
if PointInRect(LeftBottom, R.TopLeft) and
PointInRect(RightBottom, R.BottomRight)
then
begin
Inc(NR.Right, XO);
OffsetRect(NR, 0, YO);
end
else
if PointInRect(LeftTop, R.TopLeft) and
PointInRect(LeftBottom, R.BottomRight)
then
Inc(NR.Bottom, YO)
else
if PointInRect(RightTop, R.TopLeft) and
PointInRect(RightBottom, R.BottomRight)
then
begin
OffsetRect(NR, XO, 0);
Inc(NR.Bottom, YO);
end;
Result := NR;
end;
begin
XO := Width - RectWidth(SkinRect);
YO := Height - RectHeight(SkinRect);
Result := R;
case ResizeMode of
1:
begin
LeftTop := Rect(0, 0, LTPt.X, LTPt.Y);
LeftBottom := Rect(0, LBPt.Y, LBPt.X, RectHeight(SkinRect));
RightTop := Rect(RTPt.X, 0, RectWidth(SkinRect), RTPt.Y);
RightBottom := Rect(RBPt.X, RBPt.Y,
RectWidth(SkinRect), RectHeight(SkinRect));
Result := R;
if RectInRect(R, LeftTop)
then Result := R
else
if RectInRect(R, RightTop)
then OffsetRect(Result, XO, 0)
else
if RectInRect(R, LeftBottom)
then OffsetRect(Result, 0, YO)
else
if RectInRect(R, RightBottom)
then
OffsetRect(Result, XO, YO)
else
Result := CorrectResizeRect;
end;
2:
begin
if (R.Left <= LTPt.X) and (R.Right >= RTPt.X)
then
Inc(Result.Right, XO)
else
if (R.Left >= RTPt.X) and (R.Right > RTPt.X)
then
OffsetRect(Result, XO, 0);
end;
3:
begin
if (R.Top <= LTPt.Y) and (R.Bottom >= LBPt.Y)
then
Inc(Result.Bottom, YO)
else
if (R.Top >= LBPt.Y) and (R.Bottom > LBPt.X)
then
OffsetRect(Result, 0, YO);
end;
end;
end;
procedure TbsSkinCustomControl.GetSkinData;
begin
inherited;
if FIndex <> -1
then
if TbsDataSkinControl(FSD.CtrlList.Items[FIndex]) is TbsDataSkinCustomControl
then
with TbsDataSkinCustomControl(FSD.CtrlList.Items[FIndex]) do
begin
LTPt := LTPoint;
RTPt := RTPoint;
LBPt := LBPoint;
RBPt := RBPoint;
Self.SkinRect := SkinRect;
Self.ClRect := ClRect;
if (PictureIndex <> -1) and (PictureIndex < FSD.FActivePictures.Count)
then
Picture := TBitMap(FSD.FActivePictures.Items[PictureIndex])
else
Picture := nil;
if (MaskPictureIndex <> -1) and (MaskPictureIndex < FSD.FActivePictures.Count)
then
MaskPicture := TBitMap(FSD.FActivePictures.Items[MaskPictureIndex])
else
MaskPicture := nil;
ResizeMode := GetResizeMode;
end
else
begin
ResizeMode := 0;
Picture := nil;
MaskPicture := nil;
end;
end;
procedure TbsSkinCustomControl.CreateControlRegion;
var
TempRgn: HRGN;
Offset: Integer;
begin
TempRgn := FRgn;
case ResizeMode of
0:
CreateSkinSimplyRegion(FRgn, MaskPicture);
1:
CreateSkinRegion
(FRgn, LTPt, RTPt, LBPt, RBPt, ClRect,
NewLtPoint, NewRTPoint, NewLBPoint, NewRBPoint, NewClRect,
MaskPicture, Width, Height);
2:
begin
Offset := Width - RectWidth(SkinRect);
CreateSkinRegion(FRgn,
LTPt, RTPt, LTPt, RTPt, ClRect,
LTPt, Point(RTPt.X + Offset, RTPt.Y),
LTPt, Point(RTPt.X + Offset, RTPt.Y), NewClRect,
MaskPicture, Width, Height);
end;
3:
begin
Offset := Height - RectHeight(SkinRect);
CreateSkinRegion(FRgn,
LTPt, LTPt, LBPt, LBPt, ClRect,
LTPt, LTPt,
Point(LBPt.X, LBPt.Y + Offset),
Point(LBPt.X, LBPt.Y + Offset), NewClRect,
MaskPicture, Width, Height);
end;
end;
SetWindowRgn(Handle, FRgn, True);
if TempRgn <> 0 then DeleteObject(TempRgn);
end;
procedure TbsSkinCustomControl.SetControlRegion;
begin
if ((MaskPicture = nil) or (FIndex = -1)) and (FRgn <> 0)
then
begin
SetWindowRgn(Handle, 0, True);
DeleteObject(FRgn);
FRgn := 0;
end
else
if (MaskPicture <> nil) and (FIndex <> -1)
then CreateControlRegion;
end;
//=========== TbsSkinButton ===============
constructor TbsSkinButton.Create;
begin
inherited;
RepeatTimer := nil;
FRepeatMode := False;
FRepeatInterval := 100;
TabStop := True;
FActive := False;
MorphTimer := nil;
FAllowAllUp := False;
FAllowAllUpCheck := False;
FSkinDataName := 'button';
FCanFocused := True;
FDown := False;
FMouseDown := False;
FMouseIn := False;
Width := 75;
Height := 25;
FGroupIndex := 0;
FGlyph := TBitMap.Create;
FNumGlyphs := 1;
FMargin := -1;
FSpacing := 1;
FLayout := blGlyphLeft;
FMorphKf := 0;
end;
destructor TbsSkinButton.Destroy;
begin
FGlyph.Free;
StopMorph;
if RepeatTimer <> nil then RepeatTimer.Free;
RepeatTimer := nil;
inherited;
end;
procedure TbsSkinButton.Click;
begin
if ActionLink = nil then inherited;
end;
procedure TbsSkinButton.RepeatTimerProc;
begin
ButtonClick;
end;
procedure TbsSkinButton.StartRepeat;
begin
if RepeatTimer <> nil then RepeatTimer.Free;
RepeatTimer := TTimer.Create(Self);
RepeatTimer.Enabled := False;
RepeatTimer.OnTimer := RepeatTimerProc;
RepeatTimer.Interval := FRepeatInterval;
RepeatTimer.Enabled := True;
end;
procedure TbsSkinButton.StopRepeat;
begin
if RepeatTimer = nil then Exit;
RepeatTimer.Enabled := False;
RepeatTimer.Free;
RepeatTimer := nil;
end;
procedure TbsSkinButton.StartMorph;
begin
if MorphTimer <> nil then Exit;
MorphTimer := TTimer.Create(Self);
MorphTimer.Interval := MorphTimerInterval;
MorphTimer.OnTimer := DoMorph;
MorphTimer.Enabled := True;
end;
procedure TbsSkinButton.StopMorph;
begin
if MorphTimer = nil then Exit;
MorphTimer.Free;
MorphTimer := nil;
end;
procedure TbsSkinButton.DoMorph;
begin
if (FIndex = -1) or not Morphing
then
begin
if (FMouseIn or IsFocused) then FMorphKf := 1 else FMorphKf := 0;
StopMorph;
end
else
if (FMouseIn or IsFocused) and (FMorphKf < 1)
then
begin
FMorphKf := FMorphKf + MorphInc;
RePaint;
end
else
if not (FMouseIn or IsFocused) and (FMorphKf > 0)
then
begin
FMorphKf := FMorphKf - MorphInc;
RePaint;
end
else
begin
if (FMouseIn or IsFocused) then FMorphKf := 1 else FMorphKf := 0;
StopMorph;
RePaint;
end;
end;
procedure TbsSkinButton.ReDrawControl;
begin
if Morphing and (FIndex <> -1)
then StartMorph
else RePaint;
end;
procedure TbsSkinButton.SetDefault(Value: Boolean);
var
Form: TCustomForm;
begin
FDefault := Value;
if HandleAllocated and FCanFocused
then
begin
Form := GetParentForm(Self);
if Form <> nil then
Form.Perform(CM_FOCUSCHANGED, 0, Longint(Form.ActiveControl));
end;
end;
procedure TbsSkinButton.CMDialogKey(var Message: TCMDialogKey);
begin
with Message do
if FActive and (CharCode = VK_RETURN) and Enabled
then
begin
ButtonClick;
Result := 1;
end
else
if (CharCode = VK_ESCAPE) and FCancel and FCanFocused and
(KeyDataToShiftState(Message.KeyData) = []) and CanFocus
then
begin
ButtonClick;
Result := 1;
end
else
inherited;
end;
procedure TbsSkinButton.CreateWnd;
begin
inherited CreateWnd;
FActive := FDefault;
end;
procedure TbsSkinButton.CMFocusChanged(var Message: TCMFocusChanged);
begin
with Message do
if Sender is TbsSkinButton then
FActive := Sender = Self
else
FActive := FDefault;
if CanFocused and FDefault
then
if (Message.Sender <> Self) and (Message.Sender is TbsSkinButton) and
FMouseIn
then
begin
FMouseIn := False;
ReDrawControl;
end
else
if (Message.Sender <> Self) and not (Message.Sender is TbsSkinButton) and
not FMouseIn
then
begin
if Morphing then FMorphKf := 1;
FMouseIn := True;
ReDrawControl;
end;
inherited;
end;
procedure TbsSkinButton.ButtonClick;
var
Form: TCustomForm;
begin
if FCanFocused
then
begin
Form := GetParentForm(Self);
if Form <> nil then Form.ModalResult := ModalResult;
end;
{ Call OnClick if assigned and not equal to associated action's OnExecute.
If associated action's OnExecute assigned then call it, otherwise, call
OnClick. }
if Assigned(FOnClick) and (Action <> nil) and (@FOnClick <> @Action.OnExecute)
then
FOnClick(Self)
else
if not (csDesigning in ComponentState) and (ActionLink <> nil)
then
ActionLink.Execute
else
if Assigned(FOnClick) then FOnClick(Self);
// if Assigned(FOnClick) then FOnClick(Self);
end;
procedure TbsSkinButton.CMEnabledChanged;
begin
inherited;
if Morphing
then
begin
StopMorph;
FMorphKf := 0;
end;
FMouseIn := False;
RePaint;
end;
procedure TbsSkinButton.ChangeSkinData;
begin
StopMorph;
FMorphKf := 0;
inherited;
if Morphing and (FIndex <> -1) and (IsFocused or FMouseIn)
then
FMorphKf := 1;
end;
procedure TbsSkinButton.SetGroupIndex;
begin
FGroupIndex := Value;
if FGroupIndex <> 0 then CanFocused := False;
end;
function TbsSkinButton.IsFocused;
begin
Result := Focused and FCanFocused;
end;
procedure TbsSkinButton.CMDialogChar;
begin
with Message do
if IsAccel(CharCode, Caption) and CanFocus and FCanFocused
then
begin
SetFocus;
ButtonClick;
Result := 1;
end
else
inherited;
end;
procedure TbsSkinButton.SetCanFocused;
begin
FCanFocused := Value;
if (csDesigning in ComponentState) and not
(csLoading in ComponentState)
then
TabStop := FCanFocused;
end;
procedure TbsSkinButton.WMSETFOCUS;
begin
inherited;
if FCanFocused then ReDrawControl;
end;
procedure TbsSkinButton.WMKILLFOCUS;
begin
if FRepeatMode and (RepeatTimer <> nil) then StopRepeat;
if (GroupIndex = 0) and FDown then FDown := False;
inherited;
if FCanFocused then ReDrawControl;
end;
procedure TbsSkinButton.WndProc(var Message: TMessage);
begin
if FCanFocused then
case Message.Msg of
WM_KEYDOWN:
if TWMKEYDOWN(Message).CharCode = VK_SPACE
then
begin
Down := True;
if FRepeatMode then ButtonClick;
end
else
if TWMKEYDOWN(Message).CharCode = VK_RETURN
then
begin
ButtonClick;
end;
WM_KEYUP:
if TWMKEYUP(Message).CharCode = VK_SPACE
then
begin
Down := False;
ButtonClick;
end;
WM_LBUTTONDOWN, WM_LBUTTONDBLCLK:
if not (csDesigning in ComponentState) and not Focused then
begin
FClicksDisabled := True;
Windows.SetFocus(Handle);
FClicksDisabled := False;
if not Focused then Exit;
end;
CN_COMMAND:
if FClicksDisabled then Exit;
end;
inherited WndProc(Message);
end;
procedure TbsSkinButton.ActionChange(Sender: TObject; CheckDefaults: Boolean);
procedure CopyImage(ImageList: TCustomImageList; Index: Integer);
begin
with FGlyph do
begin
Width := ImageList.Width;
Height := ImageList.Height;
Canvas.Brush.Color := clFuchsia;
Canvas.FillRect(Rect(0, 0, Width, Height));
ImageList.Draw(Canvas, 0, 0, Index);
end;
end;
begin
inherited ActionChange(Sender, CheckDefaults);
if Sender is TCustomAction then
with TCustomAction(Sender) do
begin
if (FGlyph.Empty) and (ActionList <> nil) and (ActionList.Images <> nil) and
(ImageIndex >= 0) and (ImageIndex < ActionList.Images.Count) then
begin
CopyImage(ActionList.Images, ImageIndex);
RePaint;
end;
end;
end;
procedure TbsSkinButton.SetLayout;
begin
if FLayout <> Value
then
begin
FLayout := Value;
RePaint;
end;
end;
procedure TbsSkinButton.SetSpacing;
begin
if Value <> FSpacing
then
begin
FSpacing := Value;
RePaint;
end;
end;
procedure TbsSkinButton.SetMargin;
begin
if (Value <> FMargin) and (Value >= -1)
then
begin
FMargin := Value;
RePaint;
end;
end;
procedure TbsSkinButton.SetDown;
begin
FDown := Value;
if Morphing
then
begin
FMorphKf := 1;
if not FDown then StartMorph else StopMorph;
end;
RePaint;
if (GroupIndex <> 0) and FDown and not FAllowAllUp then DoAllUp;
end;
procedure TbsSkinButton.DoAllUp;
var
PC: TWinControl;
i: Integer;
begin
if Parent = nil then Exit;
PC := TWinControl(Parent);
for i := 0 to PC.ControlCount - 1 do
if (PC.Controls[i] is TbsSkinButton) and
(PC.Controls[i] <> Self)
then
with TbsSkinButton(PC.Controls[i]) do
if (GroupIndex = Self.GroupIndex) and
(GroupIndex <> 0) and FDown
then
Down := False;
end;
procedure TbsSkinButton.SetGlyph;
begin
FGlyph.Assign(Value);
RePaint;
end;
procedure TbsSkinButton.SetNumGlyphs;
begin
FNumGlyphs := Value;
RePaint;
end;
procedure TbsSkinButton.GetSkinData;
begin
inherited;
if FIndex <> -1
then
begin
if TbsDataSkinControl(FSD.CtrlList.Items[FIndex]) is TbsDataSkinButtonControl
then
with TbsDataSkinButtonControl(FSD.CtrlList.Items[FIndex]) do
begin
Self.FontName := FontName;
Self.FontColor := FontColor;
Self.ActiveFontColor := ActiveFontColor;
Self.DownFontColor := DownFontColor;
Self.FontStyle := FontStyle;
Self.FontHeight := FontHeight;
Self.ActiveSkinRect := ActiveSkinRect;
Self.DownSkinRect := DownSkinRect;
if IsNullRect(ActiveSkinRect) then Self.ActiveSkinRect := SkinRect;
if IsNullRect(DownSkinRect) then Self.DownSkinRect := Self.ActiveSkinRect;
Self.DisabledSkinRect := DisabledSkinRect;
Self.DisabledFontColor := DisabledFontColor;
Self.Morphing := Morphing;
Self.MorphKind := MorphKind;
end;
end;
end;
function TbsSkinButton.GetGlyphNum;
begin
if AIsDown and AIsMouseIn and (FNumGlyphs > 2)
then
Result := 3
else
if AIsMouseIn and (FNumGlyphs > 3)
then
Result := 4
else
if not Enabled and (FNumGlyphs > 1)
then
Result := 2
else
Result := 1;
end;
procedure TbsSkinButton.CreateButtonImage;
begin
CreateSkinControlImage(B, Picture, R);
if not FUseSkinFont
then
B.Canvas.Font.Assign(FDefaultFont)
else
with B.Canvas.Font do
begin
Name := FontName;
Height := FontHeight;
Style := FontStyle;
end;
with B.Canvas.Font do
begin
if (SkinData <> nil) and (SkinData.ResourceStrData <> nil)
then
Charset := SkinData.ResourceStrData.CharSet
else
CharSet := FDefaultFont.Charset;
if not Enabled
then
Color := DisabledFontColor
else
if ADown and AMouseIn
then
Color := DownFontColor
else
if AMouseIn
then Color := ActiveFontColor
else Color := FontColor;
end;
DrawGlyphAndText(B.Canvas,
NewClRect, FMargin, FSpacing, FLayout,
Caption, FGlyph, FNumGlyphs, GetGlyphNum(ADown, AMouseIn), ADown and AMouseIn);
end;
procedure TbsSkinButton.CreateControlDefaultImage;
var
R: TRect;
IsDown: Boolean;
begin
IsDown := False;
R := ClientRect;
if FDown and (((FMouseIn or (IsFocused and not FMouseDown)) and
(GroupIndex = 0)) or (GroupIndex <> 0))
then
begin
Frame3D(B.Canvas, R, BS_XP_BTNFRAMECOLOR, BS_XP_BTNFRAMECOLOR, 1);
B.Canvas.Brush.Color := BS_XP_BTNDOWNCOLOR;
B.Canvas.FillRect(R);
IsDown := True;
end
else
if FMouseIn or IsFocused
then
begin
Frame3D(B.Canvas, R, BS_XP_BTNFRAMECOLOR, BS_XP_BTNFRAMECOLOR, 1);
B.Canvas.Brush.Color := BS_XP_BTNACTIVECOLOR;
B.Canvas.FillRect(R);
end
else
begin
Frame3D(B.Canvas, R, clBtnShadow, clBtnShadow, 1);
B.Canvas.Brush.Color := clBtnFace;
B.Canvas.FillRect(R);
end;
B.Canvas.Font.Assign(FDefaultFont);
if (SkinData <> nil) and (SkinData.ResourceStrData <> nil)
then
B.Canvas.Font.Charset := SkinData.ResourceStrData.CharSet;
if not Enabled then B.Canvas.Font.Color := clBtnShadow;
DrawGlyphAndText(B.Canvas,
ClientRect, FMargin, FSpacing, FLayout,
Caption, FGlyph, FNumGlyphs, GetGlyphNum(FDown, FMouseIn), IsDown);
end;
procedure TbsSkinButton.CreateControlSkinImage;
begin
end;
procedure TbsSkinButton.Paint;
var
Buffer, ABuffer: TBitMap;
PBuffer, APBuffer: TbsEffectBmp;
begin
GetSkinData;
if FIndex = -1
then
inherited
else
begin
Buffer := TBitMap.Create;
Buffer.Width := Width;
Buffer.Height := Height;
if Morphing and (FMorphKf < 1) and (FMorphKf > 0) and Enabled
then
begin
ABuffer := TBitMap.Create;
ABuffer.Width := Width;
ABuffer.Height := Height;
CreateButtonImage(Buffer, SkinRect, False, False);
CreateButtonImage(ABuffer, ActiveSkinRect, False, True);
PBuffer := TbsEffectBmp.CreateFromhWnd(Buffer.Handle);
APBuffer := TbsEffectBmp.CreateFromhWnd(ABuffer.Handle);
case MorphKind of
mkDefault: PBuffer.Morph(APBuffer, FMorphKf);
mkGradient: PBuffer.MorphGrad(APBuffer, FMorphKf);
mkLeftGradient: PBuffer.MorphLeftGrad(APBuffer, FMorphKf);
mkRightGradient: PBuffer.MorphRightGrad(APBuffer, FMorphKf);
mkLeftSlide: PBuffer.MorphLeftSlide(APBuffer, FMorphKf);
mkRightSlide: PBuffer.MorphRightSlide(APBuffer, FMorphKf);
mkPush: PBuffer.MorphPush(APBuffer, FMorphKf);
end;
PBuffer.Draw(Canvas.Handle, 0, 0);
PBuffer.Free;
APBuffer.Free;
ABuffer.Free;
Buffer.Free;
end
else
begin
if (not Enabled) and not IsNullRect(DisabledSkinRect)
then
CreateButtonImage(Buffer, DisabledSkinRect, False, False)
else
if FDown and (((FMouseIn or (IsFocused and not FMouseDown)) and
(GroupIndex = 0)) or (GroupIndex <> 0))
then
CreateButtonImage(Buffer, DownSkinRect, True, True)
else
if (IsFocused or FMouseIn) or (not (IsFocused or FMouseIn) and
Morphing and (FMorphKf = 1))
then
CreateButtonImage(Buffer, ActiveSkinRect, False, True)
else
CreateButtonImage(Buffer, SkinRect, False, False);
Canvas.Draw(0, 0, Buffer);
Buffer.Free;
end;
end;
end;
procedure TbsSkinButton.CMTextChanged;
begin
inherited;
RePaint;
end;
procedure TbsSkinButton.CMMouseEnter(var Message: TMessage);
var
CanPaint: Boolean;
begin
inherited;
if (csDesigning in ComponentState) then Exit;
FMouseIn := True;
if GroupIndex <> 0
then
CanPaint := not FDown
else
CanPaint := not IsFocused or FDown;
if CanPaint
then
begin
if FDown
then
begin
if Morphing then FMorphKf := 1;
RePaint;
end
else
ReDrawControl;
end;
if FDown and FRepeatMode and (GroupIndex = 0) then StartRepeat;
end;
procedure TbsSkinButton.CMMouseLeave(var Message: TMessage);
var
CanPaint: Boolean;
begin
inherited;
if (csDesigning in ComponentState) then Exit;
if not (FCanFocused and FDefault and FActive and not Focused)
then
FMouseIn := False;
if GroupIndex <> 0
then
CanPaint := not FDown
else
CanPaint := not IsFocused or FDown;
if CanPaint
then ReDrawControl;
if FDown and FRepeatMode and (RepeatTimer <> nil) and (GroupIndex = 0) then StopRepeat;
end;
procedure TbsSkinButton.MouseDown;
begin
inherited;
if Button = mbLeft
then
begin
FMouseDown := True;
if not FDown
then
begin
FMouseIn := True;
Down := True;
if FRepeatMode and (GroupIndex = 0)
then
StartRepeat
else
if (GroupIndex <> 0) then ButtonClick;
FAllowAllUpCheck := False;
end
else
if (GroupIndex <> 0) then FAllowAllUpCheck := True;
end;
end;
procedure TbsSkinButton.MouseUp;
begin
if Button = mbLeft
then
begin
FMouseDown := False;
if GroupIndex = 0
then
begin
if FMouseIn
then
begin
Down := False;
if FRepeatMode and (RepeatTimer <> nil) then StopRepeat;
ButtonClick;
end
else
begin
FDown := False;
if FRepeatMode and (RepeatTimer <> nil) then StopRepeat;
end;
end
else
if (GroupIndex <> 0) and FDown and FAllowAllUp and
FAllowAllUpCheck and FMouseIn
then
begin
Down := False;
ButtonClick;
end;
end;
if HandleAllocated and Visible then inherited;
end;
//==============TbsSkinMenuButton==========//
constructor TbsSkinMenuButton.Create;
begin
inherited;
FSkinDataName := 'toolmenubutton';
FTrackButtonMode := False;
FMenuTracked := False;
FSkinPopupMenu := nil;
end;
destructor TbsSkinMenuButton.Destroy;
begin
inherited;
end;
procedure TbsSkinMenuButton.CreateButtonImage;
begin
if FMenuTracked and FTrackButtonMode and
not IsNullRect(TrackButtonRect) and not IsNullRect(DownSkinRect)
then
begin
inherited CreateButtonImage(B, ActiveSkinRect, False, True);
R := TrackButtonRect;
OffsetRect(R, DownSkinRect.Left, DownSkinRect.Top);
B.Canvas.CopyRect(GetNewTrackButtonRect, Picture.Canvas,
R);
end
else
inherited;
end;
procedure TbsSkinMenuButton.CreateControlDefaultImage;
var
R, R1: TRect;
isDown: Boolean;
begin
IsDown := False;
if FTrackButtonMode
then
begin
R := Rect(0, 0, Width - 15, Height);
R1 := Rect(Width - 15, 0, Width, Height);
if FMenuTracked
then
begin
Frame3D(B.Canvas, R, BS_XP_BTNFRAMECOLOR, BS_XP_BTNFRAMECOLOR, 1);
B.Canvas.Brush.Color := BS_XP_BTNACTIVECOLOR;
B.Canvas.FillRect(R);
Frame3D(B.Canvas, R1, BS_XP_BTNFRAMECOLOR, BS_XP_BTNFRAMECOLOR, 1);
B.Canvas.Brush.Color := BS_XP_BTNDOWNCOLOR;
B.Canvas.FillRect(R1);
end
else
begin
if FDown and FMouseIn
then
begin
Frame3D(B.Canvas, R, BS_XP_BTNFRAMECOLOR, BS_XP_BTNFRAMECOLOR, 1);
B.Canvas.Brush.Color := BS_XP_BTNDOWNCOLOR;
B.Canvas.FillRect(R);
Frame3D(B.Canvas, R1, BS_XP_BTNFRAMECOLOR, BS_XP_BTNFRAMECOLOR, 1);
B.Canvas.Brush.Color := BS_XP_BTNDOWNCOLOR;
B.Canvas.FillRect(R1);
isDown := True;
end
else
if FMouseIn or IsFocused
then
begin
Frame3D(B.Canvas, R, BS_XP_BTNFRAMECOLOR, BS_XP_BTNFRAMECOLOR, 1);
B.Canvas.Brush.Color := BS_XP_BTNACTIVECOLOR;
B.Canvas.FillRect(R);
Frame3D(B.Canvas, R1, BS_XP_BTNFRAMECOLOR, BS_XP_BTNFRAMECOLOR, 1);
B.Canvas.Brush.Color := BS_XP_BTNACTIVECOLOR;
B.Canvas.FillRect(R1);
end
else
begin
Frame3D(B.Canvas, R, clBtnShadow, clBtnShadow, 1);
B.Canvas.Brush.Color := clBtnFace;
B.Canvas.FillRect(R);
Frame3D(B.Canvas, R1, clBtnShadow, clBtnShadow, 1);
B.Canvas.Brush.Color := clBtnFace;
B.Canvas.FillRect(R1);
end;
end;
end
else
begin
R := Rect(0, 0, Width, Height);
if FDown and FMouseIn
then
begin
Frame3D(B.Canvas, R, BS_XP_BTNFRAMECOLOR, BS_XP_BTNFRAMECOLOR, 1);
B.Canvas.Brush.Color := BS_XP_BTNDOWNCOLOR;
B.Canvas.FillRect(R);
end
else
if FMouseIn or IsFocused
then
begin
Frame3D(B.Canvas, R, BS_XP_BTNFRAMECOLOR, BS_XP_BTNFRAMECOLOR, 1);
B.Canvas.Brush.Color := BS_XP_BTNACTIVECOLOR;
B.Canvas.FillRect(R);
end
else
begin
Frame3D(B.Canvas, R, clBtnShadow, clBtnShadow, 1);
B.Canvas.Brush.Color := clBtnFace;
B.Canvas.FillRect(R);
end;
end;
R := ClientRect;
Dec(R.Right, 15);
B.Canvas.Font.Assign(FDefaultFont);
if (SkinData <> nil) and (SkinData.ResourceStrData <> nil)
then
B.Canvas.Font.Charset := SkinData.ResourceStrData.CharSet;
DrawGlyphAndText(B.Canvas, R, FMargin, FSpacing, FLayout,
Caption, FGlyph, FNumGlyphs, 1, isDown);
R.Left := Width - 15;
Inc(R.Right, 15);
if (FDown and FMouseIn) or FMenuTracked
then
begin
Inc(R.Top, 2);
Inc(R.Left, 2);
end;
DrawTrackArrowImage(B.Canvas, R, clBtnText);
end;
procedure TbsSkinMenuButton.CMDialogChar;
begin
if not FTrackButtonMode and CanMenuTrack(0, 0)
then
begin
with Message do
if IsAccel(CharCode, Caption) and CanFocus and FCanFocused
then
begin
SetFocus;
FMenuTracked := True;
Down := True;
TrackMenu;
Result := 1;
end
else
inherited;
end
else
inherited;
end;
procedure TbsSkinMenuButton.WndProc;
var
FOld: Boolean;
begin
FOld := True;
if FCanFocused then
case Message.Msg of
WM_KEYDOWN:
if TWMKEYDOWN(Message).CharCode = VK_SPACE
then
begin
if not FTrackButtonMode and CanMenuTrack(0, 0)
then
begin
FMenuTracked := True;
Down := True;
TrackMenu;
FOld := False;
end;
end;
WM_KEYUP:
if (TWMKEYUP(Message).CharCode = VK_SPACE) and not FMenuTracked
then
begin
Down := False;
if Assigned(FOnClick) then FOnClick(Self);
FOld := False;
end
else
if (TWMKEYUP(Message).CharCode = VK_RETURN) and not FMenuTracked
then
begin
if Assigned(FOnClick) then FOnClick(Self);
end
end;
if FOld then inherited;
end;
function TbsSkinMenuButton.GetNewTrackButtonRect;
var
RM, Off: Integer;
R: TRect;
begin