Delphi控件源码

开发平台：

Delphi

bsSkinBoxCtrls.pas：源码内容

{*******************************************************************}
{ }
{ Almediadev Visual Component Lifbrary }
{ BusinessSkinForm }
{ Version 1.98 }
{ }
{ }
{ Home: http://www.almdev.com }
{ Support: support@almdev.com }
{ }
{*******************************************************************}
unit bsSkinBoxCtrls;
{$P+,S-,W-,R-}
{$WARNINGS OFF}
{$HINTS OFF}
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Menus, ExtCtrls, bsSkinData, StdCtrls, bsSkinCtrls, CommCtrl, ComCtrls, Mask,
ImgList, bsCalendar;
type
TbsDrawSkinItemEvent = procedure(Cnvs: TCanvas; Index: Integer;
ItemWidth, ItemHeight: Integer; TextRect: TRect; State: TOwnerDrawState) of object;
TbsCBButtonX = record
R: TRect;
MouseIn: Boolean;
Down: Boolean;
end;
TbsOnEditCancelMode = procedure(C: TControl) of object;
TbsCustomEdit = class(TCustomMaskEdit)
protected
FOnUp: TNotifyEvent;
FOnDown: TNotifyEvent;
FOnKillFocus: TNotifyEvent;
FOnEditCancelMode: TbsOnEditCancelMode;
FDown: Boolean;
FReadOnly: Boolean;
FEditTransparent: Boolean;
procedure SetEditTransparent(Value: Boolean);
procedure WMSETFOCUS(var Message: TMessage); message WM_SETFOCUS;
procedure WMKILLFOCUS(var Message: TMessage); message WM_KILLFOCUS;
procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
procedure CNCtlColorEdit(var Message:TWMCTLCOLOREDIT); message CN_CTLCOLOREDIT;
procedure CreateParams(var Params: TCreateParams); override;
procedure Change; override;
procedure WMCHAR(var Message:TWMCHAR); message WM_CHAR;
procedure WMSetText(var Message:TWMSetText); message WM_SETTEXT;
procedure WMKeyDown(var Message: TWMKeyDown); message WM_KEYDOWN;
procedure WMKeyUp(var Message: TWMKeyUp); message WM_KEYUP;
procedure WMMove(var Message: TMessage); message WM_MOVE;
procedure WMCut(var Message: TMessage); message WM_Cut;
procedure WMPaste(var Message: TMessage); message WM_PASTE;
procedure WMClear(var Message: TMessage); message WM_CLEAR;
procedure WMUndo(var Message: TMessage); message WM_UNDO;
procedure WMLButtonDown(var Message: TMessage); message WM_LBUTTONDOWN;
procedure WMLButtonUp(var Message: TMessage); message WM_LBUTTONUP;
procedure WMMOUSEMOVE(var Message: TMessage); message WM_MOUSEMOVE;
procedure WMSetFont(var Message: TWMSetFont); message WM_SETFONT;
procedure CMCancelMode(var Message: TCMCancelMode); message CM_CANCELMODE;
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
procedure Invalidate; override;
property ReadOnly read FReadOnly write FReadOnly;
property EditTransparent: Boolean read FEditTransparent write SetEditTransparent;
property OnUp: TNotifyEvent read FOnUp write FOnUp;
property OnDown: TNotifyEvent read FOnDown write FOnDown;
property OnEditCancelMode: TbsOnEditCancelMode
read FOnEditCancelMode write FOnEditCancelMode;
published
{ Published declarations }
end;
TbsSkinNumEdit = class(TbsCustomEdit)
protected
FOnUpClick: TNotifyEvent;
FOnDownClick: TNotifyEvent;
FEditorEnabled: Boolean;
function IsValidChar(Key: Char): Boolean;
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
procedure KeyPress(var Key: Char); override;
procedure WMMOUSEWHEEL(var Message: TMessage); message WM_MOUSEWHEEL;
public
Float: Boolean;
constructor Create(AOwner: TComponent);
property OnUpClick: TNotifyEvent read FOnUpClick write FOnUpClick;
property OnDownClick: TNotifyEvent read FOnDownClick write FOnDownClick;
property EditorEnabled: Boolean read FEditorEnabled write FEditorEnabled default True;
end;
TbsSkinCustomEdit = class(TbsCustomEdit)
protected
FOnButtonClick: TNotifyEvent;
FButtonRect: TRect;
FButtonMode: Boolean;
FButtonDown: Boolean;
FButtonActive: Boolean;
FEditRect: TRect;
FMouseIn: Boolean;
FIndex: Integer;
FSD: TbsSkinData;
FSkinDataName: String;
Picture: TBitMap;
FOnMouseEnter, FOnMouseLeave: TNotifyEvent;
FDefaultFont: TFont;
FUseSkinFont: Boolean;
FDefaultWidth: Integer;
FDefaultHeight: Integer;
FAlignment: TAlignment;
procedure SetAlignment(Value: TAlignment);
procedure SetDefaultWidth(Value: Integer);
procedure SetDefaultHeight(Value: Integer);
procedure OnDefaultFontChange(Sender: TObject);
procedure SetDefaultFont(Value: TFont);
procedure CalcRects;
procedure SetButtonMode(Value: Boolean);
procedure SetPasswordChar(Value: Char);
function GetPasswordChar: Char;
procedure SetSkinData(Value: TbsSkinData); virtual;
procedure Notification(AComponent: TComponent;
Operation: TOperation); override;
procedure GetSkinData;
procedure CreateParams(var Params: TCreateParams); override;
procedure WMNCCALCSIZE(var Message: TWMNCCalcSize); message WM_NCCALCSIZE;
procedure WMNCPAINT(var Message: TMessage); message WM_NCPAINT;
procedure WMNCLBUTTONDOWN(var Message: TWMNCLBUTTONDOWN); message WM_NCLBUTTONDOWN;
procedure WMNCLBUTTONDBCLK(var Message: TWMNCLBUTTONDOWN); message WM_NCLBUTTONDBLCLK;
procedure WMNCLBUTTONUP(var Message: TWMNCLBUTTONUP); message WM_NCLBUTTONUP;
procedure WMNCMOUSEMOVE(var Message: TWMNCMOUSEMOVE); message WM_NCMOUSEMOVE;
procedure WMMOUSEMOVE(var Message: TWMNCMOUSEMOVE); message WM_MOUSEMOVE;
procedure WMNCHITTEST(var Message: TWMNCHITTEST); message WM_NCHITTEST;
procedure WMSETFOCUS(var Message: TMessage); message WM_SETFOCUS;
procedure WMKILLFOCUS(var Message: TMessage); message WM_KILLFOCUS;
procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
public
//
LOffset, ROffset: Integer;
ClRect: TRect;
SkinRect, ActiveSkinRect: TRect;
FontName: String;
FontStyle: TFontStyles;
FontHeight: Integer;
FontColor, DisabledFontColor: TColor;
ActiveFontColor: TColor;
ButtonRect: TRect;
ActiveButtonRect: TRect;
DownButtonRect: TRect;
//
procedure DrawSkinEdit(C: TCanvas; ADrawText: Boolean);
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure ChangeSkinData; virtual;
procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
procedure Invalidate; override;
property BorderStyle;
//
property DefaultFont: TFont read FDefaultFont write SetDefaultFont;
property UseSkinFont: Boolean read FUseSkinFont write FUseSkinFont;
property DefaultWidth: Integer read FDefaultWidth write SetDefaultWidth;
property DefaultHeight: Integer read FDefaultHeight write SetDefaultHeight;
property ButtonMode: Boolean read FButtonMode write SetButtonMode;
property SkinData: TbsSkinData read FSD write SetSkinData;
property SkinDataName: String read FSkinDataName write FSkinDataName;
//
property EditPasswordChar: Char read GetPasswordChar write SetPasswordChar;
property OnMouseEnter: TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
property OnMouseLeave: TNotifyEvent read FOnMouseLeave write FOnMouseLeave;
property ReadOnly;
property Align;
property Alignment: TAlignment read FAlignment write SetAlignment default taLeftJustify;
property Font;
property Anchors;
property AutoSelect;
property BiDiMode;
property CharCase;
property Constraints;
property DragCursor;
property DragKind;
property DragMode;
property Enabled;
property HideSelection;
property ImeMode;
property ImeName;
property MaxLength;
property OEMConvert;
property ParentBiDiMode;
property ParentColor;
property ParentCtl3D;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ShowHint;
property TabOrder;
property TabStop;
property Text;
property Visible;
property OnButtonClick: TNotifyEvent read FOnButtonClick
write FOnButtonClick;
property OnChange;
property OnClick;
property OnDblClick;
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 OnStartDock;
property OnStartDrag;
end;
TbsSkinEdit = class(TbsSkinCustomEdit)
published
property DefaultFont;
property UseSkinFont;
property DefaultWidth;
property DefaultHeight;
property ButtonMode;
property SkinData;
property SkinDataName;
property EditPasswordChar;
property OnMouseEnter;
property OnMouseLeave;
property ReadOnly;
property Align;
property Alignment;
property Font;
property Anchors;
property AutoSelect;
property BiDiMode;
property CharCase;
property Constraints;
property DragCursor;
property DragKind;
property DragMode;
property Enabled;
property HideSelection;
property ImeMode;
property ImeName;
property MaxLength;
property OEMConvert;
property ParentBiDiMode;
property ParentColor;
property ParentCtl3D;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ShowHint;
property TabOrder;
property TabStop;
property Text;
property Visible;
property OnButtonClick;
property OnChange;
property OnClick;
property OnDblClick;
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 OnStartDock;
property OnStartDrag;
end;
TbsSkinMemo = class(TMemo)
protected
FBitMapBG: Boolean;
FReadOnly: Boolean;
FMouseIn: Boolean;
FIndex: Integer;
FSD: TbsSkinData;
FSkinDataName: String;
Picture: TBitMap;
FOnMouseEnter, FOnMouseLeave: TNotifyEvent;
FVScrollBar: TbsSkinScrollBar;
FDown: Boolean;
FDefaultFont: TFont;
FUseSkinFont: Boolean;
procedure OnDefaultFontChange(Sender: TObject);
procedure SetDefaultFont(Value: TFont);
procedure SkinNCPaint(C: TCanvas);
procedure SkinFramePaint(C: TCanvas);
procedure SetBitMapBG(Value: Boolean);
procedure UpDateScrollRange;
procedure SetVScrollBar(Value: TbsSkinScrollBar);
procedure OnVScrollBarChange(Sender: TObject);
procedure SetSkinData(Value: TbsSkinData);
procedure Notification(AComponent: TComponent;
Operation: TOperation); override;
procedure Change; override;
procedure GetSkinData;
procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
procedure CNCtlColorEdit(var Message:TWMCTLCOLOREDIT); message CN_CTLCOLOREDIT;
procedure WMCHAR(var Message:TMessage); message WM_CHAR;
procedure WMNCCALCSIZE(var Message: TWMNCCalcSize); message WM_NCCALCSIZE;
procedure CreateParams(var Params: TCreateParams); override;
procedure WMNCPAINT(var Message: TWMNCPAINT); message WM_NCPAINT;
procedure WMSETFOCUS(var Message: TMessage); message WM_SETFOCUS;
procedure WMKILLFOCUS(var Message: TMessage); message WM_KILLFOCUS;
procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
procedure WMMove(var Msg: TWMMove); message WM_MOVE;
procedure WMSize(var Msg: TWMSize); message WM_SIZE;
procedure WMLBUTTONDOWN(var Message: TMessage); message WM_LBUTTONDOWN;
procedure WMLBUTTONUP(var Message: TMessage); message WM_LBUTTONUP;
procedure WMMOUSEMOVE(var Message: TMessage); message WM_MOUSEMOVE;
procedure WMMOUSEWHEEL(var Message: TMessage); message WM_MOUSEWHEEL;
procedure WMSetText(var Message:TWMSetText); message WM_SETTEXT;
procedure WMKeyDown(var Message: TWMKeyDown); message WM_KEYDOWN;
procedure WMCut(var Message: TMessage); message WM_Cut;
procedure WMPaste(var Message: TMessage); message WM_PASTE;
procedure WMClear(var Message: TMessage); message WM_CLEAR;
procedure WMUndo(var Message: TMessage); message WM_UNDO;
procedure WMVSCROLL(var Message: TWMVScroll); message WM_VSCROLL;
procedure WMHSCROLL(var Message: TWMHScroll); message WM_HSCROLL;
procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
public
LTPoint, RTPoint, LBPoint, RBPoint: TPoint;
ClRect: TRect;
SkinRect, ActiveSkinRect: TRect;
FontName: String;
FontStyle: TFontStyles;
FontHeight: Integer;
FontColor: TColor;
ActiveFontColor: TColor;
BGColor: TColor;
ActiveBGColor: TColor;
//
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure ChangeSkinData;
procedure Invalidate; override;
property BorderStyle;
property ScrollBars;
published
//
property DefaultFont: TFont read FDefaultFont write SetDefaultFont;
property UseSkinFont: Boolean read FUseSkinFont write FUseSkinFont;
property BitMapBG: Boolean read FBitMapBG write SetBitMapBG;
property VScrollBar: TbsSkinScrollBar read FVScrollBar
write SetVScrollBar;
property SkinData: TbsSkinData read FSD write SetSkinData;
property SkinDataName: String read FSkinDataName write FSkinDataName;
//
property ReadOnly read FReadOnly write FReadOnly;
property Align;
property Alignment;
property Anchors;
property BiDiMode;
property Constraints;
property DragCursor;
property DragKind;
property DragMode;
property Enabled;
property Font;
property HideSelection;
property ImeMode;
property ImeName;
property Lines;
property MaxLength;
property OEMConvert;
property ParentBiDiMode;
property ParentColor;
property ParentCtl3D;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ShowHint;
property TabOrder;
property TabStop;
property Visible;
property WantReturns;
property WantTabs;
property WordWrap;
property OnChange;
property OnClick;
property OnDblClick;
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 OnStartDock;
property OnStartDrag;
property OnMouseEnter: TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
property OnMouseLeave: TNotifyEvent read FOnMouseLeave write FOnMouseLeave;
end;
TbsSkinMemo2 = class(TMemo)
protected
FMouseIn: Boolean;
FIndex: Integer;
FSD: TbsSkinData;
FSkinDataName: String;
FOnMouseEnter, FOnMouseLeave: TNotifyEvent;
FVScrollBar: TbsSkinScrollBar;
FHScrollBar: TbsSkinScrollBar;
FDown: Boolean;
FDefaultFont: TFont;
FUseSkinFont: Boolean;
procedure OnDefaultFontChange(Sender: TObject);
procedure SetDefaultFont(Value: TFont);
procedure UpDateScrollRange;
procedure SetVScrollBar(Value: TbsSkinScrollBar);
procedure SetHScrollBar(Value: TbsSkinScrollBar);
procedure OnVScrollBarChange(Sender: TObject);
procedure OnHScrollBarChange(Sender: TObject);
procedure SetSkinData(Value: TbsSkinData);
procedure Notification(AComponent: TComponent;
Operation: TOperation); override;
procedure Change; override;
procedure GetSkinData;
procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
procedure CNCtlColorEdit(var Message:TWMCTLCOLOREDIT); message CN_CTLCOLOREDIT;
procedure WMCHAR(var Message:TMessage); message WM_CHAR;
procedure WMNCCALCSIZE(var Message: TWMNCCalcSize); message WM_NCCALCSIZE;
procedure CreateParams(var Params: TCreateParams); override;
procedure WMSETFOCUS(var Message: TMessage); message WM_SETFOCUS;
procedure WMKILLFOCUS(var Message: TMessage); message WM_KILLFOCUS;
procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
procedure WMMove(var Msg: TWMMove); message WM_MOVE;
procedure WMSize(var Msg: TWMSize); message WM_SIZE;
procedure WMLBUTTONDOWN(var Message: TMessage); message WM_LBUTTONDOWN;
procedure WMLBUTTONUP(var Message: TMessage); message WM_LBUTTONUP;
procedure WMMOUSEMOVE(var Message: TMessage); message WM_MOUSEMOVE;
procedure WMMOUSEWHEEL(var Message: TMessage); message WM_MOUSEWHEEL;
procedure WMSetText(var Message:TWMSetText); message WM_SETTEXT;
procedure WMKeyDown(var Message: TWMKeyDown); message WM_KEYDOWN;
procedure WMCut(var Message: TMessage); message WM_Cut;
procedure WMPaste(var Message: TMessage); message WM_PASTE;
procedure WMClear(var Message: TMessage); message WM_CLEAR;
procedure WMUndo(var Message: TMessage); message WM_UNDO;
procedure WMVSCROLL(var Message: TWMVScroll); message WM_VSCROLL;
procedure WMHSCROLL(var Message: TWMHScroll); message WM_HSCROLL;
procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
public
FontName: String;
FontStyle: TFontStyles;
FontHeight: Integer;
FontColor: TColor;
ActiveFontColor: TColor;
BGColor: TColor;
ActiveBGColor: TColor;
//
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure ChangeSkinData;
procedure Invalidate; override;
property BorderStyle;
property ScrollBars;
published
//
property DefaultFont: TFont read FDefaultFont write SetDefaultFont;
property UseSkinFont: Boolean read FUseSkinFont write FUseSkinFont;
property VScrollBar: TbsSkinScrollBar read FVScrollBar
write SetVScrollBar;
property HScrollBar: TbsSkinScrollBar read FHScrollBar
write SetHScrollBar;
property SkinData: TbsSkinData read FSD write SetSkinData;
property SkinDataName: String read FSkinDataName write FSkinDataName;
//
property ReadOnly;
property Align;
property Alignment;
property Anchors;
property BiDiMode;
property Constraints;
property DragCursor;
property DragKind;
property DragMode;
property Enabled;
property Font;
property HideSelection;
property ImeMode;
property ImeName;
property Lines;
property MaxLength;
property OEMConvert;
property ParentBiDiMode;
property ParentColor;
property ParentCtl3D;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ShowHint;
property TabOrder;
property TabStop;
property Visible;
property WantReturns;
property WantTabs;
property WordWrap;
property OnChange;
property OnClick;
property OnDblClick;
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 OnStartDock;
property OnStartDrag;
property OnMouseEnter: TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
property OnMouseLeave: TNotifyEvent read FOnMouseLeave write FOnMouseLeave;
end;
TbsSkinCustomListBox = class;
TbsListBox = class(TListBox)
protected
FHorizontalExtentValue: Integer;
function GetState(AItemID: Integer): TOwnerDrawState;
procedure PaintBGWH(Cnvs: TCanvas; AW, AH, AX, AY: Integer);
procedure PaintBG(DC: HDC);
procedure PaintList(DC: HDC);
procedure PaintColumnsList(DC: HDC);
procedure CreateParams(var Params: TCreateParams); override;
procedure CNDrawItem(var Message: TWMDrawItem); message CN_DRAWITEM;
procedure WndProc(var Message: TMessage); override;
procedure DrawDefaultItem(Cnvs: TCanvas; itemID: Integer; rcItem: TRect;
State: TOwnerDrawState);
procedure DrawSkinItem(Cnvs: TCanvas; itemID: Integer; rcItem: TRect;
State: TOwnerDrawState);
procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
procedure WMPaint(var Msg: TWMPaint); message WM_PAINT;
procedure WMNCCALCSIZE(var Message: TWMNCCalcSize); message WM_NCCALCSIZE;
procedure PaintWindow(DC: HDC); 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 KeyDown(var Key: Word; Shift: TShiftState); override;
procedure KeyPress(var Key: Char); override;
procedure Click; override;
procedure CMEnter(var Message: TCMGotFocus); message CM_ENTER;
procedure CMExit(var Message: TCMGotFocus); message CM_EXIT;
procedure CreateWnd; override;
public
SkinListBox: TbsSkinCustomListBox;
procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
property HorizontalExtentValue: Integer
read FHorizontalExtentValue
write FHorizontalExtentValue;
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
end;
TbsSkinCustomListBox = class(TbsSkinCustomControl)
protected
//
FHorizontalExtent: Boolean;
FStopUpDateHScrollBar: Boolean;
//
FRowCount: Integer;
FGlyph: TBitMap;
FNumGlyphs: TbsSkinPanelNumGlyphs;
FSpacing: Integer;
FImages: TCustomImageList;
FImageIndex: Integer;
FOnUpButtonClick, FOnDownButtonClick, FOnCheckButtonClick: TNotifyEvent;
FDefaultItemHeight: Integer;
FDefaultCaptionHeight: Integer;
FDefaultCaptionFont: TFont;
FOnDrawItem: TbsDrawSkinItemEvent;
NewClRect: TRect;
ListRect: TRect;
FCaptionMode: Boolean;
FAlignment: TAlignment;
Buttons: array[0..2] of TbsCBButtonX;
OldActiveButton, ActiveButton, CaptureButton: Integer;
NewCaptionRect: TRect;
FOnListBoxClick: TNotifyEvent;
FOnListBoxDblClick: TNotifyEvent;
FOnListBoxMouseDown: TMouseEvent;
FOnListBoxMouseMove: TMouseMoveEvent;
FOnListBoxMouseUp: TMouseEvent;
FOnListBoxKeyDown: TKeyEvent;
FOnListBoxKeyPress: TKeyPressEvent;
FOnListBoxKeyUp: TKeyEvent;
TimerMode: Integer;
WaitMode: Boolean;
function GetFullItemWidth(Index: Integer; ACnvs: TCanvas): Integer; virtual;
procedure SetHorizontalExtent(Value: Boolean);
function GetColumns: Integer;
procedure SetColumns(Value: Integer);
procedure SetRowCount(Value: Integer);
procedure SetImages(Value: TCustomImageList);
procedure SetImageIndex(Value: Integer);
procedure SetGlyph(Value: TBitMap);
procedure SetNumGlyphs(Value: TbsSkinPanelNumGlyphs);
procedure SetSpacing(Value: Integer);
procedure StartTimer;
procedure StopTimer;
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 ListBoxMouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); virtual;
procedure ListBoxMouseMove(Shift: TShiftState; X, Y: Integer); virtual;
procedure ListBoxMouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); virtual;
procedure ListBoxClick; virtual;
procedure ListBoxDblClick; virtual;
procedure ListBoxKeyDown(var Key: Word; Shift: TShiftState); virtual;
procedure ListBoxKeyUp(var Key: Word; Shift: TShiftState); virtual;
procedure ListBoxKeyPress(var Key: Char); virtual;
procedure ListBoxEnter; virtual;
procedure ListBoxExit; virtual;
//
procedure ShowScrollBar;
procedure HideScrollBar;
procedure ShowHScrollBar;
procedure HideHScrollBar;
procedure GetSkinData; override;
procedure CalcRects;
procedure SBChange(Sender: TObject);
procedure HSBChange(Sender: TObject);
procedure CreateParams(var Params: TCreateParams); override;
procedure WMSIZE(var Message: TWMSIZE); message WM_SIZE;
procedure WMTimer(var Message: TWMTimer); message WM_Timer;
procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
//
procedure DefaultFontChange; override;
procedure OnDefaultCaptionFontChange(Sender: TObject);
procedure SetDefaultCaptionHeight(Value: Integer);
procedure SetDefaultCaptionFont(Value: TFont);
procedure SetDefaultItemHeight(Value: Integer);
procedure SetCaptionMode(Value: Boolean);
procedure SetAlignment(Value: TAlignment);
procedure SetItems(Value: TStrings);
function GetItems: TStrings;
function GetItemIndex: Integer;
procedure SetItemIndex(Value: Integer);
function GetMultiSelect: Boolean;
procedure SetMultiSelect(Value: Boolean);
function GetListBoxFont: TFont;
procedure SetListBoxFont(Value: TFont);
function GetListBoxTabOrder: TTabOrder;
procedure SetListBoxTabOrder(Value: TTabOrder);
function GetListBoxTabStop: Boolean;
procedure SetListBoxTabStop(Value: Boolean);
function GetListBoxDragMode: TDragMode;
procedure SetListBoxDragMode(Value: TDragMode);
function GetListBoxDragKind: TDragKind;
procedure SetListBoxDragKind(Value: TDragKind);
function GetListBoxDragCursor: TCursor;
procedure SetListBoxDragCursor(Value: TCursor);
//
function GetCanvas: TCanvas;
function GetExtandedSelect: Boolean;
procedure SetExtandedSelect(Value: Boolean);
function GetSelCount: Integer;
function GetSelected(Index: Integer): Boolean;
procedure SetSelected(Index: Integer; Value: Boolean);
function GetSorted: Boolean;
procedure SetSorted(Value: Boolean);
function GetTopIndex: Integer;
procedure SetTopIndex(Value: Integer);
function GetListBoxPopupMenu: TPopupMenu;
procedure SetListBoxPopupMenu(Value: TPopupMenu);
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 ListBoxWProc(var Message: TMessage; var Handled: Boolean); virtual;
procedure ListBoxCreateWnd; virtual;
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
public
ScrollBar: TbsSkinScrollBar;
HScrollBar: TbsSkinScrollBar;
ListBox: TbsListBox;
FontName: String;
FontStyle: TFontStyles;
FontHeight: Integer;
SItemRect, ActiveItemRect, FocusItemRect: TRect;
ItemLeftOffset, ItemRightOffset: Integer;
ItemTextRect: TRect;
FontColor, ActiveFontColor, FocusFontColor: TColor;
CaptionRect: TRect;
CaptionFontName: String;
CaptionFontStyle: TFontStyles;
CaptionFontHeight: Integer;
CaptionFontColor: TColor;
UpButtonRect, ActiveUpButtonRect, DownUpButtonRect: TRect;
DownButtonRect, ActiveDownButtonRect, DownDownButtonRect: TRect;
CheckButtonRect, ActiveCheckButtonRect, DownCheckButtonRect: TRect;
VScrollBarName, HScrollBarName, BothScrollBarName: String;
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure ChangeSkinData; override;
procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
procedure UpDateScrollBar;
function CalcHeight(AItemsCount: Integer): Integer;
//
procedure Clear;
function ItemAtPos(Pos: TPoint; Existing: Boolean): Integer;
function ItemRect(Item: Integer): TRect;
//
property Columns: Integer read GetColumns write SetColumns;
property Selected[Index: Integer]: Boolean read GetSelected write SetSelected;
property ListBoxCanvas: TCanvas read GetCanvas;
property SelCount: Integer read GetSelCount;
property TopIndex: Integer read GetTopIndex write SetTopIndex;
//
property DefaultCaptionHeight: Integer
read FDefaultCaptionHeight write SetDefaultCaptionHeight;
property DefaultCaptionFont: TFont
read FDefaultCaptionFont write SetDefaultCaptionFont;
property CaptionMode: Boolean read FCaptionMode
write SetCaptionMode;
property Alignment: TAlignment read FAlignment write SetAlignment
default taLeftJustify;
property DefaultItemHeight: Integer read FDefaultItemHeight
write SetDefaultItemHeight;
property Items: TStrings read GetItems write SetItems;
property ItemIndex: Integer read GetItemIndex write SetItemIndex;
property MultiSelect: Boolean read GetMultiSelect write SetMultiSelect;
property ListBoxFont: TFont read GetListBoxFont write SetListBoxFont;
property ListBoxTabOrder: TTabOrder read GetListBoxTabOrder write SetListBoxTabOrder;
property ListBoxTabStop: Boolean read GetListBoxTabStop write SetListBoxTabStop;
property ExtandedSelect: Boolean read GetExtandedSelect write SetExtandedSelect;
property Sorted: boolean read GetSorted write SetSorted;
property ListBoxPopupMenu: TPopupMenu read GetListBoxPopupMenu write SetListBoxPopupMenu;
property HorizontalExtent: Boolean
read FHorizontalExtent
write SetHorizontalExtent;
property ListBoxDragMode: TDragMode read GetListBoxDragMode write SetListBoxDragMode;
property ListBoxDragKind: TDragKind read GetListBoxDragKind write SetListBoxDragKind;
property ListBoxDragCursor: TCursor read GetListBoxDragCursor write SetListBoxDragCursor;
//
property Caption;
property Font;
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 RowCount: Integer read FRowCount write SetRowCount;
property Images: TCustomImageList read FImages write SetImages;
property ImageIndex: Integer read FImageIndex write SetImageIndex;
property Glyph: TBitMap read FGlyph write SetGlyph;
property NumGlyphs: TbsSkinPanelNumGlyphs read FNumGlyphs write SetNumGlyphs;
property Spacing: Integer read FSpacing write SetSpacing;
property OnClick;
property OnUpButtonClick: TNotifyEvent read FOnUpButtonClick
write FOnUpButtonClick;
property OnDownButtonClick: TNotifyEvent read FOnDownButtonClick
write FOnDownButtonClick;
property OnCheckButtonClick: TNotifyEvent read FOnCheckButtonClick
write FOnCheckButtonClick;
property OnCanResize;
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 OnListBoxClick: TNotifyEvent read FOnListBoxClick write FOnListBoxClick;
property OnListBoxDblClick: TNotifyEvent read FOnListBoxDblClick write FOnListBoxDblClick;
property OnListBoxMouseDown: TMouseEvent read FOnListBoxMouseDown write
FOnListBoxMouseDown;
property OnListBoxMouseMove: TMouseMoveEvent read FOnListBoxMouseMove
write FOnListBoxMouseMove;
property OnListBoxMouseUp: TMouseEvent read FOnListBoxMouseUp
write FOnListBoxMouseUp;
property OnListBoxKeyDown: TKeyEvent read FOnListBoxKeyDown write FOnListBoxKeyDown;
property OnListBoxKeyPress: TKeyPressEvent read FOnListBoxKeyPress write FOnListBoxKeyPress;
property OnListBoxKeyUp: TKeyEvent read FOnListBoxKeyUp write FOnListBoxKeyUp;
property OnDrawItem: TbsDrawSkinItemEvent read FOnDrawItem write FOnDrawItem;
end;
TbsSkinListBox = class(TbsSkinCustomListBox)
published
property HorizontalExtent;
property Columns;
property RowCount;
property Images;
property ImageIndex;
property Glyph;
property NumGlyphs;
property Spacing;
property CaptionMode;
property DefaultCaptionHeight;
property DefaultCaptionFont;
property Alignment;
property DefaultItemHeight;
property Items;
property ItemIndex;
property MultiSelect;
property ListBoxFont;
property ListBoxTabOrder;
property ListBoxTabStop;
property ListBoxDragMode;
property ListBoxDragKind;
property ListBoxDragCursor;
property ExtandedSelect;
property Sorted;
property ListBoxPopupMenu;
//
property Caption;
property Font;
property Align;
property DockSite;
property DragCursor;
property DragKind;
property DragMode;
property Enabled;
property ParentShowHint;
property PopupMenu;
property ShowHint;
property TabOrder;
property TabStop;
property OnClick;
property Visible;
property OnUpButtonClick;
property OnDownButtonClick;
property OnCheckButtonClick;
property OnCanResize;
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 OnListBoxClick;
property OnListBoxDblClick;
property OnListBoxMouseDown;
property OnListBoxMouseMove;
property OnListBoxMouseUp;
property OnListBoxKeyDown;
property OnListBoxKeyPress;
property OnListBoxKeyUp;
property OnDrawItem;
end;
TbsSkinScrollBox = class(TbsSkinCustomControl)
protected
FInCheckScrollBars: Boolean;
FDown: Boolean;
FVScrollBar: TbsSkinScrollBar;
FHScrollBar: TbsSkinScrollBar;
FOldVScrollBarPos: Integer;
FOldHScrollBarPos: Integer;
FVSizeOffset: Integer;
FHSizeOffset: Integer;
FBorderStyle: TbsSkinBorderStyle;
procedure SetBorderStyle(Value: TbsSkinBorderStyle);
procedure SetVScrollBar(Value: TbsSkinScrollBar);
procedure SetHScrollBar(Value: TbsSkinScrollBar);
procedure VScrollControls(AOffset: Integer);
procedure HScrollControls(AOffset: Integer);
procedure OnHScrollBarChange(Sender: TObject);
procedure OnVScrollBarChange(Sender: TObject);
procedure OnHScrollBarLastChange(Sender: TObject);
procedure OnVScrollBarLastChange(Sender: TObject);
procedure Notification(AComponent: TComponent;
Operation: TOperation); override;
procedure WMNCCALCSIZE(var Message: TWMNCCalcSize); message WM_NCCALCSIZE;
procedure WMNCPAINT(var Message: TWMNCPAINT); message WM_NCPAINT;
procedure PaintFrame(C: TCanvas);
procedure WMSize(var Msg: TWMSize); message WM_SIZE;
procedure CreateParams(var Params: TCreateParams); override;
procedure GetSkinData; override;
procedure CreateControlDefaultImage(B: TBitMap); override;
procedure ChangeSkinData; override;
procedure AdjustClientRect(var Rect: TRect); override;
procedure CMVisibleChanged(var Message: TMessage); message CM_VISIBLECHANGED;
public
BGPictureIndex: Integer;
procedure HScroll(APosition: Integer);
procedure VScroll(APosition: Integer);
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
procedure Paint; override;
procedure GetHRange;
procedure GetVRange;
procedure UpDateScrollRange;
published
property HScrollBar: TbsSkinScrollBar read FHScrollBar
write SetHScrollBar;
property VScrollBar: TbsSkinScrollBar read FVScrollBar
write SetVScrollBar;
property BorderStyle: TbsSkinBorderStyle
read FBorderStyle write SetBorderStyle;
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 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;
TCloseUpEvent = procedure (Sender: TObject; Accept: Boolean) of object;
TPopupAlign = (epaRight, epaLeft);
TbsCBItem = record
R: TRect;
State: TOwnerDrawState;
end;
TbsSkinCustomComboBoxStyle = (bscbEditStyle, bscbFixedStyle);
TbsPopupListBox = class(TbsSkinListBox)
private
FOldAlphaBlend: Boolean;
FOldAlphaBlendValue: Byte;
procedure WMMouseActivate(var Message: TMessage); message WM_MOUSEACTIVATE;
protected
procedure CreateParams(var Params: TCreateParams); override;
public
constructor Create(AOwner: TComponent); override;
procedure Hide;
procedure Show(Origin: TPoint);
end;
TbsSkinCustomComboBox = class(TbsSkinCustomControl)
protected
FAlphaBlend: Boolean;
FAlphaBlendAnimation: Boolean;
FAlphaBlendValue: Byte;
FStyle: TbsSkinCustomComboBoxStyle;
FOnChange: TNotifyEvent;
FOnClick: TNotifyEvent;
FOnCloseUp: TNotifyEvent;
FOnListBoxDrawItem: TbsDrawSkinItemEvent;
FOnComboBoxDrawItem: TbsDrawSkinItemEvent;
FMouseIn: Boolean;
FOldItemIndex: Integer;
FDropDownCount: Integer;
FLBDown: Boolean;
FListBoxWindowProc: TWndMethod;
FEditWindowProc: TWndMethod;
//
FListBox: TbsPopupListBox;
//
CBItem: TbsCBItem;
Button: TbsCBButtonX;
FEdit: TbsCustomEdit;
FromEdit: Boolean;
function GetHorizontalExtent: Boolean;
procedure SetHorizontalExtent(Value: Boolean);
function GetImages: TCustomImageList;
function GetImageIndex: Integer;
procedure SetImages(Value: TCustomImageList);
procedure SetImageIndex(Value: Integer);
function GetListBoxDefaultFont: TFont;
procedure SetListBoxDefaultFont(Value: TFont);
function GetListBoxUseSkinFont: Boolean;
procedure SetListBoxUseSkinFont(Value: Boolean);
function GetListBoxDefaultCaptionFont: TFont;
procedure SetListBoxDefaultCaptionFont(Value: TFont);
function GetListBoxDefaultItemHeight: Integer;
procedure SetListBoxDefaultItemHeight(Value: Integer);
function GetListBoxCaptionAlignment: TAlignment;
procedure SetListBoxCaptionAlignment(Value: TAlignment);
procedure CheckButtonClick(Sender: TObject);
procedure SetListBoxCaption(Value: String);
function GetListBoxCaption: String;
procedure SetListBoxCaptionMode(Value: Boolean);
function GetListBoxCaptionMode: Boolean;
procedure EditCancelMode(C: TControl);
procedure ListBoxDrawItem(Cnvs: TCanvas; Index: Integer;
ItemWidth, ItemHeight: Integer; TextRect: TRect; State: TOwnerDrawState);
function GetSorted: Boolean;
procedure SetSorted(Value: Boolean);
procedure SetStyle(Value: TbsSkinCustomComboBoxStyle);
procedure DrawDefaultItem(Cnvs: TCanvas);
procedure DrawSkinItem(Cnvs: TCanvas);
function GetItemIndex: Integer;
procedure SetItemIndex(Value: Integer);
procedure ListBoxWindowProcHook(var Message: TMessage);
procedure EditWindowProcHook(var Message: TMessage); virtual;
procedure SetItems(Value: TStrings);
function GetItems: TStrings;
procedure SetListBoxDrawItem(Value: TbsDrawSkinItemEvent);
procedure SetDropDownCount(Value: Integer);
procedure EditChange(Sender: TObject);
procedure EditUp(AChange: Boolean);
procedure EditDown(AChange: Boolean);
procedure EditUp1(AChange: Boolean);
procedure EditDown1(AChange: Boolean);
procedure EditPageUp1(AChange: Boolean);
procedure EditPageDown1(AChange: Boolean);
procedure ShowEditor;
procedure HideEditor;
procedure DrawButton(C: TCanvas);
procedure CalcRects;
procedure WMSETFOCUS(var Message: TMessage); message WM_SETFOCUS;
procedure WMKILLFOCUS(var Message: TWMKILLFOCUS); message WM_KILLFOCUS;
procedure WMSIZE(var Message: TWMSIZE); message WM_SIZE;
procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
procedure CMCancelMode(var Message: TCMCancelMode); message CM_CANCELMODE;
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 ListBoxMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure ListBoxMouseMove(Sender: TObject; Shift: TShiftState;
X, Y: Integer);
procedure ListBoxMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure GetSkinData; override;
procedure WMMOUSEWHEEL(var Message: TMessage); message WM_MOUSEWHEEL;
procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
procedure CMWantSpecialKey(var Msg: TCMWantSpecialKey); message CM_WANTSPECIALKEY;
procedure DefaultFontChange; override;
procedure CreateControlDefaultImage(B: TBitMap); override;
procedure CreateControlSkinImage(B: TBitMap); override;
procedure Change; virtual;
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
public
FontName: String;
FontStyle: TFontStyles;
FontHeight: Integer;
SItemRect, FocusItemRect: TRect;
ItemLeftOffset, ItemRightOffset: Integer;
ItemTextRect: TRect;
FontColor, FocusFontColor: TColor;
ButtonRect,
ActiveButtonRect,
DownButtonRect, UnEnabledButtonRect: TRect;
ListBoxName: String;
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure ChangeSkinData; override;
procedure CloseUp(Value: Boolean);
procedure DropDown;
function IsPopupVisible: Boolean;
function CanCancelDropDown: Boolean;
procedure Invalidate; override;
public
property AlphaBlend: Boolean read FAlphaBlend write FAlphaBlend;
property AlphaBlendAnimation: Boolean
read FAlphaBlendAnimation write FAlphaBlendAnimation;
property AlphaBlendValue: Byte read FAlphaBlendValue write FAlphaBlendValue;
property Images: TCustomImageList read GetImages write SetImages;
property ImageIndex: Integer read GetImageIndex write SetImageIndex;
property ListBoxCaption: String read GetListBoxCaption
write SetListBoxCaption;
property ListBoxCaptionMode: Boolean read GetListBoxCaptionMode
write SetListBoxCaptionMode;
property ListBoxDefaultFont: TFont
read GetListBoxDefaultFont write SetListBoxDefaultFont;
property ListBoxUseSkinFont: Boolean
read GetListBoxUseSkinFont write SetListBoxUseSkinFont;
property ListBoxDefaultCaptionFont: TFont
read GetListBoxDefaultCaptionFont write SetListBoxDefaultCaptionFont;
property ListBoxDefaultItemHeight: Integer
read GetListBoxDefaultItemHeight write SetListBoxDefaultItemHeight;
property ListBoxCaptionAlignment: TAlignment
read GetListBoxCaptionAlignment write SetListBoxCaptionAlignment;
property Enabled;
property PopupMenu;
property ShowHint;
property TabOrder;
property Visible;
//
property Text;
property Align;
property Items: TStrings read GetItems write SetItems;
property ItemIndex: Integer read GetItemIndex write SetItemIndex;
property DropDownCount: Integer read FDropDownCount write SetDropDownCount;
property HorizontalExtent: Boolean
read GetHorizontalExtent write SetHorizontalExtent;
property Font;
property Sorted: boolean read GetSorted write SetSorted;
property Style: TbsSkinCustomComboBoxStyle read FStyle write SetStyle;
property OnListBoxDrawItem: TbsDrawSkinItemEvent
read FOnListBoxDrawItem write SetListBoxDrawItem;
property OnComboBoxDrawItem: TbsDrawSkinItemEvent
read FOnComboBoxDrawItem write FOnComboBoxDrawItem;
property OnChange: TNotifyEvent read FOnChange write FOnChange;
property OnClick: TNotifyEvent read FOnClick write FOnClick;
property OnCloseUp: TNotifyEvent read FOnCloseUp write FOnCloseUp;
end;
TbsSkinComboBox = class(TbsSkinCustomComboBox)
published
property AlphaBlend;
property AlphaBlendValue;
property AlphaBlendAnimation;
property ListBoxUseSkinFont;
property Images;
property ImageIndex;
property ListBoxCaption;
property ListBoxCaptionMode;
property ListBoxDefaultFont;
property ListBoxDefaultCaptionFont;
property ListBoxDefaultItemHeight;
property ListBoxCaptionAlignment;
property Enabled;
property PopupMenu;
property ShowHint;
property TabOrder;
property TabStop;
property Visible;
//
property Text;
property Align;
property Items;
property ItemIndex;
property DropDownCount;
property HorizontalExtent;
property Font;
property Sorted;
property Style;
property OnListBoxDrawItem;
property OnComboBoxDrawItem;
property OnChange;
property OnClick;
property OnCloseUp;
end;
TbsColorBoxStyles = (bscbStandardColors, bscbExtendedColors, bscbSystemColors,
bscbIncludeNone, bscbIncludeDefault, bscbCustomColor,
bscbPrettyNames);
TbsColorBoxStyle = set of TbsColorBoxStyles;
TbsSkinColorComboBox = class(TbsSkinCustomComboBox)
private
FShowNames: Boolean;
FExStyle: TbsColorBoxStyle;
FNeedToPopulate: Boolean;
FListSelected: Boolean;
FDefaultColorColor: TColor;
FNoneColorColor: TColor;
FSelectedColor: TColor;
procedure SetShowNames(Value: Boolean);
function GetColor(Index: Integer): TColor;
function GetColorName(Index: Integer): string;
function GetSelected: TColor;
procedure SetSelected(const AColor: TColor);
procedure ColorCallBack(const AName: string);
procedure SetDefaultColorColor(const Value: TColor);
procedure SetNoneColorColor(const Value: TColor);
procedure SetExStyle(AStyle: TbsColorBoxStyle);
protected
procedure DrawColorItem(Cnvs: TCanvas; Index: Integer;
ItemWidth, ItemHeight: Integer; TextRect: TRect; State: TOwnerDrawState);
procedure CreateWnd; override;
function PickCustomColor: Boolean; virtual;
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
procedure OnLBCloseUp(Sender: TObject);
public
constructor Create(AOwner: TComponent); override;
property Colors[Index: Integer]: TColor read GetColor;
property ColorNames[Index: Integer]: string read GetColorName;
procedure PopulateList;
published
property AlphaBlend;
property AlphaBlendValue;
property ListBoxCaption;
property ListBoxCaptionMode;
property Enabled;
property PopupMenu;
property ShowHint;
property TabOrder;
property Visible;
//
property Align;
property ItemIndex;
property DropDownCount;
property Font;
property Sorted;
property ExStyle: TbsColorBoxStyle read FExStyle write SetExStyle
default [bscbStandardColors, bscbExtendedColors, bscbSystemColors];
property Selected: TColor read GetSelected write SetSelected default clBlack;
property DefaultColorColor: TColor read FDefaultColorColor write SetDefaultColorColor default clBlack;
property NoneColorColor: TColor read FNoneColorColor write SetNoneColorColor default clBlack;
property ShowNames: Boolean read FShowNames write SetShowNames;
property OnClick;
property OnChange;
end;
TbsFontDevice = (fdScreen, fdPrinter, fdBoth);
TbsFontListOption = (foAnsiOnly, foTrueTypeOnly, foFixedPitchOnly,
foNoOEMFonts, foOEMFontsOnly, foScalableOnly, foNoSymbolFonts);
TbsFontListOptions = set of TbsFontListOption;
TbsSkinFontComboBox = class(TbsSkinCustomComboBox)
protected
FDevice: TbsFontDevice;
FUpdate: Boolean;
FUseFonts: Boolean;
FOptions: TbsFontListOptions;
procedure SetFontName(const NewFontName: TFontName);
function GetFontName: TFontName;
function GetTrueTypeOnly: Boolean;
procedure SetDevice(Value: TbsFontDevice);
procedure SetOptions(Value: TbsFontListOptions);
procedure SetTrueTypeOnly(Value: Boolean);
procedure SetUseFonts(Value: Boolean);
procedure Reset;
procedure WMFontChange(var Message: TMessage); message WM_FONTCHANGE;
procedure DrawLBFontItem(Cnvs: TCanvas; Index: Integer;
ItemWidth, ItemHeight: Integer; TextRect: TRect; State: TOwnerDrawState);
procedure DrawCBFontItem(Cnvs: TCanvas; Index: Integer;
ItemWidth, ItemHeight: Integer; TextRect: TRect; State: TOwnerDrawState);
procedure CreateWnd; override;
procedure DrawTT(Cnvs: TCanvas; X, Y: Integer; C: TColor);
public
constructor Create(AOwner: TComponent); override;
procedure PopulateList;
published
property AlphaBlend;
property AlphaBlendValue;
property ListBoxCaption;
property ListBoxCaptionMode;
property Enabled;
property PopupMenu;
property ShowHint;
property TabOrder;
property Visible;
//
property Align;
property ItemIndex;
property DropDownCount;
property Font;
property Sorted;
property Style;
property OnChange;
property OnClick;
//
property Device: TbsFontDevice read FDevice write SetDevice default fdScreen;
property FontName: TFontName read GetFontName write SetFontName;
property Options: TbsFontListOptions read FOptions write SetOptions default [];
property TrueTypeOnly: Boolean read GetTrueTypeOnly write SetTrueTypeOnly
stored False;
property UseFonts: Boolean read FUseFonts write SetUseFonts default False;
end;
TbsValueType = (vtInteger, vtFloat);
TbsSkinSpinEdit = class(TbsSkinCustomControl)
private
StopCheck: Boolean;
FDecimal: Byte;
FMinValue, FMaxValue, FIncrement: Double;
FromEdit: Boolean;
FValueType: TbsValueType;
FOnChange: TNotifyEvent;
FValue: Double;
OldActiveButton, ActiveButton, CaptureButton: Integer;
TimerMode: Integer;
WaitMode: Boolean;
procedure StartTimer;
procedure StopTimer;
procedure SetValue(AValue: Double);
procedure SetMinValue(AValue: Double);
procedure SetMaxValue(AValue: Double);
procedure SetEditorEnabled(AValue: Boolean);
function GetEditorEnabled: Boolean;
procedure SetMaxLength(AValue: Integer);
function GetMaxLength: Integer;
procedure SetValueType(NewType: TbsValueType);
procedure SetDecimal(NewValue: Byte);
protected
Buttons: array[0..1] of TbsCBButtonX;
FOnEditKeyDown: TKeyEvent;
FOnEditKeyPress: TKeyPressEvent;
FOnEditKeyUp: TKeyEvent;
FOnEditEnter: TNotifyEvent;
FOnEditExit: TNotifyEvent;
procedure EditKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); virtual;
procedure EditKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); virtual;
procedure EditKeyPress(Sender: TObject; var Key: Char); virtual;
procedure EditEnter(Sender: TObject); virtual;
procedure EditExit(Sender: TObject); virtual;
procedure UpClick(Sender: TObject);
procedure DownClick(Sender: TObject);
function CheckValue (NewValue: Double): Double;
procedure EditChange(Sender: TObject);
procedure ButtonDown(I: Integer; X, Y: Integer);
procedure ButtonUp(I: Integer; X, Y: Integer);
procedure ButtonEnter(I: Integer);
procedure ButtonLeave(I: Integer);
procedure TestActive(X, Y: Integer);
procedure CalcRects;
procedure DrawButton(Cnvs: TCanvas; i: Integer);
procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
procedure WMSIZE(var Message: TWMSIZE); message WM_SIZE;
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 MouseMove(Shift: TShiftState; X, Y: Integer); override;
procedure WMTimer(var Message: TWMTimer); message WM_Timer;
procedure GetSkinData; override;
procedure DefaultFontChange; override;
procedure CreateControlDefaultImage(B: TBitMap); override;
procedure CreateControlSkinImage(B: TBitMap); override;
procedure Change; virtual;
public
FontName: String;
FontStyle: TFontStyles;
FontHeight: Integer;
FontColor: TColor;
UpButtonRect, ActiveUpButtonRect, DownUpButtonRect: TRect;
DownButtonRect, ActiveDownButtonRect, DownDownButtonRect: TRect;
//
FEdit: TbsSkinNumEdit;
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Invalidate; override;
function IsNumText(AText: String): Boolean;
procedure ChangeSkinData; override;
property Text;
procedure SimpleSetValue(AValue: Double);
published
property ValueType: TbsValueType read FValueType write SetValueType;
property Decimal: Byte read FDecimal write SetDecimal default 2;
property Align;
property MinValue: Double read FMinValue write SetMinValue;
property MaxValue: Double read FMaxValue write SetMaxValue;
property Value: Double read FValue write SetValue;
property Increment: Double read FIncrement write FIncrement;
property EditorEnabled: Boolean read GetEditorEnabled write SetEditorEnabled;
property MaxLength: Integer read GetMaxLength write SetMaxLength;
property OnChange: TNotifyEvent read FOnChange write FOnChange;
property OnEditKeyDown: TKeyEvent read FOnEditKeyDown write FOnEditKeyDown;
property OnEditKeyPress: TKeyPressEvent read FOnEditKeyPress write FOnEditKeyPress;
property OnEditKeyUp: TKeyEvent read FOnEditKeyUp write FOnEditKeyUp;
property OnEditEnter: TNotifyEvent read FOnEditEnter write FOnEditEnter;
property OnEditExit: TNotifyEvent read FOnEditExit write FOnEditExit;
end;
TbsSkinCheckListBox = class;
TbsCheckListBox = class(TListBox)
protected
FSaveStates: TList;
FOnClickCheck: TNotifyEvent;
procedure SkinDrawCheckImage(X, Y: Integer; Cnvs: TCanvas; IR: TRect; DestCnvs: TCanvas);
procedure PaintBGWH(Cnvs: TCanvas; AW, AH, AX, AY: Integer);
function CreateWrapper(Index: Integer): TObject;
function GetWrapper(Index: Integer): TObject;
function HaveWrapper(Index: Integer): Boolean;
function ExtractWrapper(Index: Integer): TObject;
procedure InvalidateCheck(Index: Integer);
procedure SetChecked(Index: Integer; Checked: Boolean);
function GetChecked(Index: Integer): Boolean;
procedure SetState(Index: Integer; AState: TCheckBoxState);
function GetState(Index: Integer): TCheckBoxState;
function GetState1(AItemID: Integer): TOwnerDrawState;
procedure ToggleClickCheck(Index: Integer);
procedure DeleteString(Index: Integer); override;
procedure ResetContent; override;
procedure SetItemData(Index: Integer; AData: LongInt); override;
function GetItemData(Index: Integer): LongInt; override;
procedure PaintBG(DC: HDC);
procedure PaintList(DC: HDC);
procedure PaintColumnsList(DC: HDC);
procedure CreateParams(var Params: TCreateParams); override;
procedure CNDrawItem(var Message: TWMDrawItem); message CN_DRAWITEM;
procedure WndProc(var Message: TMessage); override;
procedure DrawDefaultItem(Cnvs: TCanvas; itemID: Integer; rcItem: TRect;
State1: TOwnerDrawState);
procedure DrawSkinItem(Cnvs: TCanvas; itemID: Integer; rcItem: TRect;
State1: TOwnerDrawState);
procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
procedure WMPaint(var Msg: TWMPaint); message WM_PAINT;
procedure WMNCCALCSIZE(var Message: TWMNCCalcSize); message WM_NCCALCSIZE;
procedure PaintWindow(DC: HDC); override;
procedure WMDestroy(var Msg : TWMDestroy);message WM_DESTROY;
procedure DestroyWnd; 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 KeyDown(var Key: Word; Shift: TShiftState); override;
procedure KeyPress(var Key: Char); override;
procedure Click; override;
procedure CMEnter(var Message: TCMGotFocus); message CM_ENTER;
procedure CMExit(var Message: TCMGotFocus); message CM_EXIT;
procedure CreateWnd; override;
public
SkinListBox: TbsSkinCheckListBox;
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
property Checked[Index: Integer]: Boolean read GetChecked write SetChecked;
property State[Index: Integer]: TCheckBoxState read GetState write SetState;
property OnClickCheck: TNotifyEvent read FOnClickCheck write FOnClickCheck;
end;
TbsSkinCheckListBox = class(TbsSkinCustomControl)
protected
FRowCount: Integer;
FImages: TCustomImageList;
FImageIndex: Integer;
FGlyph: TBitMap;
FNumGlyphs: TbsSkinPanelNumGlyphs;
FSpacing: Integer;
FOnUpButtonClick, FOnDownButtonClick, FOnCheckButtonClick: TNotifyEvent;
FOnClickCheck: TNotifyEvent;
FDefaultItemHeight: Integer;
FOnDrawItem: TbsDrawSkinItemEvent;
NewClRect: TRect;
ListRect: TRect;
FDefaultCaptionHeight: Integer;
FDefaultCaptionFont: TFont;
FOnListBoxClick: TNotifyEvent;
FOnListBoxDblClick: TNotifyEvent;
FOnListBoxMouseDown: TMouseEvent;
FOnListBoxMouseMove: TMouseMoveEvent;
FOnListBoxMouseUp: TMouseEvent;
FOnListBoxKeyDown: TKeyEvent;
FOnListBoxKeyPress: TKeyPressEvent;
FOnListBoxKeyUp: TKeyEvent;
FCaptionMode: Boolean;
FAlignment: TAlignment;
Buttons: array[0..2] of TbsCBButtonX;
OldActiveButton, ActiveButton, CaptureButton: Integer;
NewCaptionRect: TRect;
TimerMode: Integer;
WaitMode: Boolean;
function GetColumns: Integer;
procedure SetColumns(Value: Integer);
procedure SetOnClickCheck(const Value: TNotifyEvent);
procedure SetRowCount(Value: Integer);
procedure SetImages(Value: TCustomImageList);
procedure SetImageIndex(Value: Integer);
procedure SetGlyph(Value: TBitMap);
procedure SetNumGlyphs(Value: TbsSkinPanelNumGlyphs);
procedure SetSpacing(Value: Integer);
procedure StartTimer;
procedure StopTimer;
procedure ButtonDown(I: Integer; X, Y: Integer);
procedure ButtonUp(I: Integer; X, Y: Integer);
procedure ButtonEnter(I: Integer);
procedure ButtonLeave(I: Integer);
procedure TestActive(X, Y: Integer);
procedure DrawButton(Cnvs: TCanvas; i: Integer);
procedure ListBoxOnClickCheck(Sender: TObject);
procedure SetChecked(Index: Integer; Checked: Boolean);
function GetChecked(Index: Integer): Boolean;
procedure SetState(Index: Integer; AState: TCheckBoxState);
function GetState(Index: Integer): TCheckBoxState;
procedure ListBoxMouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); virtual;
procedure ListBoxMouseMove(Shift: TShiftState; X, Y: Integer); virtual;
procedure ListBoxMouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); virtual;
procedure ListBoxClick; virtual;
procedure ListBoxDblClick; virtual;
procedure ListBoxKeyDown(var Key: Word; Shift: TShiftState); virtual;
procedure ListBoxKeyUp(var Key: Word; Shift: TShiftState); virtual;
procedure ListBoxKeyPress(var Key: Char); virtual;
procedure ListBoxEnter; virtual;
procedure ListBoxExit; virtual;
//
procedure ShowScrollBar;
procedure HideScrollBar;
//
procedure GetSkinData; override;
procedure CalcRects;
procedure SBChange(Sender: TObject);
procedure CreateParams(var Params: TCreateParams); override;
procedure WMSIZE(var Message: TWMSIZE); message WM_SIZE;
procedure WMTimer(var Message: TWMTimer); message WM_Timer;
procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
//
procedure OnDefaultCaptionFontChange(Sender: TObject);
procedure SetDefaultCaptionHeight(Value: Integer);
procedure SetDefaultCaptionFont(Value: TFont);
procedure SetDefaultItemHeight(Value: Integer);
procedure SetCaptionMode(Value: Boolean);
procedure SetAlignment(Value: TAlignment);
procedure SetItems(Value: TStrings);
function GetItems: TStrings;
function GetItemIndex: Integer;
procedure SetItemIndex(Value: Integer);
function GetMultiSelect: Boolean;
procedure SetMultiSelect(Value: Boolean);
function GetListBoxFont: TFont;
procedure SetListBoxFont(Value: TFont);
function GetListBoxTabOrder: TTabOrder;
procedure SetListBoxTabOrder(Value: TTabOrder);
function GetListBoxTabStop: Boolean;
procedure SetListBoxTabStop(Value: Boolean);
//
function GetCanvas: TCanvas;
function GetExtandedSelect: Boolean;
procedure SetExtandedSelect(Value: Boolean);
function GetSelCount: Integer;
function GetSelected(Index: Integer): Boolean;
procedure SetSelected(Index: Integer; Value: Boolean);
function GetSorted: Boolean;
procedure SetSorted(Value: Boolean);
function GetTopIndex: Integer;
procedure SetTopIndex(Value: Integer);
function GetListBoxPopupMenu: TPopupMenu;
procedure SetListBoxPopupMenu(Value: TPopupMenu);
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 Notification(AComponent: TComponent; Operation: TOperation); override;
function GetListBoxDragMode: TDragMode;
procedure SetListBoxDragMode(Value: TDragMode);
function GetListBoxDragKind: TDragKind;
procedure SetListBoxDragKind(Value: TDragKind);
function GetListBoxDragCursor: TCursor;
procedure SetListBoxDragCursor(Value: TCursor);
public
ScrollBar: TbsSkinScrollBar;
ListBox: TbsCheckListBox;
FontName: String;
FontStyle: TFontStyles;
FontHeight: Integer;
SItemRect, ActiveItemRect, FocusItemRect: TRect;
ItemLeftOffset, ItemRightOffset: Integer;
ItemTextRect: TRect;
FontColor, ActiveFontColor, FocusFontColor: TColor;
UnCheckImageRect, CheckImageRect: TRect;
ItemCheckRect: TRect;
CaptionRect: TRect;
CaptionFontName: String;
CaptionFontStyle: TFontStyles;
CaptionFontHeight: Integer;
CaptionFontColor: TColor;
UpButtonRect, ActiveUpButtonRect, DownUpButtonRect: TRect;
DownButtonRect, ActiveDownButtonRect, DownDownButtonRect: TRect;
CheckButtonRect, ActiveCheckButtonRect, DownCheckButtonRect: TRect;
VScrollBarName, HScrollBarName: String;
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
property Checked[Index: Integer]: Boolean read GetChecked write SetChecked;
property State[Index: Integer]: TCheckBoxState read GetState write SetState;
procedure ChangeSkinData; override;
procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
procedure UpDateScrollBar;
function CalcHeight(AItemsCount: Integer): Integer;
//
procedure Clear;
function ItemAtPos(Pos: TPoint; Existing: Boolean): Integer;
function ItemRect(Item: Integer): TRect;
//
property Selected[Index: Integer]: Boolean read GetSelected write SetSelected;
property ListBoxCanvas: TCanvas read GetCanvas;
property SelCount: Integer read GetSelCount;
property TopIndex: Integer read GetTopIndex write SetTopIndex;
published
property Columns: Integer read GetColumns write SetColumns;
property CaptionMode: Boolean read FCaptionMode
write SetCaptionMode;
property DefaultCaptionHeight: Integer
read FDefaultCaptionHeight write SetDefaultCaptionHeight;
property DefaultCaptionFont: TFont
read FDefaultCaptionFont write SetDefaultCaptionFont;
property Alignment: TAlignment read FAlignment write SetAlignment
default taLeftJustify;
property DefaultItemHeight: Integer read FDefaultItemHeight
write SetDefaultItemHeight;
property Items: TStrings read GetItems write SetItems;
property ItemIndex: Integer read GetItemIndex write SetItemIndex;
property MultiSelect: Boolean read GetMultiSelect write SetMultiSelect;
property ListBoxFont: TFont read GetListBoxFont write SetListBoxFont;
property ListBoxTabOrder: TTabOrder read GetListBoxTabOrder write SetListBoxTabOrder;
property ListBoxTabStop: Boolean read GetListBoxTabStop write SetListBoxTabStop;
property ListBoxDragMode: TDragMode read GetListBoxDragMode write SetListBoxDragMode;
property ListBoxDragKind: TDragKind read GetListBoxDragKind write SetListBoxDragKind;
property ListBoxDragCursor: TCursor read GetListBoxDragCursor write SetListBoxDragCursor;
property ExtandedSelect: Boolean read GetExtandedSelect write SetExtandedSelect;
property Sorted: boolean read GetSorted write SetSorted;
property ListBoxPopupMenu: TPopupMenu read GetListBoxPopupMenu write SetListBoxPopupMenu;
//
property Caption;
property Font;
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 Images: TCustomImageList read FImages write SetImages;
property ImageIndex: Integer read FImageIndex write SetImageIndex;
property Glyph: TBitMap read FGlyph write SetGlyph;
property NumGlyphs: TbsSkinPanelNumGlyphs read FNumGlyphs write SetNumGlyphs;
property Spacing: Integer read FSpacing write SetSpacing;
property RowCount: Integer read FRowCount write SetRowCount;
property OnClick;
property OnUpButtonClick: TNotifyEvent read FOnUpButtonClick
write FOnUpButtonClick;
property OnDownButtonClick: TNotifyEvent read FOnDownButtonClick
write FOnDownButtonClick;
property OnCheckButtonClick: TNotifyEvent read FOnCheckButtonClick
write FOnCheckButtonClick;
property OnCanResize;
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 OnClickCheck: TNotifyEvent read FOnClickCheck write SetOnClickCheck;
property OnListBoxClick: TNotifyEvent read FOnListBoxClick write FOnListBoxClick;
property OnListBoxDblClick: TNotifyEvent read FOnListBoxDblClick write FOnListBoxDblClick;
property OnListBoxMouseDown: TMouseEvent read FOnListBoxMouseDown write
FOnListBoxMouseDown;
property OnListBoxMouseMove: TMouseMoveEvent read FOnListBoxMouseMove
write FOnListBoxMouseMove;
property OnListBoxMouseUp: TMouseEvent read FOnListBoxMouseUp
write FOnListBoxMouseUp;
property OnListBoxKeyDown: TKeyEvent read FOnListBoxKeyDown write FOnListBoxKeyDown;
property OnListBoxKeyPress: TKeyPressEvent read FOnListBoxKeyPress write FOnListBoxKeyPress;
property OnListBoxKeyUp: TKeyEvent read FOnListBoxKeyUp write FOnListBoxKeyUp;
property OnDrawItem: TbsDrawSkinItemEvent read FOnDrawItem write FOnDrawItem;
end;
TbsSkinUpDown = class(TbsSkinCustomControl)
protected
FOrientation: TUDOrientation;
Buttons: array[0..1] of TbsCBButtonX;
OldActiveButton, ActiveButton, CaptureButton: Integer;
TimerMode: Integer;
WaitMode: Boolean;
//
FOnUpButtonClick: TNotifyEvent;
FOnDownButtonClick: TNotifyEvent;
FOnChange: TNotifyEvent;
FIncrement: Integer;
FPosition: Integer;
FMin: Integer;
FMax: Integer;
procedure SetOrientation(Value: TUDOrientation);
procedure StartTimer;
procedure StopTimer;
procedure WMTimer(var Message: TWMTimer); message WM_Timer;
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 CalcRects;
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 SetIncrement(Value: Integer);
procedure SetPosition(Value: Integer);
procedure SetMin(Value: Integer);
procedure SetMax(Value: Integer);
procedure GetSkinData; override;
procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
procedure WMSIZE(var Message: TWMSIZE); message WM_SIZE;
procedure CreateControlDefaultImage(B: TBitMap); override;
procedure CreateControlSkinImage(B: TBitMap); override;
public
UpButtonRect, ActiveUpButtonRect, DownUpButtonRect: TRect;
DownButtonRect, ActiveDownButtonRect, DownDownButtonRect: TRect;
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property Orientation: TUDOrientation read FOrientation
write SetOrientation;
property Increment: Integer read FIncrement write SetIncrement;
property Position: Integer read FPosition write SetPosition;
property Min: Integer read FMin write SetMin;
property Max: Integer read FMax write SetMax;
property OnChange: TNotifyEvent read FOnChange write FOnChange;
property OnUpButtonClick: TNotifyEvent read FOnUpButtonClick
write FOnUpButtonClick;
property OnDownButtonClick: TNotifyEvent read FOnDownButtonClick
write FOnDownButtonClick;
end;
TbsSkinDateEdit = class;
TbsSkinPopupMonthCalendar = class(TbsSkinMonthCalendar)
protected
procedure WMMouseActivate(var Message: TMessage); message WM_MOUSEACTIVATE;
procedure CreateParams(var Params: TCreateParams); override;
public
constructor Create(AOwner: TComponent); override;
end;
TbsSkinDateEdit = class(TbsSkinCustomEdit)
private
StopCheck: Boolean;
FAlphaBlend: Boolean;
FAlphaBlendValue: Byte;
FAlphaBlendAnimation: Boolean;
FTodayDefault: Boolean;
protected
FMonthCalendar: TbsSkinPopupMonthCalendar;
FOnDateChange: TNotifyEvent;
procedure Loaded; override;
procedure SetTodayDefault(Value: Boolean);
function GetCalendarFont: TFont;
procedure SetCalendarFont(Value: TFont);
function GetCalendarWidth: Integer;
procedure SetCalendarWidth(Value: Integer);
function GetCalendarHeight: Integer;
procedure SetCalendarHeight(Value: Integer);
function GetDate: TDate;
procedure SetDate(Value: TDate);
procedure DropDown;
procedure CloseUp(AcceptValue: Boolean);
procedure ButtonClick(Sender: TObject);
procedure CalendarClick(Sender: TObject);
procedure WndProc(var Message: TMessage); override;
procedure CMCancelMode(var Message: TCMCancelMode); message CM_CANCELMODE;
function IsValidChar(Key: Char): Boolean;
procedure CheckValidDate;
procedure Change; override;
procedure KeyPress(var Key: Char); override;
function IsValidText(S: String): Boolean;
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
procedure CheckSelect;
//
function GetFirstDayOfWeek: TbsDaysOfWeek;
procedure SetFirstDayOfWeek(Value: TbsDaysOfWeek);
//
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property AlphaBlend: Boolean read FAlphaBlend write FAlphaBlend;
property AlphaBlendAnimation: Boolean
read FAlphaBlendAnimation write FAlphaBlendAnimation;
property AlphaBlendValue: Byte read FAlphaBlendValue write FAlphaBlendValue;
property Date: TDate read GetDate write SetDate;
property TodayDefault: Boolean read FTodayDefault write SetTodayDefault;
property CalendarWidth: Integer read GetCalendarWidth write SetCalendarWidth;
property CalendarHeight: Integer read GetCalendarHeight write SetCalendarHeight;
property CalendarFont: TFont read GetCalendarFont write SetCalendarFont;
property FirstDayOfWeek: TbsDaysOfWeek
read GetFirstDayOfWeek write SetFirstDayOfWeek;
property OnDateChange: TNotifyEvent
read FOnDateChange write FOnDateChange;
property DefaultFont;
property DefaultWidth;
property DefaultHeight;
property ButtonMode;
property SkinData;
property SkinDataName;
property EditPasswordChar;
property OnMouseEnter;
property OnMouseLeave;
property ReadOnly;
property Align;
property Alignment;
property Font;
property Anchors;
property AutoSelect;
property BiDiMode;
property CharCase;
property Constraints;
property DragCursor;
property DragKind;
property DragMode;
property Enabled;
property HideSelection;
property ImeMode;
property ImeName;
property MaxLength;
property OEMConvert;
property ParentBiDiMode;
property ParentColor;
property ParentCtl3D;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ShowHint;
property TabOrder;
property TabStop;
property Text;
property Visible;
property OnButtonClick;
property OnChange;
property OnClick;
property OnDblClick;
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 OnStartDock;
property OnStartDrag;
end;
TbsSkinTrackEdit = class;
TbsSkinPopupTrackBar = class(TbsSkinTrackBar)
protected
procedure WMMouseActivate(var Message: TMessage); message WM_MOUSEACTIVATE;
procedure CreateParams(var Params: TCreateParams); override;
public
TrackEdit: TbsSkinTrackEdit;
constructor Create(AOwner: TComponent); override;
end;
TbsSkinTrackEdit = class(TbsSkinCustomEdit)
private
FTrackBarSkinDataName: String;
StopCheck: Boolean;
FMinValue, FMaxValue, FValue: Integer;
FAlphaBlend: Boolean;
FAlphaBlendValue: Byte;
FAlphaBlendAnimation: Boolean;
FPopupTrackBar: TbsSkinPopupTrackBar;
procedure SetValue(AValue: Integer);
procedure SetMinValue(AValue: Integer);
procedure SetMaxValue(AValue: Integer);
procedure ButtonClick(Sender: TObject);
procedure TrackBarChange(Sender: TObject);
procedure DropDown;
procedure CloseUp;
protected
function CheckValue(NewValue: Integer): Integer;
procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
procedure CMCancelMode(var Message: TCMCancelMode); message CM_CANCELMODE;
procedure KeyPress(var Key: Char); override;
function IsValidChar(Key: Char): Boolean;
procedure Change; override;
procedure WMKillFocus(var Message: TWMKillFocus); message WM_KILLFOCUS;
property Text;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
function IsNumText(AText: String): Boolean;
published
property TrackBarSkinDataName: String
read FTrackBarSkinDataName write FTrackBarSkinDataName;
property AlphaBlend: Boolean read FAlphaBlend write FAlphaBlend;
property AlphaBlendAnimation: Boolean
read FAlphaBlendAnimation write FAlphaBlendAnimation;
property AlphaBlendValue: Byte read FAlphaBlendValue write FAlphaBlendValue;
property MinValue: Integer read FMinValue write SetMinValue;
property MaxValue: Integer read FMaxValue write SetMaxValue;
property Value: Integer read FValue write SetValue;
property DefaultFont;
property DefaultWidth;
property DefaultHeight;
property ButtonMode;
property SkinData;
property SkinDataName;
property EditPasswordChar;
property OnMouseEnter;
property OnMouseLeave;
property ReadOnly;
property Align;
property Font;
property Anchors;
property AutoSelect;
property BiDiMode;
property CharCase;
property Constraints;
property DragCursor;
property DragKind;
property DragMode;
property Enabled;
property HideSelection;
property ImeMode;
property ImeName;
property MaxLength;
property OEMConvert;
property ParentBiDiMode;
property ParentColor;
property ParentCtl3D;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ShowHint;
property TabOrder;
property TabStop;
property Visible;
property OnButtonClick;
property OnChange;
property OnClick;
property OnDblClick;
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 OnStartDock;
property OnStartDrag;
end;
TbsSkinMaskEdit = class(TbsSkinEdit)
published
property Anchors;
property AutoSelect;
property AutoSize;
property BiDiMode;
property BorderStyle;
property CharCase;
property Color;
property Constraints;
property Ctl3D;
property DragCursor;
property DragKind;
property DragMode;
property Enabled;
property EditMask;
property Font;
property ImeMode;
property ImeName;
property MaxLength;
property ParentBiDiMode;
property ParentColor;
property ParentCtl3D;
property ParentFont;
property ParentShowHint;
property PasswordChar;
property PopupMenu;
property ReadOnly;
property ShowHint;
property TabOrder;
property TabStop;
property Visible;
property OnChange;
property OnClick;
property OnDblClick;
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 OnStartDock;
property OnStartDrag;
end;
TbsSkinTimeEdit = class(TbsSkinMaskEdit)
private
fShowMSec: Boolean;
procedure SetShowMilliseconds(const Value: Boolean);
procedure SetMilliseconds(const Value: integer);
function GetMilliseconds: integer;
procedure SetTime(const Value: string);
function GetTime: string;
function IsValidTime(const AHour, AMinute, ASecond, AMilliSecond: Word): Boolean;
function IsValidChar(Key: Char): Boolean;
procedure CheckSpace(var S: String);
protected
procedure HandleOnKeyPress(Sender: TObject; var Key: Char);
public
constructor Create(AOwner: TComponent); override;
procedure DecodeTime(var Hour, Min, Sec, MSec: Word);
procedure EncodeTime(Hour, Min, Sec, MSec: Word);
property ShowMSec: Boolean read fShowMSec write SetShowMilliseconds;
property Milliseconds: integer read GetMilliseconds write SetMilliseconds;
property Time: string read GetTime write SetTime;
end;
implementation
Uses bsUtils, Consts, Printers;
const
WS_EX_LAYERED = $80000;
//=========== TbsSkinUpDown ===============
constructor TbsSkinUpDown.Create;
begin
inherited;
SkinDataName := 'hupdown';
FMin := 0;
FMax := 100;
FIncrement := 1;
FPosition := 0;
Width := 25;
Height := 50;
ActiveButton := -1;
OldActiveButton := -1;
CaptureButton := -1;
TimerMode := 0;
WaitMode := False;
end;
destructor TbsSkinUpDown.Destroy;
begin
inherited;
end;
procedure TbsSkinUpDown.SetOrientation;
begin
FOrientation := Value;
RePaint;
if (csDesigning in ComponentState) and not
(csLoading in ComponentState)
then
begin
if FOrientation = udHorizontal
then FSkinDataName := 'hupdown'
else FSkinDataName := 'vupdown';
end;
end;
procedure TbsSkinUpDown.CreateControlSkinImage;
var
i: Integer;
begin
inherited;
for i := 0 to 1 do DrawButton(B.Canvas, i);
end;
procedure TbsSkinUpDown.WMSIZE;
begin
inherited;
CalcRects;
end;
procedure TbsSkinUpDown.CreateControlDefaultImage;
var
i: Integer;
begin
CalcRects;
for i := 0 to 1 do DrawButton(B.Canvas, i);
end;
procedure TbsSkinUpDown.CMMouseEnter;
begin
ActiveButton := -1;
OldActiveButton := -1;
inherited;
end;
procedure TbsSkinUpDown.CMMouseLeave;
var
i: Integer;
begin
inherited;
for i := 0 to 1 do
if Buttons[i].MouseIn
then
begin
Buttons[i].MouseIn := False;
RePaint;
end;
end;
procedure TbsSkinUpDown.DrawButton;
var
C: TColor;
R1: TRect;
begin
if FIndex = -1
then
with Buttons[i] do
begin
R1 := R;
if Down and MouseIn
then
begin
Frame3D(Cnvs, R1, BS_XP_BTNFRAMECOLOR, BS_XP_BTNFRAMECOLOR, 1);
Cnvs.Brush.Color := BS_XP_BTNDOWNCOLOR;
Cnvs.FillRect(R1);
end
else
if MouseIn
then
begin
Frame3D(Cnvs, R1, BS_XP_BTNFRAMECOLOR, BS_XP_BTNFRAMECOLOR, 1);
Cnvs.Brush.Color := BS_XP_BTNACTIVECOLOR;
Cnvs.FillRect(R1);
end
else
begin
Frame3D(Cnvs, R1, clBtnShadow, clBtnShadow, 1);
Cnvs.Brush.Color := clBtnFace;
Cnvs.FillRect(R1);
end;
C := clBlack;
if FOrientation = udVertical
then
case i of
0: DrawArrowImage(Cnvs, R, C, 3);
1: DrawArrowImage(Cnvs, R, C, 4);
end
else
case i of
1: DrawArrowImage(Cnvs, R, C, 1);
0: DrawArrowImage(Cnvs, R, C, 2);
end
end
else
with Buttons[i] do
begin
R1 := NullRect;
case I of
0:
begin
if Down and MouseIn
then R1 := DownUpButtonRect
else if MouseIn then R1 := ActiveUpButtonRect;
end;
1:
begin
if Down and MouseIn
then R1 := DownDownButtonRect
else if MouseIn then R1 := ActiveDownButtonRect;
end
end;
if not IsNullRect(R1)
then
Cnvs.CopyRect(R, Picture.Canvas, R1);
end;
end;
procedure TbsSkinUpDown.MouseDown;
begin
TestActive(X, Y);
if ActiveButton <> -1
then
begin
CaptureButton := ActiveButton;
ButtonDown(ActiveButton, X, Y);
end;
inherited;
end;
procedure TbsSkinUpDown.MouseUp;
begin
if CaptureButton <> -1
then ButtonUp(CaptureButton, X, Y);
CaptureButton := -1;
inherited;
end;
procedure TbsSkinUpDown.MouseMove;
begin
TestActive(X, Y);
inherited;
end;
procedure TbsSkinUpDown.TestActive(X, Y: Integer);
var
i, j: Integer;
begin
j := -1;
OldActiveButton := ActiveButton;
for i := 0 to 1 do
begin
if PointInRect(Buttons[i].R, Point(X, Y))
then
begin
j := i;
Break;
end;
end;
ActiveButton := j;
if (CaptureButton <> -1) and
(ActiveButton <> CaptureButton) and (ActiveButton <> -1)
then
ActiveButton := -1;
if (OldActiveButton <> ActiveButton)
then
begin
if OldActiveButton <> - 1
then
ButtonLeave(OldActiveButton);
if ActiveButton <> -1
then
ButtonEnter(ActiveButton);
end;
end;
procedure TbsSkinUpDown.ButtonDown;
begin
Buttons[i].MouseIn := True;
Buttons[i].Down := True;
RePaint;
if FIncrement <> 0
then
begin
case i of
0: TimerMode := 2;
1: TimerMode := 1;
end;
WaitMode := True;
SetTimer(Handle, 1, 500, nil);
end;
end;
procedure TbsSkinUpDown.ButtonUp;
begin
Buttons[i].Down := False;
if ActiveButton <> i then Buttons[i].MouseIn := False;
RePaint;
if Buttons[i].MouseIn
then
case i of
0:
begin
if FIncrement <> 0 then Position := Position + FIncrement;
if Assigned(FOnUpButtonClick) then FOnUpButtonClick(Self);
end;
1:
begin
if FIncrement <> 0 then Position := Position - FIncrement;
if Assigned(FOnDownButtonClick) then FOnDownButtonClick(Self);
end;
end;
if FIncrement <> 0 then StopTimer;
end;
procedure TbsSkinUpDown.ButtonEnter(I: Integer);
begin
Buttons[i].MouseIn := True;
RePaint;
if (FIncrement <> 0) and Buttons[i].Down then SetTimer(Handle, 1, 50, nil);
end;
procedure TbsSkinUpDown.ButtonLeave(I: Integer);
begin
Buttons[i].MouseIn := False;
RePaint;
if (FIncrement <> 0) and Buttons[i].Down then KillTimer(Handle, 1);
end;
procedure TbsSkinUpDown.CalcRects;
var
OX: Integer;
NewClRect: TRect;
begin
if FIndex = -1
then
begin
if FOrientation = udVertical
then
begin
Buttons[0].R := Rect(0, 0, Width, Height div 2);
Buttons[1].R := Rect(0, Height div 2, Width, Height);
end
else
begin
Buttons[1].R := Rect(0, 0, Width div 2, Height);
Buttons[0].R := Rect(Width div 2, 0, Width, Height);
end;
end
else
begin
Buttons[0].R := UpButtonRect;
Buttons[1].R := DownButtonRect;
end;
end;
procedure TbsSkinUpDown.StartTimer;
begin
KillTimer(Handle, 1);
SetTimer(Handle, 1, 100, nil);
end;
procedure TbsSkinUpDown.StopTimer;
begin
KillTimer(Handle, 1);
TimerMode := 0;
end;
procedure TbsSkinUpDown.WMTimer;
var
CanScroll: Boolean;
begin
inherited;
if WaitMode
then
begin
WaitMode := False;
StartTimer;
Exit;
end;
case TimerMode of
1: Position := Position - FIncrement;
2: Position := Position + FIncrement;
end;
end;
procedure TbsSkinUpDown.GetSkinData;
begin
inherited;
if FIndex <> -1
then
if TbsDataSkinControl(FSD.CtrlList.Items[FIndex]) is TbsDataSkinUpDownControl
then
with TbsDataSkinUpDownControl(FSD.CtrlList.Items[FIndex]) do
begin
Self.UpButtonRect := UpButtonRect;
Self.ActiveUpButtonRect := ActiveUpButtonRect;
Self.DownUpButtonRect := DownUpButtonRect;
if IsNullRect(Self.DownUpButtonRect)
then Self.DownUpButtonRect := Self.ActiveUpButtonRect;
Self.DownButtonRect := DownButtonRect;
Self.ActiveDownButtonRect := ActiveDownButtonRect;
Self.DownDownButtonRect := DownDownButtonRect;
if IsNullRect(Self.DownDownButtonRect)
then Self.DownDownButtonRect := Self.ActiveDownButtonRect;
LTPt := Point(0, 0);
RTPt := Point(0, 0);
LBPt := Point(0, 0);
RBPt := Point(0, 0);
ClRect := NullRect;
end;
CalcRects;
end;
procedure TbsSkinUpDown.SetIncrement;
begin
FIncrement := Value;
end;
procedure TbsSkinUpDown.SetPosition;
begin
if (Value <= FMax) and (Value >= FMin)
then
begin
FPosition := Value;
if not (csDesigning in ComponentState) and Assigned(FOnChange)
then
FOnChange(Self);
end;
end;
procedure TbsSkinUpDown.SetMin;
begin
FMin := Value;
if FPosition < FMin then FPosition := FMin;
end;
procedure TbsSkinUpDown.SetMax;
begin
FMax := Value;
if FPosition > FMax then FPosition := FMax;
end;
constructor TbsSkinSpinEdit.Create(AOwner: TComponent);
begin
inherited;
ControlStyle := [csCaptureMouse, csOpaque, csDoubleClicks, csAcceptsControls];
ActiveButton := -1;
OldActiveButton := -1;
CaptureButton := -1;
FValue := 0;
FromEdit := False;
FEdit := TbsSkinNumEdit.Create(Self);
FEdit.Font.Assign(FDefaultFont);
FIncrement := 1;
FDecimal := 2;
TimerMode := 0;
WaitMode := False;
FEdit.Parent := Self;
FEdit.AutoSize := False;
FEdit.Visible := True;
FEdit.EditTransparent := False;
FEdit.OnChange := EditChange;
FEdit.OnUpClick := UpClick;
FEdit.OnDownClick := DownClick;
FEdit.OnKeyUp := EditKeyUp;
FEdit.OnKeyDown := EditKeyDown;
FEdit.OnKeyPress := EditKeyPress;
FEdit.OnEnter := EditEnter;
FEdit.OnExit := EditExit;
StopCheck := True;
Text := '0';
StopCheck := False;
Width := 120;
Height := 20;
FSkinDataName := 'spinedit';
end;
destructor TbsSkinSpinEdit.Destroy;
begin
FEdit.Free;
inherited;
end;
procedure TbsSkinSpinEdit.SetValueType(NewType: TbsValueType);
begin
if FValueType <> NewType
then
begin
FEdit.Float := ValueType = vtFloat;
FValueType := NewType;
if FValueType = vtInteger
then
begin
FIncrement := Round(FIncrement);
if FIncrement = 0 then FIncrement := 1;
end;
end;
FEdit.Float := ValueType = vtFloat;
end;
procedure TbsSkinSpinEdit.SetDecimal(NewValue: Byte);
begin
if FDecimal <> NewValue then begin
FDecimal := NewValue;
end;
end;
procedure TbsSkinSpinEdit.Change;
begin
if Assigned(FOnChange) then FOnChange(Self);
end;
procedure TbsSkinSpinEdit.DefaultFontChange;
begin
if (FIndex = -1) and (FEdit <> nil) then FEdit.Font.Assign(FDefaultFont);
end;
procedure TbsSkinSpinEdit.GetSkinData;
begin
inherited;
if FIndex <> -1
then
if TbsDataSkinControl(FSD.CtrlList.Items[FIndex]) is TbsDataSkinSpinEditControl
then
with TbsDataSkinSpinEditControl(FSD.CtrlList.Items[FIndex]) do
begin
Self.FontName := FontName;
Self.FontStyle := FontStyle;
Self.FontHeight := FontHeight;
Self.FontColor := FontColor;
Self.UpButtonRect := UpButtonRect;
Self.ActiveUpButtonRect := ActiveUpButtonRect;
Self.DownUpButtonRect := DownUpButtonRect;
if IsNullRect(Self.DownUpButtonRect)
then Self.DownUpButtonRect := Self.ActiveUpButtonRect;
Self.DownButtonRect := DownButtonRect;
Self.ActiveDownButtonRect := ActiveDownButtonRect;
Self.DownDownButtonRect := DownDownButtonRect;
if IsNullRect(Self.DownDownButtonRect)
then Self.DownDownButtonRect := Self.ActiveDownButtonRect;
end;
end;
procedure TbsSkinSpinEdit.ChangeSkinData;
begin
inherited;
if FIndex <> -1
then
with FEdit.Font do
begin
if FUseSkinFont
then
begin
Style := FontStyle;
Color := FontColor;
Height := FontHeight;
Name := FontName;
CharSet := FDefaultFont.CharSet;
end
else
begin
Assign(FDefaultFont);
Color := FontColor;
end;
end
else
FEdit.Font.Assign(FDefaultFont);
if FIndex <> -1
then
begin
FEdit.EditTransparent := True;
Height := RectHeight(SkinRect);
end
else
begin
FEdit.EditTransparent := False;
end;
CalcRects;
RePaint;
end;
procedure TbsSkinSpinEdit.EditEnter;
begin
if Assigned(FOnEditEnter) then FOnEditEnter(Self);
end;
procedure TbsSkinSpinEdit.EditExit;
begin
if Assigned(FOnEditExit) then FOnEditExit(Self);
end;
procedure TbsSkinSpinEdit.EditKeyDown;
begin
if Assigned(FOnEditKeyDown) then FOnEditKeyDown(Self, Key, Shift);
end;
procedure TbsSkinSpinEdit.EditKeyUp;
begin
if Assigned(FOnEditKeyUp) then FOnEditKeyUp(Self, Key, Shift);
end;
procedure TbsSkinSpinEdit.EditKeyPress;
begin
if Assigned(FOnEditKeyPress) then FOnEditKeyPress(Self, Key);
end;
procedure TbsSkinSpinEdit.UpClick;
begin
Value := Value + FIncrement;
end;
procedure TbsSkinSpinEdit.DownClick;
begin
Value := Value - FIncrement;
end;
procedure TbsSkinSpinEdit.SetMaxLength;
begin
FEdit.MaxLength := AValue;
end;
function TbsSkinSpinEdit.GetMaxLength;
begin
Result := FEdit.MaxLength;
end;
procedure TbsSkinSpinEdit.SetEditorEnabled;
begin
FEdit.EditorEnabled := AValue;
end;
function TbsSkinSpinEdit.GetEditorEnabled;
begin
Result := FEdit.EditorEnabled;
end;
procedure TbsSkinSpinEdit.StartTimer;
begin
KillTimer(Handle, 1);
SetTimer(Handle, 1, 100, nil);
end;
procedure TbsSkinSpinEdit.StopTimer;
begin
KillTimer(Handle, 1);
TimerMode := 0;
end;
function TbsSkinSpinEdit.CheckValue;
begin
Result := NewValue;
if (FMaxValue <> FMinValue)
then
begin
if NewValue < FMinValue then
Result := FMinValue
else if NewValue > FMaxValue then
Result := FMaxValue;
end;
end;
procedure TbsSkinSpinEdit.WMTimer;
var
CanScroll: Boolean;
begin
inherited;
if WaitMode
then
begin
WaitMode := False;
StartTimer;
Exit;
end;
case TimerMode of
1: Value := Value - FIncrement;
2: Value := Value + FIncrement;
end;
end;
procedure TbsSkinSpinEdit.SetMinValue;
begin
FMinValue := AValue;
end;
procedure TbsSkinSpinEdit.SetMaxValue;
begin
FMaxValue := AValue;
end;
procedure TbsSkinSpinEdit.CMMouseEnter;
begin
inherited;
TestActive(-1, -1);
end;
function TbsSkinSpinEdit.IsNumText;
function GetMinus: Boolean;
var
i: Integer;
S: String;
begin
S := AText;
i := Pos('-', S);
if i > 1
then
Result := False
else
begin
Delete(S, i, 1);
Result := Pos('-', S) = 0;
end;
end;
function GetP: Boolean;
var
i: Integer;
S: String;
begin
S := AText;
i := Pos(DecimalSeparator, S);
if i = 1
then
Result := False
else
begin
Delete(S, i, 1);
Result := Pos(DecimalSeparator, S) = 0;
end;
end;
const
EditChars = '01234567890-';
var
i: Integer;
S: String;
begin
S := EditChars;
Result := True;
if ValueType = vtFloat
then
S := S + DecimalSeparator;
if (Text = '') or (Text = '-')
then
begin
Result := False;
Exit;
end;
for i := 1 to Length(Text) do
begin
if Pos(Text[i], S) = 0
then
begin
Result := False;
Break;
end;
end;
Result := Result and GetMinus;
if ValueType = vtFloat
then
Result := Result and GetP;
end;
procedure TbsSkinSpinEdit.CMTextChanged;
var
NewValue: Double;
IsChecked: Boolean;
begin
inherited;
if (FEdit <> nil) and not FromEdit then FEdit.Text := Text;
if not StopCheck and IsNumText(FEdit.Text)
then
begin
if ValueType = vtFloat
then NewValue := CheckValue(StrToFloat(FEdit.Text))
else NewValue := CheckValue(StrToInt(FEdit.Text));
if NewValue <> FValue
then
begin
FValue := NewValue;
Change;
end;
if (ValueType = vtFloat) and (NewValue <> StrToFloat(FEdit.Text))
then
FEdit.Text := FloatToStrF(Value, ffFixed, 15, FDecimal)
else
if (ValueType = vtInteger) and (NewValue <> StrToInt(FEdit.Text))
then
FEdit.Text := IntToStr(Round(Value));
end;
end;
procedure TbsSkinSpinEdit.CMMouseLeave;
var
i: Integer;
begin
inherited;
for i := 0 to 1 do
if Buttons[i].MouseIn
then
begin
Buttons[i].MouseIn := False;
RePaint;
end;
end;
procedure TbsSkinSpinEdit.EditChange;
begin
FromEdit := True;
Text := FEdit.Text;
FromEdit := False;
end;
procedure TbsSkinSpinEdit.Invalidate;
begin
inherited;
if (FIndex <> -1) and (FEdit <> nil) then FEdit.Invalidate;
end;
procedure TbsSkinSpinEdit.WMSIZE;
begin
inherited;
CalcRects;
end;
procedure TbsSkinSpinEdit.TestActive(X, Y: Integer);
var
i, j: Integer;
begin
j := -1;
OldActiveButton := ActiveButton;
for i := 0 to 1 do
begin
if PtInRect(Buttons[i].R, Point(X, Y))
then
begin
j := i;
Break;
end;
end;
ActiveButton := j;
if (CaptureButton <> -1) and
(ActiveButton <> CaptureButton) and (ActiveButton <> -1)
then
ActiveButton := -1;
if (OldActiveButton <> ActiveButton)
then
begin
if OldActiveButton <> - 1
then
ButtonLeave(OldActiveButton);
if ActiveButton <> -1
then
ButtonEnter(ActiveButton);
end;
end;
procedure TbsSkinSpinEdit.ButtonDown;
begin
Buttons[i].MouseIn := True;
Buttons[i].Down := True;
RePaint;
case i of
0: TimerMode := 2;
1: TimerMode := 1;
end;
WaitMode := True;
SetTimer(Handle, 1, 500, nil);
end;
procedure TbsSkinSpinEdit.ButtonUp;
begin
Buttons[i].Down := False;
if ActiveButton <> i then Buttons[i].MouseIn := False;
RePaint;
if Buttons[i].MouseIn
then
case i of
0: Value := Value + FIncrement;
1: Value := Value - FIncrement;
end;
StopTimer;
end;
procedure TbsSkinSpinEdit.ButtonEnter(I: Integer);
begin
Buttons[i].MouseIn := True;
RePaint;
if Buttons[i].Down then SetTimer(Handle, 1, 50, nil);
end;
procedure TbsSkinSpinEdit.ButtonLeave(I: Integer);
begin
Buttons[i].MouseIn := False;
RePaint;
if Buttons[i].Down then KillTimer(Handle, 1);
end;
procedure TbsSkinSpinEdit.CalcRects;
const
ButtonW = 15;
var
OX: Integer;
NewClRect: TRect;
begin
if FIndex = -1
then
begin
Buttons[0].R := Rect(Width - ButtonW - 2, 2, Width - 2, Height div 2);
Buttons[1].R := Rect(Width - ButtonW - 2, Height div 2, Width - 2, Height - 2);
FEdit.SetBounds(2, 2, Width - ButtonW - 4, Height - 4);
end
else
begin
OX := Width - RectWidth(SkinRect);
Buttons[0].R := UpButtonRect;
if Buttons[0].R.Left > RTPt.X
then OffsetRect(Buttons[0].R, OX, 0);
Buttons[1].R := DownButtonRect;
if Buttons[1].R.Left > RTPt.X
then OffsetRect(Buttons[1].R, OX, 0);
NewClRect := Rect(ClRect.Left, ClRect.Top,
ClRect.Right + OX, ClRect.Bottom);
FEdit.SetBounds(NewClRect.Left, NewClRect.Top,
RectWidth(NewClRect), RectHeight(NewClRect));
end;
end;
procedure TbsSkinSpinEdit.SimpleSetValue(AValue: Double);
begin
FValue := CheckValue(AValue);
StopCheck := True;
if ValueType = vtFloat
then
Text := FloatToStrF(CheckValue(AValue), ffFixed, 15, FDecimal)
else
Text := IntToStr(Round(CheckValue(AValue)));
StopCheck := False;
end;
procedure TbsSkinSpinEdit.SetValue;
begin
FValue := CheckValue(AValue);
StopCheck := True;
if ValueType = vtFloat
then
Text := FloatToStrF(CheckValue(AValue), ffFixed, 15, FDecimal)
else
Text := IntToStr(Round(CheckValue(AValue)));
StopCheck := False;
Change;
end;
procedure TbsSkinSpinEdit.CreateControlSkinImage;
var
i: Integer;
begin
inherited;
for i := 0 to 1 do DrawButton(B.Canvas, i);
end;
procedure TbsSkinSpinEdit.DrawButton;
var
C: TColor;
kf: Double;
R1: TRect;
begin
if FIndex = -1
then
with Buttons[i] do
begin
R1 := R;
if Down and MouseIn
then
begin
Frame3D(Cnvs, R1, BS_XP_BTNFRAMECOLOR, BS_XP_BTNFRAMECOLOR, 1);
Cnvs.Brush.Color := BS_XP_BTNDOWNCOLOR;
Cnvs.FillRect(R1);
end
else
if MouseIn
then
begin
Frame3D(Cnvs, R1, BS_XP_BTNFRAMECOLOR, BS_XP_BTNFRAMECOLOR, 1);
Cnvs.Brush.Color := BS_XP_BTNACTIVECOLOR;
Cnvs.FillRect(R1);
end
else
begin
Cnvs.Brush.Color := clBtnFace;
Cnvs.FillRect(R1);
end;
C := clBlack;
case i of
0: DrawArrowImage(Cnvs, R1, C, 3);
1: DrawArrowImage(Cnvs, R1, C, 4);
end;
end
else
with Buttons[i] do
begin
R1 := NullRect;
case I of
0:
begin
if Down and MouseIn
then R1 := DownUpButtonRect
else if MouseIn then R1 := ActiveUpButtonRect;
end;
1:
begin
if Down and MouseIn
then R1 := DownDownButtonRect
else if MouseIn then R1 := ActiveDownButtonRect;
end
end;
if not IsNullRect(R1)
then
Cnvs.CopyRect(R, Picture.Canvas, R1);
end;
end;
procedure TbsSkinSpinEdit.CreateControlDefaultImage;
var
R: TRect;
i: Integer;
begin
with B.Canvas do
begin
R := Rect(0, 0, Width, Height);
Frame3D(B.Canvas, R, clBtnShadow, clBtnShadow, 1);
Frame3D(B.Canvas, R, clBtnFace, clBtnFace, 1);
end;
for i := 0 to 1 do DrawButton(B.Canvas, i);
end;
procedure TbsSkinSpinEdit.MouseDown;
begin
TestActive(X, Y);
if ActiveButton <> -1
then
begin
CaptureButton := ActiveButton;
ButtonDown(ActiveButton, X, Y);
end;
inherited;
end;
procedure TbsSkinSpinEdit.MouseUp;
begin
if CaptureButton <> -1
then ButtonUp(CaptureButton, X, Y);
CaptureButton := -1;
inherited;
end;
procedure TbsSkinSpinEdit.MouseMove;
begin
inherited;
TestActive(X, Y);
end;
constructor TbsPopupListBox.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
ControlStyle := ControlStyle + [csNoDesignVisible, csReplicatable,
csAcceptsControls];
Ctl3D := False;
ParentCtl3D := False;
Visible := False;
FOldAlphaBlend := False;
FOldAlphaBlendValue := 0;
end;
procedure TbsPopupListBox.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
with Params do begin
Style := WS_POPUP or WS_CLIPCHILDREN;
ExStyle := WS_EX_TOOLWINDOW;
WindowClass.Style := WindowClass.Style or CS_SAVEBITS;
end;
end;
procedure TbsPopupListBox.WMMouseActivate(var Message: TMessage);
begin
Message.Result := MA_NOACTIVATE;
end;
procedure TbsPopupListBox.Hide;
begin
SetWindowPos(Handle, 0, 0, 0, 0, 0, SWP_NOZORDER or
SWP_NOMOVE or SWP_NOSIZE or SWP_NOACTIVATE or SWP_HIDEWINDOW);
Visible := False;
end;
procedure TbsPopupListBox.Show(Origin: TPoint);
var
PLB: TbsSkinCustomComboBox;
I: Integer;
begin
//
if CheckW2KWXP and (Owner is TbsSkinCustomComboBox)
then
begin
PLB := TbsSkinCustomComboBox(Owner);
if PLB.AlphaBlend and not FOldAlphaBlend
then
begin
SetWindowLong(Handle, GWL_EXSTYLE,
GetWindowLong(Handle, GWL_EXSTYLE) or WS_EX_LAYERED);
end
else
if not PLB.AlphaBlend and FOldAlphaBlend
then
begin
SetWindowLong(Handle, GWL_EXSTYLE,
GetWindowLong(Handle, GWL_EXSTYLE) and (not WS_EX_LAYERED));
end;
FOldAlphaBlend := PLB.AlphaBlend;
if (FOldAlphaBlendValue <> PLB.AlphaBlendValue) and PLB.AlphaBlend
then
begin
if PLB.AlphaBlendAnimation
then
begin
SetAlphaBlendTransparent(Handle, 0);
FOldAlphaBlendValue := 0;
end
else
begin
SetAlphaBlendTransparent(Handle, PLB.AlphaBlendValue);
FOldAlphaBlendValue := PLB.AlphaBlendValue;
end;
end;
end;
//
SetWindowPos(Handle, HWND_TOP, Origin.X, Origin.Y, 0, 0,
SWP_NOACTIVATE or SWP_SHOWWINDOW or SWP_NOSIZE);
Visible := True;
if PLB.AlphaBlendAnimation and PLB.AlphaBlend and CheckW2KWXP
then
begin
Application.ProcessMessages;
I := 0;
repeat
Inc(i, 2);
if i > PLB.AlphaBlendValue then i := PLB.AlphaBlendValue;
SetAlphaBlendTransparent(Handle, i);
until i >= PLB.FAlphaBlendValue;
end;
end;
constructor TbsCustomEdit.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
ControlStyle := ControlStyle + [csOpaque];
FEditTransparent := False;
end;
procedure TbsCustomEdit.CMCancelMode;
begin
inherited;
if Assigned(FOnEditCancelMode)
then FOnEditCancelMode(Message.Sender);
end;
procedure TbsCustomEdit.SetEditTransparent(Value: Boolean);
begin
FEditTransparent := Value;
ReCreateWnd;
end;
procedure TbsCustomEdit.WMSetFont;
begin
inherited;
SendMessage(Handle, EM_SETMARGINS, EC_LEFTMARGIN or EC_RIGHTMARGIN, MakeLong(2, 0));
end;
procedure TbsCustomEdit.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
with Params do
begin
Style := Style and not WS_BORDER;
ExStyle := ExStyle and not WS_EX_CLIENTEDGE;
if FEditTransparent then ExStyle := ExStyle or WS_EX_TRANSPARENT;
end;
end;
procedure TbsCustomEdit.WMCHAR;
begin
if not FReadOnly then inherited;
end;
procedure TbsCustomEdit.CNCTLCOLOREDIT(var Message:TWMCTLCOLOREDIT);
begin
if FEditTransparent
then
begin
with Message do
begin
SetBkMode(ChildDC, Windows.Transparent);
SetTextColor(ChildDC, Font.Color);
Result := GetStockObject(HOLLOW_BRUSH);
end
end
else
inherited;
end;
procedure TbsCustomEdit.WMEraseBkgnd(var Message: TWMEraseBkgnd);
begin
if FEditTransparent then Invalidate else inherited;
end;
procedure TbsCustomEdit.Invalidate;
var
R: TRect;
begin
if FEditTransparent
then
begin
if Parent = nil then Exit;
R := ClientRect;
R.TopLeft := Parent.ScreenToClient(ClientToScreen(R.TopLeft));
R.BottomRight := Parent.ScreenToClient(ClientToScreen(R.BottomRight));
InvalidateRect(Parent.Handle, @R, True);
RedrawWindow(Handle, nil, 0, RDW_FRAME + RDW_INVALIDATE);
end
else
inherited;
end;
procedure TbsCustomEdit.Change;
begin
inherited;
if FEditTransparent then Invalidate;
end;
procedure TbsCustomEdit.WMKeyDown(var Message: TWMKeyDown);
begin
if FReadOnly and (Message.CharCode = VK_DELETE) then Exit;
inherited;
if FEditTransparent then Invalidate;
end;
procedure TbsCustomEdit.WMKeyUp;
begin
inherited;
end;
procedure TbsCustomEdit.WMSetText(var Message:TWMSetText);
begin
inherited;
if FEditTransparent then Invalidate;
end;
procedure TbsCustomEdit.WMMove(var Message: TMessage);
begin
inherited;
if FEditTransparent then Invalidate;
end;
procedure TbsCustomEdit.WMCut(var Message: TMessage);
begin
if FReadOnly then Exit;
inherited;
if FEditTransparent then Invalidate;
end;
procedure TbsCustomEdit.WMPaste(var Message: TMessage);
begin
if FReadOnly then Exit;
inherited;
if FEditTransparent then Invalidate;
end;
procedure TbsCustomEdit.WMClear(var Message: TMessage);
begin
if FReadOnly then Exit;
inherited;
if FEditTransparent then Invalidate;
end;
procedure TbsCustomEdit.WMUndo(var Message: TMessage);
begin
if FReadOnly then Exit;
inherited;
if FEditTransparent then Invalidate;
end;
procedure TbsCustomEdit.WMLButtonDown(var Message: TMessage);
begin
inherited;
FDown := True;
if FEditTransparent then Invalidate;
end;
procedure TbsCustomEdit.WMSETFOCUS;
begin
inherited;
if FEditTransparent then Invalidate;
end;
procedure TbsCustomEdit.WMKILLFOCUS;
begin
inherited;
if FEditTransparent then Invalidate;
end;
procedure TbsCustomEdit.WMMOUSEMOVE;
begin
inherited;
if FDown and EditTransparent then Invalidate;
end;
procedure TbsCustomEdit.WMLButtonUp;
begin
inherited;
FDown := False;
end;
constructor TbsSkinNumEdit.Create(AOwner: TComponent);
begin
inherited;
FEditorEnabled := True;
end;
procedure TbsSkinNumEdit.WMMOUSEWHEEL;
begin
if Message.WParam > 0
then
begin
if Assigned(FOnDownClick) then FOnDownClick(Self);
end
else
begin
if Assigned(FOnUpClick) then FOnUpClick(Self);
end;
end;
procedure TbsSkinNumEdit.KeyDown(var Key: Word; Shift: TShiftState);
begin
if Key = VK_UP
then
begin
if Assigned(FOnUpClick) then FOnUpClick(Self);
end
else
if Key = VK_DOWN
then
begin
if Assigned(FOnDownClick) then FOnDownClick(Self);
end
else
inherited KeyDown(Key, Shift);
end;
procedure TbsSkinNumEdit.KeyPress(var Key: Char);
begin
if not IsValidChar(Key) then
begin
Key := #0;
MessageBeep(0)
end;
if Key <> #0 then inherited KeyPress(Key);
end;
function TbsSkinNumEdit.IsValidChar(Key: Char): Boolean;
begin
if FLoat
then
Result := (Key in [DecimalSeparator, '-', '0'..'9']) or
((Key < #32) and (Key <> Chr(VK_RETURN)))
else
Result := (Key in ['-', '0'..'9']) or
((Key < #32) and (Key <> Chr(VK_RETURN)));
if not FEditorEnabled and Result and ((Key >= #32) or
(Key = Char(VK_BACK)) or (Key = Char(VK_DELETE)))
then
Result := False;
end;
const
HTEDITBUTTON = HTSIZE + 2;
HTEDITFRAME = HTSIZE + 3;
constructor TbsSkinCustomEdit.Create;
begin
inherited Create(AOwner);
ControlStyle := ControlStyle + [csOpaque];
AutoSize := False;
FIndex := -1;
Font.Name := 'Arial';
Font.Color := clWindowText;
Font.Style := [];
Font.Height := 14;
Height := 20;
BorderStyle := bsNone;
Picture := nil;
EditTransparent := True;
FSkinDataName := 'edit';
FDefaultFont := TFont.Create;
FDefaultFont.OnChange := OnDefaultFontChange;
FDefaultFont.Assign(Font);
FDefaultWidth := 0;
FDefaultHeight := 20;
FUseSkinFont := True;
end;
destructor TbsSkinCustomEdit.Destroy;
begin
FDefaultFont.Free;
inherited;
end;
procedure TbsSkinCustomEdit.CMEnabledChanged;
begin
inherited;
Invalidate;
end;
procedure TbsSkinCustomEdit.SetAlignment(Value: TAlignment);
begin
if FAlignment <> Value then
begin
FAlignment := Value;
RecreateWnd;
end;
end;
procedure TbsSkinCustomEdit.WMPaint;
var
DC: HDC;
FCanvas: TControlCanvas;
PS: TPaintStruct;
i, TX, TY: Integer;
S: String;
begin
if not Enabled
then
begin
S := Text;
if Self.EditPasswordChar <> #0
then
for i := 1 to Length(S) do S[i] := EditPasswordChar;
GetSkinData;
FCanvas := TControlCanvas.Create;
DC := Message.DC;
if DC = 0 then DC := BeginPaint(Handle, PS);
FCanvas.Handle := DC;
try
with FCanvas do
begin
Brush.Style := bsClear;
if (FIndex = -1) or not FUseSkinFont
then
begin
Font := DefaultFont;
Font.Color := clGrayText;
end
else
begin
Font.Name := FontName;
Font.Height := FontHeight;
Font.Color := DisabledFontColor;
Font.Style := FontStyle;
Font.CharSet := FDefaultFont.CharSet;
end;
TY := FEditRect.Top - 2;
TX := FEditRect.Left;
case Alignment of
taCenter:
TX := TX + RectWidth(FEditRect) div 2 - TextWidth(S) div 2 - 1;
taRightJustify:
TX := FEditRect.Right - 3 - TextWidth(S);
end;
TextRect(FEditRect, TX, TY, S);
end;
finally
FCanvas.Handle := 0;
if Message.DC = 0 then EndPaint(Handle, PS);
FCanvas.Free;
end;
end
else
inherited;
end;
procedure TbsSkinCustomEdit.SetDefaultWidth;
begin
FDefaultWidth := Value;
if (FIndex = -1) and (FDefaultWidth > 0) then Width := FDefaultWidth;
end;
procedure TbsSkinCustomEdit.SetDefaultHeight;
begin
FDefaultHeight := Value;
if (FIndex = -1) and (FDefaultHeight > 0) then Height := FDefaultHeight;
end;
procedure TbsSkinCustomEdit.SetDefaultFont;
begin
FDefaultFont.Assign(Value);
if FIndex = -1 then Font.Assign(Value);
end;
procedure TbsSkinCustomEdit.OnDefaultFontChange(Sender: TObject);
begin
if FIndex = -1 then Font.Assign(FDefaultFont);
end;
procedure TbsSkinCustomEdit.CalcRects;
var
Off: Integer;
begin
if FIndex = -1
then
begin
if FButtonMode
then
begin
FEditRect := Rect(2, 2, Width - 22, Height - 2);
FButtonRect := Rect(Width - 20, 0, Width, Height);
end
else
FEditRect := Rect(2, 2, Width - 2, Height - 2);
end
else
begin
Off := Width - RectWidth(SkinRect);
FEditRect := ClRect;
Inc(FEditRect.Right, Off);
FButtonRect := ButtonRect;
if ButtonRect.Left >= RectWidth(SkinRect) - ROffset
then OffsetRect(FButtonRect, Off, 0);
end;
end;
procedure TbsSkinCustomEdit.WMMOUSEMOVE;
begin
inherited;
if FButtonMode and FButtonActive
then
begin
FButtonActive := False;
Invalidate;
end;
end;
procedure TbsSkinCustomEdit.WMNCHITTEST;
var
P: TPoint;
BR: TRect;
ER: TRect;
begin
if FButtonMode and not (csDesigning in ComponentState)
then
begin
P.X := Message.XPos;
P.Y := Message.YPos;
P := ScreenToClient(P);
CalcRects;
BR := FButtonRect; Dec(BR.Left); Dec(BR.Top);
ER := FEditRect; Dec(ER.Left); Dec(ER.Top);
if PtInRect(BR, P)
then
Message.Result := HTEDITBUTTON
else
if not PtInRect(ER, P)
then
Message.Result := HTEDITFRAME
else
inherited;
end
else
inherited;
end;
procedure TbsSkinCustomEdit.WMNCLBUTTONDBCLK;
begin
if FButtonMode and (Message.HitTest = HTEDITBUTTON) and
not (csDesigning in ComponentState)
then
begin
FButtonDown := True;
Invalidate;
end
else
inherited;
end;
procedure TbsSkinCustomEdit.WMNCLBUTTONDOWN;
begin
if FButtonMode and (Message.HitTest = HTEDITBUTTON) and
not (csDesigning in ComponentState)
then
begin
FButtonDown := True;
Invalidate;
end
else
inherited;
end;
procedure TbsSkinCustomEdit.WMNCLBUTTONUP;
begin
if FButtonMode and (Message.HitTest = HTEDITBUTTON) and
not (csDesigning in ComponentState)
then
begin
FButtonDown := False;
Invalidate;
if not Focused then SetFocus;
if Assigned(FOnButtonClick) then FOnButtonClick(Self);
end
else
inherited;
end;
procedure TbsSkinCustomEdit.WMNCMOUSEMOVE;
begin
if FButtonMode and not (csDesigning in ComponentState)
then
begin
if Message.HitTest = HTEDITBUTTON
then
begin
if not FButtonActive
then
begin
FButtonActive := True;
Invalidate;
end
end
else
begin
if FButtonActive
then
begin
FButtonActive := False;
Invalidate;
end;
inherited;
end
end
else
inherited;
end;
procedure TbsSkinCustomEdit.SetButtonMode;
begin
FButtonMode := Value;
ReCreateWnd;
if (csDesigning in ComponentState) and not
(csLoading in ComponentState)
then
begin
if FButtonMode
then FSkinDataName := 'buttonedit'
else FSkinDataName := 'edit';
end;
end;
procedure TbsSkinCustomEdit.SetPasswordChar(Value: Char);
begin
PasswordChar := Value;
ReCreateWnd;
end;
function TbsSkinCustomEdit.GetPasswordChar;
begin
Result := PasswordChar;
end;
procedure TbsSkinCustomEdit.Invalidate;
begin
if Parent = nil then Exit;
RedrawWindow(Handle, nil, 0, RDW_FRAME + RDW_INVALIDATE);
end;
procedure TbsSkinCustomEdit.WMSETFOCUS;
begin
inherited;
if not FMouseIn and (FIndex <> -1) then Font.Color := ActiveFontColor;
end;
procedure TbsSkinCustomEdit.WMKILLFOCUS;
begin
inherited;
if not FMouseIn and (FIndex <> -1) then Font.Color := FontColor;
end;
procedure TbsSkinCustomEdit.CMMouseEnter;
begin
inherited;
FMouseIn := True;
if not Focused and (FIndex <> -1) then Font.Color := ActiveFontColor;
if (not Focused) then Invalidate;
if Assigned(FOnMouseEnter) then FOnMouseEnter(Self);
end;
procedure TbsSkinCustomEdit.CMMouseLeave;
begin
inherited;
FMouseIn := False;
if not Focused and (FIndex <> -1) then Font.Color := FontColor;
if not Focused then Invalidate;
if FButtonDown or FButtonActive
then
begin
FButtonActive := False;
FButtonDown := False;
Invalidate;
end;
if Assigned(FOnMouseLeave) then FOnMouseLeave(Self);
end;
procedure TbsSkinCustomEdit.SetBounds;
var
UpDate: Boolean;
begin
GetSkinData;
UpDate := ((Width <> AWidth) or (Height <> AHeight)) and (FIndex <> -1);
if UpDate then AHeight := RectHeight(SkinRect);
inherited;
Invalidate;
end;
procedure TbsSkinCustomEdit.WMNCCALCSIZE;
begin
GetSkinData;
if FIndex = -1
then
with Message.CalcSize_Params^.rgrc[0] do
begin
Inc(Left, 2);
Inc(Top, 2);
if FButtonMode
then Dec(Right, 22)
else Dec(Right, 2);
Dec(Bottom, 2);
end
else
with Message.CalcSize_Params^.rgrc[0] do
begin
Inc(Left, ClRect.Left);
Inc(Top, ClRect.Top);
Dec(Right, RectWidth(SkinRect) - ClRect.Right);
Dec(Bottom, RectHeight(SkinRect) - ClRect.Bottom);
end;
end;
procedure TbsSkinCustomEdit.CreateParams(var Params: TCreateParams);
const
Alignments: array[TAlignment] of DWORD = (ES_LEFT, ES_RIGHT, ES_CENTER);
begin
inherited CreateParams(Params);
with Params do
begin
ExStyle := Exstyle and not WS_EX_Transparent;
Style := Style and not WS_BORDER and not ES_MULTILINE or Alignments[FAlignment];
if PasswordChar <> #0 then Style := Style or ES_PASSWORD;
end;
end;
procedure TbsSkinCustomEdit.DrawSkinEdit;
var
R: TRect;
TX, TY, Offset: Integer;
BR: TRect;
B: TBitMap;
begin
GetSkinData;
CalcRects;
if FButtonMode then Offset := Width - FButtonRect.Left else Offset := 0;
B := TBitMap.Create;
B.Width := Width;
B.Height := Height;
try
if FIndex = -1
then
with B.Canvas do
begin
Brush.Color := clWindow;
// draw frame
R := Rect(0, 0, Width - Offset, Height);
if FMouseIn or Focused
then
begin
Frame3D(B.Canvas, R, clBtnShadow, clBtnShadow, 1);
Frame3D(B.Canvas, R, clBtnFace, clBtnFace, 1);
end
else
begin
Frame3D(B.Canvas, R, clBtnFace, clBtnFace, 1);
Frame3D(B.Canvas, R, clBtnShadow, clBtnShadow, 1);
end;
// draw button
if FButtonMode
then
begin
CalcRects;
R := FButtonRect;
if FButtonDown and FButtonActive
then
begin
Frame3D(B.Canvas, R, BS_XP_BTNFRAMECOLOR, BS_XP_BTNFRAMECOLOR, 1);
Brush.Color := BS_XP_BTNDOWNCOLOR;
FillRect(R);
end
else
if FButtonActive
then
begin
Frame3D(B.Canvas, R, BS_XP_BTNFRAMECOLOR, BS_XP_BTNFRAMECOLOR, 1);
Brush.Color := BS_XP_BTNACTIVECOLOR;
FillRect(R);
end
else
begin
Frame3D(B.Canvas, R, clBtnShadow, clBtnShadow, 1);
Brush.Color := clBtnFace;
FillRect(R);
end;
end;
end
else
begin
if FMouseIn or Focused
then
CreateHSkinImage(LOffset, ROffset, B, Picture, ActiveSkinRect, Width,
RectHeight(ActiveSkinRect))
else
CreateHSkinImage(LOffset, ROffset, B, Picture, SkinRect, Width,
RectHeight(SkinRect));
// draw button
if FButtonMode
then
begin
BR := NullRect;
if FButtonDown and FButtonActive
then
BR := DownButtonRect
else if FButtonActive then BR := ActiveButtonRect;
if not IsNullRect(BR) then