Delphi控件源码

开发平台：

Delphi

SkinBoxCtrls.pas：源码内容

{*******************************************************************}
{ }
{ Almediadev Visual Component Library }
{ DynamicSkinForm }
{ Version 4.98 }
{ }
{ }
{ Home: http://www.almdev.com }
{ Support: support@almdev.com }
{ }
{*******************************************************************}
unit SkinBoxCtrls;
{$P+,S-,W-,R-}
{$WARNINGS OFF}
{$HINTS OFF}
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Menus, ExtCtrls, SkinData, spEffBmp, StdCtrls, SkinCtrls, ComCtrls, Mask,
ImgList, spCalendar;
type
TspDrawSkinItemEvent = procedure(Cnvs: TCanvas; Index: Integer;
ItemWidth, ItemHeight: Integer; TextRect: TRect; State: TOwnerDrawState) of object;
TspCBButtonX = record
R: TRect;
MouseIn: Boolean;
Down: Boolean;
end;
TspOnEditCancelMode = procedure(C: TControl) of object;
TspCustomEdit = class(TCustomMaskEdit)
protected
FOnUp: TNotifyEvent;
FOnDown: TNotifyEvent;
FOnKillFocus: TNotifyEvent;
FDown: Boolean;
FReadOnly: Boolean;
FEditTransparent: Boolean;
FOnEditCancelMode: TspOnEditCancelMode;
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: TWMSYSKeyDown); message WM_KEYDOWN;
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: TspOnEditCancelMode
read FOnEditCancelMode write FOnEditCancelMode;
published
{ Published declarations }
end;
TspSkinNumEdit = class(TspCustomEdit)
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 EditorEnabled: Boolean read FEditorEnabled write FEditorEnabled default True;
property OnUpClick: TNotifyEvent read FOnUpClick write FOnUpClick;
property OnDownClick: TNotifyEvent read FOnDownClick write FOnDownClick;
end;
TspSkinCustomEdit = class(TspCustomEdit)
protected
FOnButtonClick: TNotifyEvent;
FButtonRect: TRect;
FButtonMode: Boolean;
FButtonDown: Boolean;
FButtonActive: Boolean;
FEditRect: TRect;
ParentImage: TBitMap;
FMouseIn: Boolean;
FIndex: Integer;
FSD: TspSkinData;
FSkinDataName: String;
FAlphaBlend: Boolean;
FAlphaBlendValue: Byte;
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: TspSkinData);
procedure SetAlphaBlend(AValue: Boolean);
procedure SetAlphaBlendValue(AValue: Byte);
procedure Notification(AComponent: TComponent;
Operation: TOperation); override;
procedure GetSkinData;
procedure WMNCCALCSIZE(var Message: TWMNCCalcSize); message WM_NCCALCSIZE;
procedure CreateParams(var Params: TCreateParams); override;
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;
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;
//
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure ChangeSkinData;
procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
procedure SetParentImage;
procedure Invalidate; override;
property Text;
//
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: TspSkinData read FSD write SetSkinData;
property SkinDataName: String read FSkinDataName write FSkinDataName;
property AlphaBlend: Boolean read FAlphaBlend write SetAlphaBlend;
property AlphaBlendValue: Byte
read FAlphaBlendValue write SetAlphaBlendValue;
//
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 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;
TspSkinEdit = class(TspSkinCustomEdit)
published
property Text;
property DefaultFont;
property UseSkinFont;
property DefaultWidth;
property DefaultHeight;
property ButtonMode;
property SkinData;
property SkinDataName;
property AlphaBlend;
property AlphaBlendValue;
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;
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: 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;
TspSkinMemo = class(TMemo)
protected
FBitMapBG: Boolean;
FReadOnly: Boolean;
FMouseIn: Boolean;
FIndex: Integer;
ParentImage: TBitMap;
FSD: TspSkinData;
FSkinDataName: String;
FAlphaBlend: Boolean;
FAlphaBlendValue: Byte;
Picture: TBitMap;
FOnMouseEnter, FOnMouseLeave: TNotifyEvent;
FVScrollBar: TSpSkinScrollBar;
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: TspSkinScrollBar);
procedure OnVScrollBarChange(Sender: TObject);
procedure SetSkinData(Value: TspSkinData);
procedure SetAlphaBlend(AValue: Boolean);
procedure SetAlphaBlendValue(AValue: Byte);
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;
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 SetParentImage;
procedure Invalidate; override;
published
//
property DefaultFont: TFont read FDefaultFont write SetDefaultFont;
property UseSkinFont: Boolean read FUseSkinFont write FUseSkinFont;
property BitMapBG: Boolean read FBitMapBG write SetBitMapBG;
property VScrollBar: TspSkinScrollBar read FVScrollBar
write SetVScrollBar;
property SkinData: TspSkinData read FSD write SetSkinData;
property SkinDataName: String read FSkinDataName write FSkinDataName;
property Transparent: Boolean read FAlphaBlend write SetAlphaBlend;
property AlphaBlendValue: Byte
read FAlphaBlendValue write SetAlphaBlendValue;
//
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;
TspSkinMemo2 = class(TMemo)
protected
FMouseIn: Boolean;
FIndex: Integer;
FSD: TspSkinData;
FSkinDataName: String;
FOnMouseEnter, FOnMouseLeave: TNotifyEvent;
FVScrollBar: TspSkinScrollBar;
FHScrollBar: TspSkinScrollBar;
FDown: Boolean;
FDefaultFont: TFont;
FUseSkinFont: Boolean;
procedure OnDefaultFontChange(Sender: TObject);
procedure SetDefaultFont(Value: TFont);
procedure UpDateScrollRange;
procedure SetVScrollBar(Value: TspSkinScrollBar);
procedure SetHScrollBar(Value: TspSkinScrollBar);
procedure OnVScrollBarChange(Sender: TObject);
procedure OnHScrollBarChange(Sender: TObject);
procedure SetSkinData(Value: TspSkinData);
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: TspSkinScrollBar read FVScrollBar
write SetVScrollBar;
property HScrollBar: TspSkinScrollBar read FHScrollBar
write SetHScrollBar;
property SkinData: TspSkinData 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;
TspSkinCustomListBox = class;
TspListBox = 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: TspSkinCustomListBox;
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
property HorizontalExtentValue: Integer
read FHorizontalExtentValue
write FHorizontalExtentValue;
end;
TspSkinCustomListBox = class(TspSkinCustomControl)
protected
//
FHorizontalExtent: Boolean;
FStopUpDateHScrollBar: Boolean;
//
FRowCount: Integer;
FGlyph: TBitMap;
FNumGlyphs: TspSkinPanelNumGlyphs;
FSpacing: Integer;
FImages: TCustomImageList;
FImageIndex: Integer;
FOnUpButtonClick, FOnDownButtonClick, FOnCheckButtonClick: TNotifyEvent;
FDefaultItemHeight: Integer;
FDefaultCaptionHeight: Integer;
FDefaultCaptionFont: TFont;
FOnDrawItem: TspDrawSkinItemEvent;
NewClRect: TRect;
ListRect: TRect;
FCaptionMode: Boolean;
FAlignment: TAlignment;
Buttons: array[0..2] of TspCBButtonX;
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: TspSkinPanelNumGlyphs);
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 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: TspSkinScrollBar;
HScrollBar: TspSkinScrollBar;
ListBox: TspListBox;
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 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: TspSkinPanelNumGlyphs 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: TspDrawSkinItemEvent read FOnDrawItem write FOnDrawItem;
end;
TspSkinListBox = class(TspSkinCustomListBox)
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 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;
TspSkinScrollBox = class(TspSkinCustomControl)
protected
FInCheckScrollBars: Boolean;
FDown: Boolean;
FVScrollBar: TspSkinScrollBar;
FHScrollBar: TspSkinScrollBar;
FOldVScrollBarPos: Integer;
FOldHScrollBarPos: Integer;
FVSizeOffset: Integer;
FHSizeOffset: Integer;
FBorderStyle: TspSkinBorderStyle;
procedure SetBorderStyle(Value: TspSkinBorderStyle);
procedure SetVScrollBar(Value: TspSkinScrollBar);
procedure SetHScrollBar(Value: TspSkinScrollBar);
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: TspSkinScrollBar read FHScrollBar
write SetHScrollBar;
property VScrollBar: TspSkinScrollBar read FVScrollBar
write SetVScrollBar;
property BorderStyle: TspSkinBorderStyle
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);
TspPopupListBox = class(TspSkinListBox)
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;
TspCBItem = record
R: TRect;
State: TOwnerDrawState;
end;
TspSkinCustomComboBoxStyle = (spcbEditStyle, spcbFixedStyle);
TspSkinCustomComboBox = class(TspSkinCustomControl)
protected
FListBoxAlphaBlend: Boolean;
FListBoxAlphaBlendAnimation: Boolean;
FListBoxAlphaBlendValue: Byte;
FStyle: TspSkinCustomComboBoxStyle;
FOnChange: TNotifyEvent;
FOnClick: TNotifyEvent;
FOnCloseUp: TNotifyEvent;
FOnListBoxDrawItem: TspDrawSkinItemEvent;
FOnComboBoxDrawItem: TspDrawSkinItemEvent;
FMouseIn: Boolean;
FOldItemIndex: Integer;
FDropDownCount: Integer;
FLBDown: Boolean;
FListBoxWindowProc: TWndMethod;
FEditWindowProc: TWndMethod;
//
FListBox: TspPopupListBox;
//
CBItem: TspCBItem;
Button: TspCBButtonX;
FEdit: TspCustomEdit;
FromEdit: Boolean;
function GetImages: TCustomImageList;
function GetImageIndex: Integer;
procedure SetImages(Value: TCustomImageList);
procedure SetImageIndex(Value: Integer);
function GetHorizontalExtent: Boolean;
procedure SetHorizontalExtent(Value: Boolean);
procedure EditCancelMode(C: TControl);
function GetListBoxDefaultFont: TFont;
procedure SetListBoxDefaultFont(Value: TFont);
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 ListBoxDrawItem(Cnvs: TCanvas; Index: Integer;
ItemWidth, ItemHeight: Integer; TextRect: TRect; State: TOwnerDrawState);
function GetSorted: Boolean;
procedure SetSorted(Value: Boolean);
procedure SetStyle(Value: TspSkinCustomComboBoxStyle);
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);
procedure SetItems(Value: TStrings);
function GetItems: TStrings;
procedure SetListBoxDrawItem(Value: TspDrawSkinItemEvent);
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 KeyDown(var Key: Word; Shift: TShiftState); override;
procedure CMWantSpecialKey(var Msg: TCMWantSpecialKey); message CM_WANTSPECIALKEY;
procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
procedure DefaultFontChange; override;
procedure CreateControlDefaultImage(B: TBitMap); override;
procedure CreateControlSkinImage(B: TBitMap); override;
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
procedure Change; virtual;
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 ListBoxAlphaBlend: Boolean read FListBoxAlphaBlend write FListBoxAlphaBlend;
property ListBoxAlphaBlendAnimation: Boolean
read FListBoxAlphaBlendAnimation write FListBoxAlphaBlendAnimation;
property ListBoxAlphaBlendValue: Byte read FListBoxAlphaBlendValue write FListBoxAlphaBlendValue;
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 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: TspSkinCustomComboBoxStyle read FStyle write SetStyle;
property OnListBoxDrawItem: TspDrawSkinItemEvent
read FOnListBoxDrawItem write SetListBoxDrawItem;
property OnComboBoxDrawItem: TspDrawSkinItemEvent
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;
TspSkinComboBox = class(TspSkinCustomComboBox)
published
property ListBoxAlphaBlend;
property ListBoxAlphaBlendAnimation;
property ListBoxAlphaBlendValue;
property TabStop;
property HorizontalExtent;
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 Visible;
//
property Text;
property Align;
property Items;
property ItemIndex;
property DropDownCount;
property Font;
property Sorted;
property Style;
property OnListBoxDrawItem;
property OnComboBoxDrawItem;
property OnChange;
property OnClick;
property OnCloseUp;
end;
TspColorBoxStyles = (spcbStandardColors, // first sixteen RGBI colors
spcbExtendedColors, // four additional reserved colors
spcbSystemColors, // system managed/defined colors
spcbIncludeNone, // include clNone color, must be used with cbSystemColors
spcbIncludeDefault, // include clDefault color, must be used with cbSystemColors
spcbCustomColor, // first color is customizable
spcbPrettyNames); // instead of 'clColorNames' you get 'Color Names'
TspColorBoxStyle = set of TspColorBoxStyles;
TspSkinColorComboBox = class(TspSkinCustomComboBox)
private
FShowNames: Boolean;
FExStyle: TspColorBoxStyle;
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: TspColorBoxStyle);
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;
procedure PopulateList;
property Colors[Index: Integer]: TColor read GetColor;
property ColorNames[Index: Integer]: string read GetColorName;
published
property ListBoxCaption;
property ListBoxCaptionMode;
property ListBoxAlphaBlend;
property ListBoxAlphaBlendValue;
property ListBoxAlphaBlendAnimation;
property Enabled;
property PopupMenu;
property ShowHint;
property TabOrder;
property Visible;
//
property Align;
property ItemIndex;
property DropDownCount;
property Font;
property Sorted;
property OnChange;
property OnClick;
//
property ExStyle: TspColorBoxStyle read FExStyle write SetExStyle
default [spcbStandardColors, spcbExtendedColors, spcbSystemColors];
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;
end;
TspFontDevice = (fdScreen, fdPrinter, fdBoth);
TspFontListOption = (foAnsiOnly, foTrueTypeOnly, foFixedPitchOnly,
foNoOEMFonts, foOEMFontsOnly, foScalableOnly, foNoSymbolFonts);
TspFontListOptions = set of TspFontListOption;
TspSkinFontComboBox = class(TspSkinCustomComboBox)
protected
FDevice: TspFontDevice;
FUpdate: Boolean;
FUseFonts: Boolean;
FOptions: TspFontListOptions;
procedure SetFontName(const NewFontName: TFontName);
function GetFontName: TFontName;
function GetTrueTypeOnly: Boolean;
procedure SetDevice(Value: TspFontDevice);
procedure SetOptions(Value: TspFontListOptions);
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 ListBoxCaption;
property ListBoxCaptionMode;
property Enabled;
property PopupMenu;
property ShowHint;
property TabOrder;
property Visible;
property Device: TspFontDevice read FDevice write SetDevice default fdScreen;
property FontName: TFontName read GetFontName write SetFontName;
property Options: TspFontListOptions read FOptions write SetOptions default [];
property TrueTypeOnly: Boolean read GetTrueTypeOnly write SetTrueTypeOnly
stored False;
property UseFonts: Boolean read FUseFonts write SetUseFonts default False;
property Align;
property ItemIndex;
property DropDownCount;
property Font;
property Sorted;
property Style;
property OnChange;
property OnClick;
end;
TspValueType = (vtInteger, vtFloat);
TspSkinSpinEdit = class(TspSkinCustomControl)
private
StopCheck: Boolean;
FMinValue, FMaxValue, FIncrement: Extended;
FromEdit: Boolean;
FOnChange: TNotifyEvent;
FValue: Extended;
OldActiveButton, ActiveButton, CaptureButton: Integer;
TimerMode: Integer;
WaitMode: Boolean;
FDecimal: Byte;
FValueType: TspValueType;
procedure StartTimer;
procedure StopTimer;
procedure SetValue(AValue: Extended);
procedure SetMinValue(AValue: Extended);
procedure SetMaxValue(AValue: Extended);
procedure SetEditorEnabled(AValue: Boolean);
function GetEditorEnabled: Boolean;
procedure SetMaxLength(AValue: Integer);
function GetMaxLength: Integer;
procedure SetValueType(NewType: TspValueType);
procedure SetDecimal(NewValue: Byte);
protected
Buttons: array[0..1] of TspCBButtonX;
FOnEditKeyDown: TKeyEvent;
FOnEditKeyPress: TKeyPressEvent;
FOnEditKeyUp: TKeyEvent;
procedure EditKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure EditKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure EditKeyPress(Sender: TObject; var Key: Char);
procedure UpClick(Sender: TObject);
procedure DownClick(Sender: TObject);
function CheckValue (NewValue: Extended): Extended;
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: TspSkinNumEdit;
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 Align;
property ValueType: TspValueType read FValueType write SetValueType;
property Decimal: Byte read FDecimal write SetDecimal default 2;
property MinValue: Extended read FMinValue write SetMinValue;
property MaxValue: Extended read FMaxValue write SetMaxValue;
property Value: Extended read FValue write SetValue;
property Increment: Extended 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;
end;
TspSkinCheckListBox = class;
TspCheckListBox = 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: TspSkinCheckListBox;
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;
TspSkinCheckListBox = class(TspSkinCustomControl)
protected
FRowCount: Integer;
FImages: TCustomImageList;
FImageIndex: Integer;
FGlyph: TBitMap;
FNumGlyphs: TspSkinPanelNumGlyphs;
FSpacing: Integer;
FOnUpButtonClick, FOnDownButtonClick, FOnCheckButtonClick: TNotifyEvent;
FOnClickCheck: TNotifyEvent;
FDefaultItemHeight: Integer;
FOnDrawItem: TspDrawSkinItemEvent;
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 TspCBButtonX;
OldActiveButton, ActiveButton, CaptureButton: Integer;
NewCaptionRect: TRect;
TimerMode: Integer;
WaitMode: 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: TspSkinPanelNumGlyphs);
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;
public
ScrollBar: TspSkinScrollBar;
ListBox: TspCheckListBox;
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 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: TspSkinPanelNumGlyphs 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 FOnClickCheck;
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: TspDrawSkinItemEvent read FOnDrawItem write FOnDrawItem;
end;
TspSkinUpDown = class(TspSkinCustomControl)
protected
FOrientation: TUDOrientation;
Buttons: array[0..1] of TspCBButtonX;
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;
TspSkinDateEdit = class;
TspPopupCalendar = class(TspSkinMonthCalendar)
protected
procedure WMMouseActivate(var Message: TMessage); message WM_MOUSEACTIVATE;
procedure CreateParams(var Params: TCreateParams); override;
public
constructor Create(AOwner: TComponent); override;
end;
TspSkinDateEdit = class(TspSkinCustomEdit)
private
FTodayDefault: Boolean;
StopCheck: Boolean;
FCalendarAlphaBlend: Boolean;
FCalendarAlphaBlendValue: Byte;
FCalendarAlphaBlendAnimation: Boolean;
protected
FMonthCalendar: TspPopupCalendar;
FOnDateChange: TNotifyEvent;
function GetDate: TDate;
procedure SetDate(Value: TDate);
procedure Loaded; override;
function GetFirstDayOfWeek: TspDaysOfWeek;
procedure SetFirstDayOfWeek(Value: TspDaysOfWeek);
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);
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 KeyPress(var Key: Char); override;
procedure CheckValidDate;
procedure Change; override;
function IsValidText(S: String): Boolean;
procedure KeyDown(var Key: Word; Shift: TShiftState); override;
procedure CheckSelect;
//
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property Date: TDate read GetDate write SetDate;
property CalendarAlphaBlend: Boolean read FCalendarAlphaBlend write FCalendarAlphaBlend;
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 CalendarAlphaBlendAnimation: Boolean
read FCalendarAlphaBlendAnimation write FCalendarAlphaBlendAnimation;
property CalendarAlphaBlendValue: Byte read FCalendarAlphaBlendValue write FCalendarAlphaBlendValue;
property DefaultFont;
property DefaultWidth;
property DefaultHeight;
property ButtonMode;
property SkinData;
property SkinDataName;
property AlphaBlend;
property AlphaBlendValue;
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;
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: 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;
property OnDateChange: TNotifyEvent read FOnDateChange write FOnDateChange;
end;
TspSkinTrackEdit = class;
TspSkinPopupTrackBar = class(TspSkinTrackBar)
protected
procedure WMMouseActivate(var Message: TMessage); message WM_MOUSEACTIVATE;
procedure CreateParams(var Params: TCreateParams); override;
public
TrackEdit: TspSkinTrackEdit;
constructor Create(AOwner: TComponent); override;
end;
TspSkinTrackEdit = class(TspSkinCustomEdit)
private
FTrackBarSkinDataName: String;
StopCheck: Boolean;
FMinValue, FMaxValue, FValue: Integer;
FPopupTrackBar: TspSkinPopupTrackBar;
FTrackBarAlphaBlend: Boolean;
FTrackBarAlphaBlendValue: Byte;
FTrackBarAlphaBlendAnimation: Boolean;
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 TrackBarAlphaBlend: Boolean read FTrackBarAlphaBlend write FTrackBarAlphaBlend;
property TrackBarAlphaBlendAnimation: Boolean
read FTrackBarAlphaBlendAnimation write FTrackBarAlphaBlendAnimation;
property TrackBarAlphaBlendValue: Byte read FTrackBarAlphaBlendValue write FTrackBarAlphaBlendValue;
property TrackBarSkinDataName: String
read FTrackBarSkinDataName write FTrackBarSkinDataName;
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;
TspSkinMaskEdit = class(TspSkinEdit)
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;
TspSkinTimeEdit = class(TspSkinMaskEdit)
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 spUtils, Consts, Printers;
const
WS_EX_LAYERED = $80000;
//=========== TspSkinUpDown ===============
constructor TspSkinUpDown.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 TspSkinUpDown.Destroy;
begin
inherited;
end;
procedure TspSkinUpDown.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 TspSkinUpDown.CreateControlSkinImage;
var
i: Integer;
begin
inherited;
for i := 0 to 1 do DrawButton(B.Canvas, i);
end;
procedure TspSkinUpDown.WMSIZE;
begin
inherited;
CalcRects;
end;
procedure TspSkinUpDown.CreateControlDefaultImage;
var
i: Integer;
begin
CalcRects;
for i := 0 to 1 do DrawButton(B.Canvas, i);
end;
procedure TspSkinUpDown.CMMouseEnter;
begin
ActiveButton := -1;
OldActiveButton := -1;
inherited;
end;
procedure TspSkinUpDown.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 TspSkinUpDown.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, SP_XP_BTNFRAMECOLOR, SP_XP_BTNFRAMECOLOR, 1);
Cnvs.Brush.Color := SP_XP_BTNDOWNCOLOR;
Cnvs.FillRect(R1);
end
else
if MouseIn
then
begin
Frame3D(Cnvs, R1, SP_XP_BTNFRAMECOLOR, SP_XP_BTNFRAMECOLOR, 1);
Cnvs.Brush.Color := SP_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 TspSkinUpDown.MouseDown;
begin
TestActive(X, Y);
if ActiveButton <> -1
then
begin
CaptureButton := ActiveButton;
ButtonDown(ActiveButton, X, Y);
end;
inherited;
end;
procedure TspSkinUpDown.MouseUp;
begin
if CaptureButton <> -1
then ButtonUp(CaptureButton, X, Y);
CaptureButton := -1;
inherited;
end;
procedure TspSkinUpDown.MouseMove;
begin
TestActive(X, Y);
inherited;
end;
procedure TspSkinUpDown.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 TspSkinUpDown.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 TspSkinUpDown.ButtonUp;
begin
Buttons[i].Down := False;
if ActiveButton <> i then Buttons[i].MouseIn := False;
RePaint;
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 TspSkinUpDown.ButtonEnter(I: Integer);
begin
Buttons[i].MouseIn := True;
RePaint;
if (FIncrement <> 0) and Buttons[i].Down then SetTimer(Handle, 1, 50, nil);
end;
procedure TspSkinUpDown.ButtonLeave(I: Integer);
begin
Buttons[i].MouseIn := False;
RePaint;
if (FIncrement <> 0) and Buttons[i].Down then KillTimer(Handle, 1);
end;
procedure TspSkinUpDown.CalcRects;
const
BW = 15;
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 TspSkinUpDown.StartTimer;
begin
KillTimer(Handle, 1);
SetTimer(Handle, 1, 100, nil);
end;
procedure TspSkinUpDown.StopTimer;
begin
KillTimer(Handle, 1);
TimerMode := 0;
end;
procedure TspSkinUpDown.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 TspSkinUpDown.GetSkinData;
begin
inherited;
if FIndex <> -1
then
if TspDataSkinControl(FSD.CtrlList.Items[FIndex]) is TspDataSkinUpDownControl
then
with TspDataSkinUpDownControl(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 TspSkinUpDown.SetIncrement;
begin
FIncrement := Value;
end;
procedure TspSkinUpDown.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 TspSkinUpDown.SetMin;
begin
FMin := Value;
if FPosition < FMin then FPosition := FMin;
end;
procedure TspSkinUpDown.SetMax;
begin
FMax := Value;
if FPosition > FMax then FPosition := FMax;
end;
constructor TspSkinSpinEdit.Create(AOwner: TComponent);
begin
inherited;
ControlStyle := [csCaptureMouse, csOpaque, csDoubleClicks, csAcceptsControls];
ActiveButton := -1;
OldActiveButton := -1;
CaptureButton := -1;
FValue := 0;
FromEdit := False;
FEdit := TspSkinNumEdit.Create(Self);
FEdit.Font.Assign(FDefaultFont);
FIncrement := 1;
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;
StopCheck := True;
Text := '0';
StopCheck := False;
Width := 120;
Height := 20;
FSkinDataName := 'spinedit';
FDecimal := 2;
end;
destructor TspSkinSpinEdit.Destroy;
begin
FEdit.Free;
inherited;
end;
procedure TspSkinSpinEdit.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 TspSkinSpinEdit.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 TspSkinSpinEdit.SetValueType;
begin
if FValueType <> NewType
then
begin
FValueType := NewType;
if FValueType = vtInteger
then
begin
FIncrement := Round(FIncrement);
if FIncrement = 0 then FIncrement := 1;
end;
end;
FEdit.Float := ValueType = vtFloat;
end;
procedure TspSkinSpinEdit.SetDecimal(NewValue: Byte);
begin
if FDecimal <> NewValue then begin
FDecimal := NewValue;
end;
end;
procedure TspSkinSpinEdit.Change;
begin
if Assigned(FOnChange) then FOnChange(Self);
end;
procedure TspSkinSpinEdit.DefaultFontChange;
begin
if (FIndex = -1) and (FEdit <> nil) then FEdit.Font.Assign(FDefaultFont);
end;
procedure TspSkinSpinEdit.GetSkinData;
begin
inherited;
if FIndex <> -1
then
if TspDataSkinControl(FSD.CtrlList.Items[FIndex]) is TspDataSkinSpinEditControl
then
with TspDataSkinSpinEditControl(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 TspSkinSpinEdit.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 TspSkinSpinEdit.EditKeyDown;
begin
if Assigned(FOnEditKeyDown) then FOnEditKeyDown(Self, Key, Shift);
end;
procedure TspSkinSpinEdit.EditKeyUp;
begin
if Assigned(FOnEditKeyUp) then FOnEditKeyUp(Self, Key, Shift);
end;
procedure TspSkinSpinEdit.EditKeyPress;
begin
if Assigned(FOnEditKeyPress) then FOnEditKeyPress(Self, Key);
end;
procedure TspSkinSpinEdit.UpClick;
begin
Value := Value + FIncrement;
end;
procedure TspSkinSpinEdit.DownClick;
begin
Value := Value - FIncrement;
end;
procedure TspSkinSpinEdit.SetMaxLength;
begin
FEdit.MaxLength := AValue;
end;
function TspSkinSpinEdit.GetMaxLength;
begin
Result := FEdit.MaxLength;
end;
procedure TspSkinSpinEdit.SetEditorEnabled;
begin
FEdit.EditorEnabled := AValue;
end;
function TspSkinSpinEdit.GetEditorEnabled;
begin
Result := FEdit.EditorEnabled;
end;
procedure TspSkinSpinEdit.StartTimer;
begin
KillTimer(Handle, 1);
SetTimer(Handle, 1, 100, nil);
end;
procedure TspSkinSpinEdit.StopTimer;
begin
KillTimer(Handle, 1);
TimerMode := 0;
end;
function TspSkinSpinEdit.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 TspSkinSpinEdit.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 TspSkinSpinEdit.SetMinValue;
begin
FMinValue := AValue;
end;
procedure TspSkinSpinEdit.SetMaxValue;
begin
FMaxValue := AValue;
end;
procedure TspSkinSpinEdit.CMMouseEnter;
begin
inherited;
TestActive(-1, -1);
end;
function TspSkinSpinEdit.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 TspSkinSpinEdit.CMTextChanged;
var
NewValue: Extended;
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 TspSkinSpinEdit.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 TspSkinSpinEdit.EditChange;
begin
FromEdit := True;
Text := FEdit.Text;
FromEdit := False;
end;
procedure TspSkinSpinEdit.Invalidate;
begin
inherited;
if (FIndex <> -1) and (FEdit <> nil) then FEdit.Invalidate;
end;
procedure TspSkinSpinEdit.WMSIZE;
begin
inherited;
CalcRects;
end;
procedure TspSkinSpinEdit.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 TspSkinSpinEdit.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 TspSkinSpinEdit.ButtonUp;
begin
Buttons[i].Down := False;
if ActiveButton <> i then Buttons[i].MouseIn := False;
RePaint;
case i of
0: Value := Value + FIncrement;
1: Value := Value - FIncrement;
end;
StopTimer;
end;
procedure TspSkinSpinEdit.ButtonEnter(I: Integer);
begin
Buttons[i].MouseIn := True;
RePaint;
if Buttons[i].Down then SetTimer(Handle, 1, 50, nil);
end;
procedure TspSkinSpinEdit.ButtonLeave(I: Integer);
begin
Buttons[i].MouseIn := False;
RePaint;
if Buttons[i].Down then KillTimer(Handle, 1);
end;
procedure TspSkinSpinEdit.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 TspSkinSpinEdit.CreateControlSkinImage;
var
i: Integer;
begin
inherited;
for i := 0 to 1 do DrawButton(B.Canvas, i);
end;
procedure TspSkinSpinEdit.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, SP_XP_BTNFRAMECOLOR, SP_XP_BTNFRAMECOLOR, 1);
Cnvs.Brush.Color := SP_XP_BTNDOWNCOLOR;
Cnvs.FillRect(R1);
end
else
if MouseIn
then
begin
Frame3D(Cnvs, R1, SP_XP_BTNFRAMECOLOR, SP_XP_BTNFRAMECOLOR, 1);
Cnvs.Brush.Color := SP_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 TspSkinSpinEdit.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 TspSkinSpinEdit.MouseDown;
begin
TestActive(X, Y);
if ActiveButton <> -1
then
begin
CaptureButton := ActiveButton;
ButtonDown(ActiveButton, X, Y);
end;
inherited;
end;
procedure TspSkinSpinEdit.MouseUp;
begin
if CaptureButton <> -1
then ButtonUp(CaptureButton, X, Y);
CaptureButton := -1;
inherited;
end;
procedure TspSkinSpinEdit.MouseMove;
begin
inherited;
TestActive(X, Y);
end;
constructor TspCustomEdit.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
ControlStyle := ControlStyle + [csOpaque];
FEditTransparent := False;
end;
procedure TspCustomEdit.CMCancelMode;
begin
inherited;
if Assigned(FOnEditCancelMode)
then FOnEditCancelMode(Message.Sender);
end;
procedure TspCustomEdit.SetEditTransparent(Value: Boolean);
begin
FEditTransparent := Value;
ReCreateWnd;
end;
procedure TspCustomEdit.WMSetFont;
begin
inherited;
SendMessage(Handle, EM_SETMARGINS, EC_LEFTMARGIN or EC_RIGHTMARGIN, MakeLong(2, 0));
end;
procedure TspCustomEdit.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 TspCustomEdit.WMCHAR;
begin
if not FReadOnly then inherited;
end;
procedure TspCustomEdit.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 TspCustomEdit.WMEraseBkgnd(var Message: TWMEraseBkgnd);
begin
if FEditTransparent then Invalidate else inherited;
end;
procedure TspCustomEdit.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 TspCustomEdit.Change;
begin
inherited;
if FEditTransparent then Invalidate;
end;
procedure TspCustomEdit.WMKeyDown(var Message: TWMKeyDown);
begin
if FReadOnly and (Message.CharCode = VK_DELETE) then Exit;
inherited;
if FEditTransparent then Invalidate;
end;
procedure TspCustomEdit.WMSetText(var Message:TWMSetText);
begin
inherited;
if FEditTransparent then Invalidate;
end;
procedure TspCustomEdit.WMMove(var Message: TMessage);
begin
inherited;
if FEditTransparent then Invalidate;
end;
procedure TspCustomEdit.WMCut(var Message: TMessage);
begin
if FReadOnly then Exit;
inherited;
if FEditTransparent then Invalidate;
end;
procedure TspCustomEdit.WMPaste(var Message: TMessage);
begin
if FReadOnly then Exit;
inherited;
if FEditTransparent then Invalidate;
end;
procedure TspCustomEdit.WMClear(var Message: TMessage);
begin
if FReadOnly then Exit;
inherited;
if FEditTransparent then Invalidate;
end;
procedure TspCustomEdit.WMUndo(var Message: TMessage);
begin
if FReadOnly then Exit;
inherited;
if FEditTransparent then Invalidate;
end;
procedure TspCustomEdit.WMLButtonDown(var Message: TMessage);
begin
inherited;
FDown := True;
if FEditTransparent then Invalidate;
end;
procedure TspCustomEdit.WMSETFOCUS;
begin
inherited;
if FEditTransparent then Invalidate;
end;
procedure TspCustomEdit.WMKILLFOCUS;
begin
inherited;
if FEditTransparent then Invalidate;
end;
procedure TspCustomEdit.WMMOUSEMOVE;
begin
inherited;
if FDown and EditTransparent then Invalidate;
end;
procedure TspCustomEdit.WMLButtonUp;
begin
inherited;
FDown := False;
end;
constructor TspSkinNumEdit.Create(AOwner: TComponent);
begin
inherited;
FEditorEnabled := True;
end;
procedure TspSkinNumEdit.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 TspSkinNumEdit.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 TspSkinNumEdit.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 TspSkinNumEdit.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 TspSkinCustomEdit.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;
ParentImage := nil;
FSkinDataName := 'edit';
FDefaultFont := TFont.Create;
FDefaultFont.OnChange := OnDefaultFontChange;
FDefaultFont.Assign(Font);
FDefaultWidth := 0;
FDefaultHeight := 20;
FUseSkinFont := True;
end;
destructor TspSkinCustomEdit.Destroy;
begin
FDefaultFont.Free;
inherited;
end;
procedure TspSkinCustomEdit.SetAlignment(Value: TAlignment);
begin
if FAlignment <> Value then
begin
FAlignment := Value;
RecreateWnd;
end;
end;
procedure TspSkinCustomEdit.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 TspSkinCustomEdit.SetDefaultWidth;
begin
FDefaultWidth := Value;
if (FIndex = -1) and (FDefaultWidth > 0) then Width := FDefaultWidth;
end;
procedure TspSkinCustomEdit.SetDefaultHeight;
begin
FDefaultHeight := Value;
if (FIndex = -1) and (FDefaultHeight > 0) then Height := FDefaultHeight;
end;
procedure TspSkinCustomEdit.SetDefaultFont;
begin
FDefaultFont.Assign(Value);
if FIndex = -1 then Font.Assign(Value);
end;
procedure TspSkinCustomEdit.OnDefaultFontChange(Sender: TObject);
begin
if FIndex = -1 then Font.Assign(FDefaultFont);
end;
procedure TspSkinCustomEdit.CalcRects;
var
Off: Integer;
begin
if FIndex = -1
then
begin
FButtonRect := Rect(Width - 20, 0, Width, Height);
FEditRect := Rect(2, 2, Width - 22, 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 TspSkinCustomEdit.WMMOUSEMOVE;
begin
inherited;
if FButtonMode and FButtonActive
then
begin
FButtonActive := False;
Invalidate;
end;
end;
procedure TspSkinCustomEdit.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 TspSkinCustomEdit.WMNCLBUTTONDBCLK;
begin
if FButtonMode and (Message.HitTest = HTEDITBUTTON) and
not (csDesigning in ComponentState)
then
begin
FButtonDown := True;
Invalidate;
end
else
inherited;
end;
procedure TspSkinCustomEdit.WMNCLBUTTONDOWN;
begin
if FButtonMode and (Message.HitTest = HTEDITBUTTON) and
not (csDesigning in ComponentState)
then
begin
FButtonDown := True;
Invalidate;
end
else
inherited;
end;
procedure TspSkinCustomEdit.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 TspSkinCustomEdit.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 TspSkinCustomEdit.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 TspSkinCustomEdit.SetPasswordChar(Value: Char);
begin
PasswordChar := Value;
ReCreateWnd;
end;
function TspSkinCustomEdit.GetPasswordChar;
begin
Result := PasswordChar;
end;
procedure TspSkinCustomEdit.Invalidate;
begin
if Parent = nil then Exit;
RedrawWindow(Handle, nil, 0, RDW_FRAME + RDW_INVALIDATE);
end;
procedure TspSkinCustomEdit.SetParentImage;
begin
if ParentImage <> nil
then
begin
ParentImage.Width := Width;
ParentImage.Height := Height;
GetParentImage(Self, ParentImage.Canvas);
end;
end;
procedure TspSkinCustomEdit.WMSETFOCUS;
begin
inherited;
if not FMouseIn and (FIndex <> -1) then Font.Color := ActiveFontColor;
end;
procedure TspSkinCustomEdit.WMKILLFOCUS;
begin
inherited;
if not FMouseIn and (FIndex <> -1) then Font.Color := FontColor;
end;
procedure TspSkinCustomEdit.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 TspSkinCustomEdit.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 TspSkinCustomEdit.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 TspSkinCustomEdit.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 TspSkinCustomEdit.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 TspSkinCustomEdit.WMNCPAINT;
var
DC: HDC;
C: TCanvas;
B: TBitMap;
R: TRect;
Kf: Double;
EB1, EB2: TspEffectBmp;
Offset: Integer;
BR: TRect;
begin
if FAlphaBlend
then
begin
ParentImage := TBitMap.Create;
SetParentImage;
end;
DC := GetWindowDC(Handle);
C := TControlCanvas.Create;
C.Handle := DC;
B := TBitMap.Create;
B.Width := Width;
B.Height := Height;
GetSkinData;
CalcRects;
if FButtonMode then Offset := Width - FButtonRect.Left else Offset := 0;
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, SP_XP_BTNFRAMECOLOR, SP_XP_BTNFRAMECOLOR, 1);
Brush.Color := SP_XP_BTNDOWNCOLOR;
FillRect(R);
end
else
if FButtonActive
then
begin
Frame3D(B.Canvas, R, SP_XP_BTNFRAMECOLOR, SP_XP_BTNFRAMECOLOR, 1);
Brush.Color := SP_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
B.Canvas.CopyRect(FButtonRect, Picture.Canvas, BR);
end;
//
end;
if FAlphaBlend
then
begin
ParentImage.Width := B.Width;
EB1 := TspEffectBmp.CreateFromhWnd(B.Handle);
EB2 := TspEffectBmp.CreateFromhWnd(ParentImage.Handle);
kf := 1 - FAlphaBlendValue / 255;
EB1.Morph(EB2, Kf);
EB1.Draw(C.Handle, 0, 0);
EB1.Free;
EB2.Free;
end
else
C.Draw(0, 0, B);
finally
B.Free;
C.Free;
ReleaseDC(Handle, DC);
end;
if FAlphaBlend
then
begin
ParentImage.Free;
ParentImage := nil;
end;
end;
procedure TspSkinCustomEdit.SetAlphaBlend;
begin
if FAlphaBlend <> AValue
then
begin
FAlphaBlend := AValue;
Invalidate;
end;
end;
procedure TspSkinCustomEdit.SetAlphaBlendValue;
begin
FAlphaBlendValue := AValue;
if FAlphaBlend then Invalidate;
end;
procedure TspSkinCustomEdit.GetSkinData;
begin
if FSD = nil
then
begin
FIndex := -1;
Exit;
end;
if FSD.Empty
then
FIndex := -1
else
FIndex := FSD.GetControlIndex(FSkinDataName);
if FIndex <> -1
then
if TspDataSkinControl(FSD.CtrlList.Items[FIndex]) is TspDataSkinEditControl
then
with TspDataSkinEditControl(FSD.CtrlList.Items[FIndex]) do
begin
if (PictureIndex <> -1) and (PictureIndex < FSD.FActivePictures.Count)
then
Picture := TBitMap(FSD.FActivePictures.Items[PictureIndex])
else
Picture := nil;
Self.SkinRect := SkinRect;
Self.ActiveSkinRect := ActiveSkinRect;
if isNullRect(ActiveSkinRect)
then
Self.ActiveSkinRect := SkinRect;
LOffset := LTPoint.X;
ROffset := RectWidth(SkinRect) - RTPoint.X;
Self.ClRect := ClRect;
Self.FontName := FontName;
Self.FontStyle := FontStyle;
Self.FontHeight := FontHeight;
Self.FontColor := FontColor;
Self.DisabledFontColor := DisabledFontColor;
Self.ActiveFontColor := ActiveFontColor;