Delphi控件源码

开发平台：

Delphi

WinSubClass.pas：源码内容

unit WinSubClass;
{$I Compilers.inc}
{.$define combobox}
{.$define buttontest}
{.$define resiztest}
{.$define scrollbartest}
{.$define combox}
{$WARNINGS OFF}
{$HINTS OFF}
{$RANGECHECKS OFF}
{$define progress}
interface
uses
Windows, SysUtils, Classes, Graphics, Controls, ComCtrls, Forms,
Menus, Messages, ExtCtrls, StdCtrls, Buttons, CommCtrl,imglist,
winskindata,tabs,TypInfo,Dialogs,Grids;
const
CM_Scroll1= 161;
CM_Scroll2= 513;
CM_Scroll3= 162;
CM_Scroll4= 514;
C_Paramv = 7;
C_Paramh = 6;
c_paramB = 1;
SBM_GETSCROLLBARINFO = 235;
type
TSkinControlState = ( scMouseIn,scDown);
TAcControl = class(TControl);
TAcWinControl = class(TWinControl);
TAcGraphicControl = class(TGraphicControl);
TSkinAcListView = class(TCustomListView);
TSkinScrollbar = class;
TSkinControl = class(TComponent)
Protected
state : set of TSkinControlState;
fCanvas : TCanvas;
done:boolean;
isdraw : boolean;
enabled : boolean;
focused : boolean;
caption : wideString;
FObjectInst,FPrevWndProc :pointer;
skinned:boolean;
isunicode:boolean;
procedure FillBG( dc:HDC; rc:TRect);
procedure FillParentBG( dc:HDC; rc:TRect);
procedure doLogMsg(aid:string;msg:TMessage);
procedure Default(Var Msg: TMessage);
procedure Invalidate;
procedure WMPaint(message:TMessage);
procedure WMERASEBKGND(var Msg: TMessage);
function GetWindowLongEx(ahWnd: HWND; nIndex: Integer): Longint;
procedure SetParentBK(value:boolean);
procedure DrawFocus(hDC: HDC; wString: WideString; rc: TRect; uFormat: UINT);
// procedure Notification(AComponent: TComponent;Operation: TOperation);override;
public
fsd: TSkinData;
hwnd : HWND;
OldWndProc: TWndMethod;
control:Twincontrol;
boundsrect:Trect;
GControl : TGraphicControl;
newColor:boolean;
oldcolor:Tcolor;
Inited:boolean;
skinstate : integer;
skinform: Tcomponent;
kind :integer;
sizing:boolean;
parentbk:boolean;
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
Procedure Init(sf:Tcomponent;sd:TSkinData;acanvas:TCanvas;acolor:boolean=false);virtual;
Procedure Inithwnd(ahwnd:Thandle;sd:TSkinData;acanvas:TCanvas;sf:Tcomponent);virtual;
procedure MouseLeave;
Procedure Unsubclass; virtual;
procedure NewWndProc(var Message: TMessage);
function BeforeProc(var Message: TMessage):boolean;virtual;
procedure AfterProc(var Message: TMessage);virtual;
procedure PaintControl(adc:HDC=0);virtual;
procedure DrawControl( dc:HDC; rc:TRect);Virtual;
Procedure SkinChange; Virtual;
function GetState:integer;Virtual;
Procedure SetColor;
Procedure RestoreColor;
procedure DrawBMPSkin( abmp:Tbitmap;rc:TRect;aObject:TdataSkinObject;
I,N:integer;trans:integer);
procedure DrawSkinMap( dc:HDC; rc:TRect;
aObject:TdataSkinObject;I,N:integer);
procedure DrawSkinMap1( dc:HDC; rc:TRect;
bmp:Tbitmap;I,N:integer);
procedure DrawSkinMap2( dc:HDC; rc:TRect;
bmp:Tbitmap;I,N:integer);
procedure DrawSkin( rc:TRect;aObject:TdataSkinObject;
I,N:integer;trans:integer);
procedure DrawSkinMap3( acanvas:Tcanvas; rc:TRect;
bmp:Tbitmap;I,N:integer);
procedure DrawBuf( dc:HDC; rc:TRect);
procedure DrawCaption(acanvas: TCanvas; rc:TRect;text:widestring;
enabled,defaulted:boolean;Alignment:word=DT_CENTER);
procedure DrawImgCaption(acanvas: TCanvas; rc:TRect;
ImgList:hImageList;imgIndex:integer;text:widestring;talign:integer=DT_CENTER);
function TextHeight(dc:HDC;const s: string):integer;
function GetParentColor(acolor:Tcolor):Tcolor;
function CheckBiDi(dw:dword):dword;
end;
TArrowButton = Class(TCustomControl)
private
procedure WMLButtonDown(Var aMsg: TMessage);message WM_LButtonDown;
procedure WMLButtonUP(Var aMsg: TMessage);message WM_LButtonUP;
// procedure WMERASEBKGND(var Msg: TMessage);message WM_ERASEBKGND;
procedure CMMouseEnter(Var aMsg: TMessage);message CM_MOUSEENTER;
procedure CMMouseLeave(Var aMsg: TMessage);message CM_MOUSELEAVE;
protected
procedure Paint; override;
public
cw:integer;
control:TWincontrol;
obj:TSkinControl;
hwnd :Thandle;
state : set of TSkinControlState;
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Attach(aobj:Tskincontrol;acontrol:Twincontrol);
procedure MoveArrow( r:TRect);
end;
TSkinDateTime = Class(TSkinControl)
private
protected
arrow:TArrowButton;
procedure AfterProc(var Message: TMessage);override;
procedure DrawControl( dc:HDC; rc:TRect);override;
public
destructor Destroy; override;
procedure Init(sf:Tcomponent;sd:TSkinData;acanvas:TCanvas;acolor:boolean=false);override;
end;
TWScrollbar = Class(TCustompanel)
private
procedure WMLButtonDown(Var aMsg: TMessage);message WM_LButtonDown;
procedure WMMouseMove(Var aMsg: TMessage);message WM_MouseMove;
procedure WMMouseLeave(Var aMsg: TMessage);message WM_MouseLeave;
procedure WMLButtonDBClick(Var aMsg: TMessage);message WM_LBUTTONDBLCLK;
procedure WMLButtonUp(Var aMsg: TMessage);message WM_LButtonUp;
procedure WMERASEBKGND(var Msg: TMessage);message WM_ERASEBKGND;
protected
Len:Integer;
thumbTop,thumbbottom:integer;
OffsetSC,trackp:tpoint;
trackthumb:integer;
fdown:boolean;
sbDir:integer;
ERASEBKGND:boolean;
scrollpos:integer;
procedure Paint; override;
procedure GetThumb(rc:TRect);
function GetScrollPos(p:Tpoint):integer;
function GetControlInfo(var info:tagScrollBarInfo):boolean;
function GetControlInfo2(var info:tagScrollBarInfo):boolean;
procedure CreateParams(var Params: TCreateParams);override;
public
CW:integer;
hwnd:Thandle;
control:TWincontrol;
obj:TSkinControl;
sbType:byte;
sbRect:Trect;
// scrollpos:integer;
sbVisible:boolean;
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Attach(aobj:TSkinControl;aControl:Twincontrol;aType:byte);
procedure AttachHwnd(aobj:TSkinControl;ahwnd:Thandle;aType:byte);
procedure SetPosition(ahwnd:Thandle);
procedure ButtonUp;
procedure HideScrollbar;
procedure DoLog(Message: TMessage);
end;
TSkinButton = class(TSkinControl)
Protected
btemp:Tbitmap;
MultiLine:boolean;
trans:boolean;
redraw:boolean;
isdefault:boolean;
procedure DrawBtnText(acanvas: TCanvas; rc:TRect;
text:String; Alignment:word=DT_CENTER);
procedure DoMouseDown(var Message: TWMMouse);
procedure WMEnable(var Message: TMessage);
procedure SetRedraw(b:boolean);
function GetFontColor(var acolor:Tcolor):boolean;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
Procedure Init(sf:Tcomponent;sd:TSkinData;acanvas:TCanvas;acolor:boolean=false);override;
function BeforeProc(var Message: TMessage):boolean;override;
procedure AfterProc(var Message: TMessage);override;
procedure DrawControl( dc:HDC; rc:TRect);override;
end;
TSkinBitButton = class(TSkinButton)
Protected
procedure DrawGlyph( acanvas:Tcanvas; rc:TRect;
bmp:Tbitmap;I,N:integer);
procedure DrawPicControl( dc:HDC; rc:TRect);
public
isPicture:boolean;
PicField:string;
procedure DrawControl( dc:HDC; rc:TRect);override;
end;
TMPBtnType = (btPlay, btPause, btStop, btNext, btPrev, btStep, btBack,
btRecord, btEject);
TButtonSet = set of TMPBtnType;
TMPGlyph = (mgEnabled, mgDisabled, mgColored);
TMPButton = record
Visible: Boolean;
Enabled: Boolean;
Colored: Boolean;
Auto: Boolean;
Bitmaps: array[TMPGlyph] of TBitmap;
end;
TWMediaPlayer = Class(TCustompanel)
private
procedure WMLButtonDown(Var aMsg: TMessage);message WM_LButtonDown;
// procedure WMMouseMove(Var aMsg: TMessage);message WM_MouseMove;
// procedure WMMouseLeave(Var aMsg: TMessage);message WM_MouseLeave;
// procedure WMLButtonDBClick(Var aMsg: TMessage);message WM_LBUTTONDBLCLK;
procedure WMLButtonUp(Var aMsg: TMessage);message WM_LButtonUp;
// procedure WMERASEBKGND(var Msg: TMessage);message WM_ERASEBKGND;
procedure LoadBitmaps;
procedure DestroyBitmaps;
procedure CheckButtons;
procedure FindButton(XPos, YPos: Integer);
protected
Buttons: array[TMPBtnType] of TMPButton;
count:integer;
fsd:TSkinData;
IsDown:boolean;
BtnClick: TMPBtnType;
BtnFocuse: TMPBtnType;
BtnWidth: integer;
procedure Paint;override;
procedure DrawButton(acanvas:Tcanvas;Btn:TMPBtnType;R:TRect);
public
obj:TWincontrol;
skincontrol:TSkincontrol;
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Attach(askin:TSkinControl;aObj:Twincontrol);
procedure SetPosition(aObj:Twincontrol);
end;
TSkinMP = class(TSkinControl)
Protected
mp:TWMediaPlayer;
// Buttons: array[TMPBtnType] of TMPButton;
// procedure LoadBitmaps;
// procedure DestroyBitmaps;
// procedure DrawGlyph( acanvas:Tcanvas; rc:TRect;
// bmp:Tbitmap;I,N:integer);
procedure Unsubclass;override;
procedure AfterProc(var Message: TMessage);override;
public
// constructor Create(AOwner: TComponent); override;
// destructor Destroy; override;
Procedure Init(sf:Tcomponent;sd:TSkinData;acanvas:TCanvas;acolor:boolean=false);override;
// procedure DrawControl( dc:HDC; rc:TRect);override;
end;
TSkinMenuButton = class(TSkinButton)
Protected
procedure DrawGlyph( acanvas:Tcanvas; rc:TRect;
bmp:Tbitmap;I,N:integer);
public
procedure DrawControl( dc:HDC; rc:TRect);override;
end;
TSkinSpeedButton = class(TSkinBitButton)
protected
FReentr : Boolean; // RF: flag for reentrancy
procedure DrawPicbtn( acanvas:Tcanvas; rc:TRect);
public
// GControl : TGraphicControl;
PicField:string;
gcanvas:Tcanvas;
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure DrawSpeedbtn( acanvas:Tcanvas; rc:TRect);
procedure InitGraphicControl(sf:Tcomponent;sd:TSkinData;acanvas:TCanvas);
procedure AfterProc(var Message: TMessage);override;
function BeforeProc(var Message: TMessage):boolean;override;
procedure PaintControl(adc:HDC=0);override;
procedure WMPaintSpeed(var Message:Tmessage);
end;
TSkinCheckBox = class(TSkinControl)
Protected
state:integer;
trans:boolean;
public
function BeforeProc(var Message: TMessage):boolean;override;
procedure AfterProc(var Message: TMessage);override;
procedure DrawControl( dc:HDC; rc:TRect);override;
Procedure Init(sf:Tcomponent;sd:TSkinData;acanvas:TCanvas;acolor:boolean=false);override;
end;
TComboxScrollBar=class;
TSkinScrollbarH=class;
TSkinComBox = class(TSkinControl)
Protected
dwStyle,ExStyle:longword;
hlist,hbtn:Thandle;
isDrop:boolean;
// box :Tskinscrollbar;
FBtnObjectInst,FBtnPrevWndProc :pointer;
vb:TSkinScrollbarH;
db:TComboxScrollBar;
info:tagCOMBOBOXINFO;
rBtn:TRect;
procedure FindBtn;
procedure DrawSkinMap3( dc:HDC; rc:TRect;
bmp:Tbitmap;I,N:integer);
procedure DrawControl1( dc:HDC; rc:TRect);
procedure ButtonProc(var Message: TMessage);
procedure CNCommand(var Message: TWMCommand);
// procedure FindScrollbar;
procedure Unsubclass;override;
procedure DrawEdit( dc:HDC; rc:TRect);
procedure SkinDropList;
procedure DeleteDropList;
procedure DrawBorder( dc:HDC; rc:TRect);
procedure DrawArrow( dc:HDC; rc:TRect;i:integer);
public
HasButton:boolean;
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure AfterProc(var Message: TMessage);override;
procedure DrawControl( dc:HDC; rc:TRect);override;
Procedure Init(sf:Tcomponent;sd:TSkinData;acanvas:TCanvas;acolor:boolean=false);override;
Procedure Inithwnd(ahwnd:Thandle;sd:TSkinData;acanvas:TCanvas;sf:Tcomponent);override;
end;
TSkinRadioButton = class(TSkinControl)
Protected
trans:boolean;
public
procedure Init(sf:Tcomponent;sd:TSkinData;acanvas:TCanvas;acolor:boolean=false);override;
procedure AfterProc(var Message: TMessage);override;
function BeforeProc(var Message: TMessage):boolean;override;
procedure DrawControl( dc:HDC; rc:TRect);override;
end;
TSkinStatusBar = class(TSkinControl)
Protected
procedure Defaultpaint(acanvas:Tcanvas; rc:TRect;I:integer;
text:widestring='';Align:TAlignment=taLeftJustify);
procedure drawitem(dc:HDC; rc:TRect;I:integer;
text:widestring='';Align:TAlignment=taLeftJustify);
public
SizeGrip:boolean;
function BeforeProc(var Message: TMessage):boolean;override;
procedure DrawControl( dc:HDC; rc:TRect);override;
end;
TSkinBox = class(TSkinControl)
Protected
public
border:integer;
procedure AfterProc(var Message: TMessage);override;
Procedure Init(sf:Tcomponent;sd:TSkinData;acanvas:TCanvas;acolor:boolean=false);override;
Procedure Unsubclass; override;
end;
TSkinGroupBox = class(TSkinControl)
Protected
procedure DefaultDraw( dc:HDC; rc:TRect);
public
border:integer;
procedure Init(sf:Tcomponent;sd:TSkinData;acanvas:TCanvas;acolor:boolean=false);override;
function BeforeProc(var Message: TMessage):boolean;override;
procedure DrawControl( dc:HDC; rc:TRect);override;
end;
TSkinUpDown = class(TSkinControl)
Protected
procedure DrawButton(acanvas:Tcanvas;rc:TRect;n,ar:integer);
procedure DrawSkinButton(dc:HDC;rc:TRect;n,ar:integer);
procedure DrawBackGround(msg:Tmessage);
public
inedit : boolean;
dir : integer;
function BeforeProc(var Message: TMessage):boolean;override;
procedure DrawControl( dc:HDC; rc:TRect);override;
end;
TSkinTabPosition = (StTop,Stbottom,Stleft,Stright);
TSkinTab = class(TSkinControl)
Protected
CloseRect: array of TRect;
Position:TSkinTabPosition;
unicode:boolean;
procedure Drawitem( dc:HDC; rc:TRect;I:integer);
procedure ERASEBKGND( dc:HDC);
procedure GetPosition;
// procedure WMPaint(var msg:Tmessage);
procedure ClipUpdown(dc:HDC;rc:Trect);
function FindScroll:boolean;
procedure DrawTabBorder(adc:HDC);
procedure drawCloseBtn(rc:TRect;i:integer);
function BeforeProc(var Message: TMessage):boolean;override;
// procedure AfterProc(var Message: TMessage);override;
function ClickClose(var Message: TMessage):boolean;
public
tabbmp,borderbmp : Tbitmap;
Drawtemp: Tbitmap;
updown:TskinUpdown;
showclose:boolean;
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure DrawControl( dc:HDC; rc:TRect);override;
// function BeforeProc(var Message: TMessage):boolean;override;
Procedure Init(sf:Tcomponent;sd:TSkinData;acanvas:TCanvas;acolor:boolean=false);override;
Procedure Inithwnd(ahwnd:Thandle;sd:TSkinData;acanvas:TCanvas;sf:Tcomponent);override;
Procedure inittab;
Procedure SkinChange;override;
end;
TSkinTab31 = class(TSkinControl)
Protected
tabbmp:Tbitmap;
updown:TskinUpdown;
scroller : Twincontrol;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
function BeforeProc(var Message: TMessage):boolean;override;
procedure DrawControl( dc:HDC; rc:TRect);override;
//Procedure Inithwnd(ahwnd:Thandle;sd:TSkinData;acanvas:TCanvas;sf:Tcomponent);override;
Procedure Init(sf:Tcomponent;sd:TSkinData;acanvas:TCanvas;acolor:boolean=false);override;
Procedure inittab;
Procedure SkinChange;override;
end;
TSkinTabBtn = class(TSkinControl)
protected
public
function BeforeProc(var Message: TMessage):boolean;override;
procedure DrawControl( dc:HDC; rc:TRect);override;
end;
TSkinTransObj = class(TSkinControl)
Protected
procedure ERASEBKGND( dc:HDC);
public
// Brush,Oldbrush: HBrush;
function BeforeProc(var Message: TMessage):boolean;override;
procedure AfterProc(var Message: TMessage);override;
end;
TSkinProgress = class(TSkinControl)
Protected
public
function BeforeProc(var Message: TMessage):boolean;override;
procedure DrawControl1( dc:HDC; rc:TRect);
procedure DrawControl( dc:HDC; rc:TRect);override;
end;
TSkinTrackBar = class(TSkinControl)
Protected
procedure Drawthumb(PDraw:PNMCustomDraw);
function CustomDraw(PDraw:PNMCustomDraw):integer;
procedure DrawTrack(PDraw:PNMCustomDraw);
public
procedure Init(sf:Tcomponent;sd:TSkinData;acanvas:TCanvas;acolor:boolean=false);override;
procedure skinchange;override;
procedure Unsubclass;override;
function BeforeProc(var Message: TMessage):boolean;override;
end;
TSkinToolbar = class(TSkinControl)
Protected
gradCol1,gradCol2:integer;
// procedure Drawthumb(PDraw:PNMCustomDraw);
// function CustomDraw(PDraw:PNMCustomDraw):integer;
procedure ERASEBKGND(msg:Tmessage);
public
function BeforeProc(var Message: TMessage):boolean;override;
Procedure Init(sf:Tcomponent;sd:TSkinData;acanvas:TCanvas;acolor:boolean=false);override;
end;
TSkinEdit = class(TSkinControl)
Protected
procedure FindUPDown(ahwnd:Thandle;sd:TSkinData;acanvas:TCanvas);
procedure DrawControl1( dc:HDC; rc:TRect);
procedure PaintControl1(adc:HDC=0);
public
updown:TSkinUpDown;
// procedure Init(aControl:Twincontrol;sd:TSkinData;acanvas:TCanvas;acolor:boolean=false);override;
// procedure Inithwnd(ahwnd:Thandle;sd:TSkinData;acanvas:TCanvas);override;
procedure AfterProc(var Message: TMessage);override;
procedure DrawControl( dc:HDC; rc:TRect);override;
end;
TSkinSizer = class(TSkinControl)
Protected
public
// Procedure Init(sf:Tcomponent;sd:TSkinData;acanvas:TCanvas;acolor:boolean=false);override;
function BeforeProc(var Message: TMessage):boolean;override;
procedure DrawControl( dc:HDC; rc:TRect);override;
end;
TSkinBoxH = class(TSkinControl)
Protected
public
function BeforeProc(var Message: TMessage):boolean;override;
// procedure DrawControl( dc:HDC; rc:TRect);override;
end;
TSkinTabSheet = class(TSkinControl)
Protected
public
procedure DrawControl( dc:HDC; rc:TRect);override;
// Procedure Init(sf:Tcomponent;sd:TSkinData;acanvas:TCanvas;acolor:boolean=false);override;
function BeforeProc(var Message: TMessage):boolean;override;
end;
TSkinObjImage = class(TSkinControl)
Protected
procedure ChangeImage;
procedure SetRzImage;
procedure SetRzRadio;
procedure SetDevCheck;
public
kind:integer;
procedure Init(sf:Tcomponent;sd:TSkinData;acanvas:TCanvas;acolor:boolean=false);override;
procedure SkinChange; override;
procedure Unsubclass; override;
end;
TSkinAdvPage = class(TSkinControl)
Protected
updown:TskinUpdown;
procedure ChangeImage;
procedure SetAdvPage;
function FindScroll:boolean;
public
kind:integer;
procedure Init(sf:Tcomponent;sd:TSkinData;acanvas:TCanvas;acolor:boolean=false);override;
procedure SkinChange; override;
procedure Unsubclass; override;
procedure DrawControl( dc:HDC; rc:TRect);override;
end;
TScrollBarPos = record
Btn:integer;
ScrollArea:integer;
Thumb:integer;
ThumbPos:integer;
MsgID:integer;
end;
TSkinScroll=(HB,VB);
TSkinScrollBar = Class(TSkinControl)
protected
nobe:boolean;
procedure AfterProc(var Message: TMessage);override;
function BeforeProc(var Message: TMessage):boolean;override;
procedure SetScrollbarPos(message:TMessage);
procedure Unsubclass;override;
procedure DrawBorder( dc:HDC; rc:TRect);
procedure BENCPAINT(adc:HDC);
public
hb,vb:TWscrollbar;
postype:integer;
painted:boolean;
border:boolean;
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure InitScrollbar(acontrol:Twincontrol;sd:TSkinData;acanvas:TCanvas;sf:Tcomponent);virtual;
procedure DrawControl( dc:HDC; rc:TRect);override;
procedure SkinChange;override;
end;
TComboxScrollBar = Class(TSkinControl)
protected
nobe:boolean;
cw,len:integer;
scrollpos:integer;
thumbtop,thumbBottom:integer;
OffsetSC,trackp:tpoint;
trackthumb:integer;
fdown:boolean;
sbDir:integer;
procedure AfterProc(var Message: TMessage);override;
function BeforeProc(var Message: TMessage):boolean;override;
// procedure SetScrollbarPos(message:TMessage);
procedure PaintScrollbar( dc:HDC; rc:TRect; sbtype:integer );
procedure Unsubclass;override;
procedure GetThumb(rc:TRect);
function WMNCPaint(var message:TMessage):boolean;
function NCLButtonDown(var Message: TMessage):boolean;
public
postype:integer;
painted:boolean;
border:boolean;
// Info:array[HB..VB] of SCROLLINFO;
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure DrawControl( dc:HDC; rc:TRect);override;
end;
TSkinScrollBarH = Class(TSkinControl)
protected
procedure AfterProc(var Message: TMessage);override;
procedure SetScrollbarPos(message:TMessage);
procedure Unsubclass;override;
public
hb,vb:TWscrollbar;
postype:integer;
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Inithwnd(ahwnd:Thandle;sd:TSkinData;acanvas:TCanvas;sf:Tcomponent);override;
procedure DrawControl( dc:HDC; rc:TRect);override;
end;
TSkinScControl = class(TSkinControl)
protected
downBtn:integer;
SP: TScrollBarPos;
sb:TWscrollbar;
procedure AfterProc(var Message: TMessage);override;
public
procedure DrawControl( dc:HDC; rc:TRect);override;
procedure InitScrollbar(acontrol:Twincontrol;sd:TSkinData;acanvas:TCanvas;sf:Tcomponent);
procedure Unsubclass;override;
destructor Destroy;override;
end;
{ TSkinSCeControl = class(TSkinControl)
protected
sb:TEscrollbar;
sceControl:Tcontrol;
procedure AfterProc(var Message: TMessage);override;
public
procedure DrawControl( dc:HDC; rc:TRect);override;
procedure InitScrollbar(acontrol:Twincontrol;ascrollbar:Tcontrol;aType:integer;
sd:TSkinData;sf:Tcomponent);
procedure Unsubclass;override;
end;}
TSkinHeader = class(TSkinControl)
protected
Items:array of TRect;
indexitem:integer;
// trackinfo : TTrackMouseEvent;
procedure WMMouseMove(var Message: TMessage);
procedure DrawItem(ImgList:hImageList;acanvas:Tcanvas;rc:Trect;index:Integer);
procedure DrawItemImgCaption(acanvas: TCanvas; rc:TRect;
ImgList:hImageList;imgIndex:integer;text:widestring;talign:integer=DT_CENTER);
public
destructor Destroy;override;
procedure Inithwnd(ahwnd:Thandle;sd:TSkinData;acanvas:TCanvas;sf:Tcomponent);override;
procedure Init(sf:Tcomponent;sd:TSkinData;acanvas:TCanvas;acolor:boolean=false);override;
function BeforeProc(var Message: TMessage):boolean;override;
procedure AfterProc(var Message: TMessage);override;
procedure DrawControl( dc:HDC; rc:TRect);override;
end;
TSkinListView = class(TSkinScrollBar)
protected
FHeaderInstance: Pointer;
FDefHeaderProc: Pointer;
hHwnd: THandle;
header:Tskinheader;
procedure SetHeaderOwnerDraw;
procedure DrawHeaderItem(DrawItemStruct: TDrawItemStruct);
procedure Drawheader;
procedure drawitem(dc:HDC; rc:TRect;acolumn:TListColumn);
procedure WMNotify(var Message:TWMNotify);
public
Procedure InitScrollbar(acontrol:Twincontrol;sd:TSkinData;acanvas:TCanvas;sf:Tcomponent);override;
// function BeforeProc(var Message: TMessage):boolean;override;
procedure HeaderProc(var Message: TMessage);
end;
function GetProperty(control: TObject ;aprop:string):string;
function GetIntProperty(control: TObject ;aprop:string):integer;
function GetEnumProperty(control: TObject;aprop:string):string;
function GetStringProp(control: TObject;aprop:string):widestring;
function GetObjProp(control: TObject;aprop:string; MinClass: TClass):Tobject;
function GetObjMethod(control: TObject;aprop:string): TMethod;
procedure SetProperty(control: TObject;aprop,value:string);
function StringReplaceW(s,s1,s2:widestring):widestring;
procedure CopyBMP(src:Tbitmap;var dst:Tbitmap);
procedure FillColor( dc:HDC; rc:TRect;acolor:Tcolor);
function GetDisableImg(FOriginal:TBitmap):Tbitmap;
procedure DrawArrow(ACanvas: TCanvas; X, Y, Orientation: integer);
procedure MyDrawCaption(acanvas: TCanvas; rc:TRect;
text:widestring; enabled,defaulted:boolean;Alignment: TAlignment=taCenter);
procedure MyDrawImgCaption(acanvas: TCanvas; rc:TRect;
ImgList:TCustomImageList;imgIndex:integer;
text:string; enabled,defaulted:boolean;Alignment: TAlignment=taCenter);
//{$R MPLAYER}
implementation
uses ImgUtil,WinSkinForm,winskindlg;
const _maxcaption = 80;
function IsPopupWindow(hwnd:Thandle):boolean;
var style:dword;
begin
style:= GetWindowLong(hWnd,GWL_STYLE);
result:=false;
if (style and ws_popup)>0 then result:=true;
if GetParent(hWnd)=65556 then result:=true;
end;
procedure CopyBMP(src:Tbitmap;var dst:Tbitmap);
begin
dst.Width:=src.Width;
dst.Height:=src.Height;
dst.PixelFormat:=src.PixelFormat;
dst.Canvas.Draw(0,0,src);
end;
function GetFormCaption(ahwnd:Thandle):widestring;
var buf:array[0..1000] of char;
begin
result:='';
if Win32PlatformIsUnicode then begin
SetLength(Result, GetWindowTextLengthW(ahwnd) + 1);
GetWindowTextW(ahwnd, PWideChar(Result), Length(Result));
SetLength(Result, Length(Result) - 1);
end else begin
sendmessage(ahwnd,WM_GETTEXT,1000,integer(@buf));
result:=strpas(buf);
end;
end;
{procedure TControlSubClass.winpaint(var Message: TMessage);
var DC: HDC;
PS: TPaintStruct;
hwnd : Thandle;
begin
hwnd:=Twincontrol(control).handle;
canvas.handle := BeginPaint(hwnd, ps);
PaintControl;
if not done then orgWindowProc(Message);
EndPaint(hwnd, ps);
Canvas.Handle := 0;
message.result:=0;
Canvas.Lock;
try
Canvas.Handle := message.wparam;
try
PaintControl;
finally
end;
finally
Canvas.Unlock;
end;
message.result:=0;
end;}
constructor TSkinControl.Create(AOwner: TComponent);
begin
inherited create(aowner);
hwnd:=0;
Gcontrol := nil;
control := nil;
inited:=false;
skinstate:=0;
skinform:=nil;
isunicode:=false;
skinned:=true;
kind :=0;
sizing:=false;
parentbk:=false;
end;
//in Tfrom : skincontrol will destory when owner (control) is destory
//in Hwnd window : skincontrol will destory when capture wm_ncdestory message
//Unsubclass : used for unskin, restore old color.
Procedure TSkinControl.Init(sf:Tcomponent;sd:TSkinData;acanvas:TCanvas;acolor:boolean=false);
begin
if inited then exit;
newcolor:=acolor;
fsd:=sd;
skinform:=sf;
fCanvas:=acanvas;
control:=Twincontrol(owner);
hwnd := control.handle;
isunicode:=IsWindowUnicode(hwnd);
OldWndProc:= Control.WindowProc;
Control.WindowProc := NewWndProc;
// control.DoubleBuffered:=true;
Twinskinform(skinform).addcontrollist(self);
// Focused := (GetFocus= hWnd);
// enabled := (GetWindowLong(hWnd,GWL_STYLE) and WS_DISABLED)=0;
// caption:=getformcaption(hwnd);
if newcolor then begin
setparentbk(true);
oldcolor:=Taccontrol(control).color;
Taccontrol(control).color:=fsd.colors[csButtonFace];
end;
if parentbk then kind:=1;
control.Invalidate;
inited:=true;
skinstate:=skin_active;
end;
Procedure TSkinControl.SetColor;
begin
end;
Procedure TSkinControl.SetParentBK(value:boolean);
var PropInfo:PPropInfo;
s:string;
begin
{$ifdef DELPHI_7}
if xoParentBackGround in fsd.options then exit;
if control=nil then exit;
PropInfo:=GetPropInfo(control,'ParentBackground');
if PropInfo<>nil then begin
if value then begin
s:=lowercase(GetEnumProp(control,PropInfo));
if s='true' then parentbk:=true
else parentbk:=false;
if parentbk then
SetProperty(control,'ParentBackground','False');
end else begin
if parentbk then
SetProperty(control,'ParentBackground','True');
end;
end;
{$endif}
end;
Procedure TSkinControl.RestoreColor;
begin
end;
Procedure TSkinControl.Inithwnd(ahwnd:Thandle;sd:TSkinData;acanvas:TCanvas;sf:Tcomponent);
begin
fsd:=sd;
fCanvas:=acanvas;
skinform:=sf;
hwnd := ahwnd;
enabled:=true;
kind := 0;
Twinskinform(skinform).addcontrollist(self);
isunicode:=IsWindowUnicode(hwnd);
caption:=getformcaption(hwnd);
FObjectInst := MakeObjectInstance(NewWndProc);
if isunicode then begin
FPrevWndProc := Pointer(GetWindowLongw(hwnd,GWL_WNDPROC));
SetWindowLongw(hwnd, GWL_WNDPROC,LongInt(FObjectInst));
end else begin
FPrevWndProc := Pointer(GetWindowLong(hwnd,GWL_WNDPROC));
SetWindowLong(hwnd, GWL_WNDPROC,LongInt(FObjectInst));
end;
if hwnd<>0 then
InvalidateRect(hwnd, 0,true) ;
inited := true;
skinstate:=skin_active;
end;
Procedure TSkinControl.Unsubclass;
begin
if not skinned then exit;
skinned:=false;
if skinstate=skin_deleted then exit;
if newcolor and (control<>nil) then begin
setparentbk(false);
Taccontrol(control).color:=oldcolor;
end;
end;
Procedure TSkinControl.SkinChange;
begin
if newcolor and (control<>nil) then
Taccontrol(control).color:=fsd.colors[csButtonFace];
Invalidate;
// setproperty(control,'Color',inttostr(fsd.colors[csButtonFace]));
end;
destructor TSkinControl.Destroy;
var s:string;
begin
{ s:=caption;
if control<>nil then s:=s+' '+control.ClassName;
if gcontrol<>nil then s:=s+' '+gcontrol.ClassName;
skinaddlog('skincontrol destory '+s); }
if assigned(oldwndproc) then begin
if control<>nil then Control.WindowProc := OldWndProc;
oldwndproc:=nil;
end;
if fobjectinst<>nil then begin
if isunicode then
SetWindowLongw(hwnd, GWL_WNDPROC,LongInt(FPrevWndProc))
else
SetWindowLong(hwnd, GWL_WNDPROC,LongInt(FPrevWndProc));
FreeObjectInstance(FObjectInst);
fobjectinst:=nil;
end;
if skinform<>nil then Twinskinform(skinform).DeleteControl(self);
inherited destroy;
end;
function TSkinControl.GetParentColor(acolor:Tcolor):Tcolor;
var pcontrol:TacControl;
PropInfo:PPropInfo;
begin
result:=acolor;
if control<>nil then begin
pcontrol:=TAccontrol(control.parent);
if pcontrol<>nil then begin
PropInfo:=GetPropInfo(pcontrol,'Color');
if (PropInfo<>nil) and
(propinfo^.PropType^.Kind = tkInteger) then
result :=GetOrdProp(pcontrol,PropInfo)
else
result:= acolor;
end ;
end ;
end;
procedure TSkinControl.NewWndProc(var Message: TMessage);
var s:string;
begin
done:=false;
if message.msg=CN_SkinEnabled then begin
skinned:=message.WParam>0;
if skinned then Invalidate;
end else
if skinned then begin
if BeforeProc(message) then begin
default(Message);
AfterProc(message);
end;
end
else default(Message);
end;
procedure TSkinControl.Default(Var Msg: TMessage);
begin
if assigned(oldwndproc) then
OldWndProc(Msg)
else
msg.result:=CallWindowProc(FPrevWndProc,hwnd,Msg.msg,msg.WParam,msg.LParam);
end;
{procedure TSkinControl.Notification(AComponent: TComponent;Operation: TOperation);
var j:integer;
sf:TWinskinform;
begin
inherited Notification(AComponent, Operation);
if (Operation = opInsert) and (AComponent <> nil)
and (AComponent is Tcontrol) then begin
sf:=TWinskinform(skinform);
sf.AddComp(Tcontrol(acomponent),sf.FForm);
skinaddlog(format('Notification Insert :%s,%s',[acomponent.classname,acomponent.name]));
end;
end; }
procedure TSkinControl.MouseLeave;
begin
if hwnd>0 then sendmessage(hwnd,CM_MOUSELEAVE,0,0);
// Twinskinform(owner).activeskincontrol:=nil;
end;
procedure TSkinControl.Invalidate;
begin
//if control<>nil then control.Invalidate
//else
if gcontrol<>nil then gcontrol.invalidate
else if (hwnd>0) then begin
InvalidateRect(hwnd,0,true);
UpdateWindow(hwnd);
end;
end;
procedure TSkinControl.PaintControl(adc:HDC=0);
var dc:HDC ;
rc:TRect;
begin
if GetWindowRect( hWnd, rc ) then begin;
try
boundsrect:=rc;
OffsetRect( rc, -rc.left, -rc.top );
if (adc=0) then begin
DC := GetWindowDC( hWnd );
try
Drawcontrol(dc,rc);
finally
ReleaseDC( hwnd, DC );
end;
end else begin
//dc:=adc;
//boundsrect:=rc;
//OffsetRect( rc, -rc.left, -rc.top );
Drawcontrol(adc,rc);
end;
except
end;
end;
end;
procedure FillColor( dc:HDC; rc:TRect;acolor:Tcolor);
var Brush: HBrush;
begin
Brush := CreateSolidBrush(acolor);
try
fillrect(dc,rc,brush);
finally
DeleteObject(Brush);
end;
end;
procedure TSkinControl.FillBG( dc:HDC; rc:TRect);
var Brush: HBrush;
begin
Brush := CreateSolidBrush(fsd.colors[csButtonFace]);
try
fillrect(dc,rc,brush);
finally
DeleteObject(Brush);
end;
end;
function TSkinControl.GetWindowLongEx(ahWnd: HWND; nIndex: Integer): Longint;
begin
if isunicode then
result:=GetWindowLongw( ahWnd, nIndex )
else
result:=GetWindowLong( ahWnd, nIndex );
end;
procedure TSkinControl.FillParentBG( dc:HDC; rc:TRect);
var Brush: HBrush;
acolor:Tcolor;
begin
acolor:= getparentcolor(fsd.colors[csButtonFace]);
Brush := CreateSolidBrush(COLORREF(acolor));
try
fillrect(dc,rc,brush);
finally
DeleteObject(Brush);
end;
end;
procedure TSkinControl.DrawFocus(hDC: HDC; wString: WideString; rc: TRect; uFormat: UINT);
var r1:Trect;
//const
// Alignments: array[TAlignment] of Word = (DT_LEFT,DT_RIGHT,DT_CENTER );
begin
r1:=rc;
Tnt_DrawTextW(hdc,caption,r1,uformat or DT_CALCRECT or DT_NOCLIP);
if uformat and dt_center >0 then
OffsetRect(r1, ((rc.right - rc.left) - (r1.right - r1.left)) div 2,
((rc.Bottom - rc.Top) - (r1.Bottom - r1.Top)) div 2-1)
else if uformat and DT_RIGHT >0 then begin
OffsetRect(r1,((rc.right - rc.left) - (r1.right - r1.left)), 0);
end;
InflateRect(r1,2,1);
if r1.Top<rc.Top then r1.Top:=rc.Top;
if r1.Bottom>rc.Bottom then r1.Bottom:=rc.Bottom;
if r1.Right>rc.Right then r1.Right := rc.Right;
if r1.Left<rc.Left then r1.Left := rc.Left;
DrawFocusRect(hdc, r1);
end;
procedure TSkinControl.doLogMsg(aid:string;msg:TMessage);
var s:string;
begin
{$IFDEF test}
s:=MsgtoStr(msg);
if s='' then exit;
if SkinCanLog then Logstring.add(aid+s);
{$ENDIF}
end;
procedure TSkinControl.AfterProc(var Message: TMessage);
begin
case message.msg of
WM_Paint:
PaintControl(message.WParam);
WM_KILLFOCUS,WM_SETFOCUS:
Invalidate;
// PaintControl;
WM_SETTEXT: begin
Invalidate;
end;
CN_SkinEnabled :skinned := message.WParam>0;
wm_enable,CM_ENABLEDCHANGED:Invalidate;
end;
end;
function TSkinControl.BeforeProc(var Message: TMessage):boolean;
begin
result:=false;
case message.msg of
CN_IsSkined : message.result := 1;
WM_NCDESTROY:begin
result:=false;
skinstate:=skin_deleted;
default(message);
if skinned then begin
//skinned:=false;
Unsubclass;
end;
//can't free,leave it,until skinform free;
// free;
end;
else result:=true;
end;
end;
procedure TSkinControl.DrawControl( dc:HDC; rc:TRect);
begin
end;
function TSkinControl.GetState:integer;
begin
result:=1;
end;
function GetProperty(control: TObject ;aprop:string):string;
var PropInfo:PPropInfo;
s:string;
i:integer;
begin
s:='';
i:=0;
if control<>nil then begin
PropInfo:=GetPropInfo(control,aprop);
if PropInfo<>nil then begin
if propinfo^.PropType^.Kind= tkEnumeration then
s:=GetEnumProp(control,PropInfo)
else if propinfo^.PropType^.Kind = tkInteger then begin
// i:= GetInt64Prop(control,PropInfo);
i:=GetOrdProp(control,PropInfo);
s:=inttostr(i);
end;
end;
end;
result := s;
end;
function GetIntProperty(control: TObject ;aprop:string):integer;
var PropInfo:PPropInfo;
begin
result:= -1;
if control<>nil then begin
PropInfo:=GetPropInfo(control,aprop);
if (PropInfo<>nil) and
(propinfo^.PropType^.Kind = tkInteger) then begin
// i:= GetInt64Prop(control,PropInfo);
result :=GetOrdProp(control,PropInfo);
end;
end;
end;
function GetEnumProperty(control: TObject;aprop:string):string;
var PropInfo:PPropInfo;
begin
result:= '';
if control<>nil then begin
PropInfo:=GetPropInfo(control,aprop);
if (PropInfo<>nil) then
result := GetEnumProp(control,PropInfo);
end;
end;
{$IFNDEF COMPILER_5a}
procedure AssignWideStr(var Dest: WideString; const Source: WideString);
begin
Dest := Source;
end;
procedure IntGetWideStrProp(Instance: TObject; PropInfo: PPropInfo;
var Value: WideString); assembler;
asm
{ -> EAX Pointer to instance }
{ EDX Pointer to property info }
{ ECX Pointer to result string }
PUSH ESI
PUSH EDI
MOV EDI,EDX
MOV EDX,[EDI].TPropInfo.Index { pass index in EDX }
CMP EDX,$80000000
JNE @@hasIndex
MOV EDX,ECX { pass value in EDX }
@@hasIndex:
MOV ESI,[EDI].TPropInfo.GetProc
CMP [EDI].TPropInfo.GetProc.Byte[3],$FE
JA @@isField
JB @@isStaticMethod
@@isVirtualMethod:
MOVSX ESI,SI { sign extend slot offset }
ADD ESI,[EAX] { vmt + slot offset }
CALL DWORD PTR [ESI]
JMP @@exit
@@isStaticMethod:
CALL ESI
JMP @@exit
@@isField:
AND ESI,$00FFFFFF
MOV EDX,[EAX+ESI]
MOV EAX,ECX
CALL AssignWideStr
@@exit:
POP EDI
POP ESI
end;
function GetWideStrProp(Instance: TObject; PropInfo: PPropInfo): WideString;
begin
IntGetWideStrProp(Instance, PropInfo, Result);
end;
procedure SetWideStrProp(Instance: TObject; PropInfo: PPropInfo;
const Value: WideString); assembler;
asm
{ -> EAX Pointer to instance }
{ EDX Pointer to property info }
{ ECX Pointer to string value }
PUSH ESI
PUSH EDI
MOV ESI,EDX
MOV EDX,[ESI].TPropInfo.Index { pass index in EDX }
CMP EDX,$80000000
JNE @@hasIndex
MOV EDX,ECX { pass value in EDX }
@@hasIndex:
MOV EDI,[ESI].TPropInfo.SetProc
CMP [ESI].TPropInfo.SetProc.Byte[3],$FE
JA @@isField
JB @@isStaticMethod
@@isVirtualMethod:
MOVSX EDI,DI
ADD EDI,[EAX]
CALL DWORD PTR [EDI]
JMP @@exit
@@isStaticMethod:
CALL EDI
JMP @@exit
@@isField:
AND EDI,$00FFFFFF
ADD EAX,EDI
MOV EDX,ECX
CALL AssignWideStr
@@exit:
POP EDI
POP ESI
end;
{$ENDIF}
//TypInfo.pas
function GetStringProp(control: TObject;aprop:string):widestring;
var PropInfo:PPropInfo;
s:string;
begin
result:='';
if control<>nil then begin
PropInfo:=GetPropInfo(control,aprop);
if PropInfo<>nil then begin
case PropInfo^.PropType^.Kind of
{$IFDEF VER200}
tkUString: result :=GetStrProp(control,PropInfo);
{$ENDIF}
tkWString: result := GetWideStrProp(control,PropInfo);
else result:=StrToWideStr(GetStrProp(control,PropInfo));
end;
end;
end;
end;
function GetControlCaption(control: TACControl):widestring;
var PropInfo:PPropInfo;
s:string;
aprop:string;
begin
result:='';
aprop:='Caption';
if control<>nil then begin
PropInfo:=GetPropInfo(control,aprop);
if PropInfo<>nil then begin
case PropInfo^.PropType^.Kind of
tkWString: result := control.caption;
else result:=StrToWideStr(control.caption);
end;
end;
end;
end;
function GetObjMethod(control: TObject;aprop:string): TMethod;
var PropInfo:PPropInfo;
begin
// result:=nil;
if control<>nil then begin
PropInfo:=GetPropInfo(control,aprop);
if PropInfo<>nil then begin
result:=GetMethodProp(control,PropInfo);
end;
end;
end;
function GetObjProp(control: TObject;aprop:string; MinClass: TClass):Tobject;
var PropInfo:PPropInfo;
begin
result:=nil;
if control<>nil then begin
PropInfo:=GetPropInfo(control,aprop);
if PropInfo<>nil then begin
result:=GetObjectProp(control,PropInfo,MinClass);
end;
end;
end;
procedure SetProperty(control: TObject;aprop,value:string);
var PropInfo:PPropInfo;
begin
if control<>nil then begin
PropInfo:=GetPropInfo(control,aprop);
if PropInfo<>nil then begin
if propinfo^.PropType^.Kind= tkEnumeration then
SetEnumProp(control,PropInfo,value)
else if propinfo^.PropType^.Kind= tkInteger then
SetOrdProp(control,PropInfo,strtoint(value))
else if propinfo^.PropType^.Kind= tkString then
SetStrProp(control,PropInfo,value)
else if propinfo^.PropType^.Kind= tkLString then
SetStrProp(control,PropInfo,value)
else if propinfo^.PropType^.Kind= tkWString then
SetStrProp(control,PropInfo,value);
end;
end;
end;
procedure TSkinButton.DoMouseDown(var Message: TWMMouse);
var acontrol:Taccontrol;
p:Tpoint;
begin
acontrol:=TACcontrol(control);
with Message do
if (acontrol.Width > 32768) or (acontrol.Height > 32768) then begin
GetCursorPos(p);
p := acontrol.ScreenToClient(p);
acontrol.MouseDown(mbLeft, KeysToShiftState(Keys), p.X, p.Y);
// with acontrol.CalcCursorPos do
// acontrol.MouseDown(mbLeft, KeysToShiftState(Keys), p.X, p.Y);
end else
acontrol.MouseDown(mbLeft, KeysToShiftState(Keys), Message.XPos, Message.YPos);
end;
{procedure TSkinButton.SetRedraw(b:boolean);
begin
redraw:=b;
if b then begin
KillTimer(hwnd, 1);
sendmessage(hwnd,WM_SETREDRAW,1,0);
Application.ProcessMessages;
end else begin
KillTimer(hwnd, 1);
sendmessage(hwnd,WM_SETREDRAW,0,0);
SetTimer(hwnd, 1, 100, nil);
end;
end; }
procedure TSkinButton.SetRedraw(b:boolean);
var dw:dword;
begin
// redraw:=b;
dw := GetWindowLong(hwnd, GWL_STYLE);
if b then begin
KillTimer(hwnd, 1);
if redraw then
dw := dw or WS_VISIBLE;
redraw:=false;
end else begin
KillTimer(hwnd, 1);
redraw := true;
dw := dw and not WS_VISIBLE;
SetTimer(hwnd, 1, 100, nil);
end;
SetWindowLong(hwnd, GWL_STYLE, dw);
end;
function TSkinButton.BeforeProc(var Message: TMessage):boolean;
var s:string;
sf: Twinskinform;
begin
{$IFDEF buttontest}
s:= MsgtoStr(message);
if s<>'' then begin
s:=format('Button %s %1x %s',[caption,hwnd,s]);
fsd.dodebug(s);
//skinaddlog(s);
end;
{$ENDIF}
{ if message.msg= CM_VISIBLECHANGED then begin
if message.wParam=0 then begin
if redraw then setredraw(true);
end;
result:=true;
exit;
end else if isdefault then begin
default(message);
result:=false;
exit;
end; }
result:=true;
case message.msg of
WM_LBUTTONDOWN, WM_LBUTTONDBLCLK:
begin
if not Focused then begin
SetFocus(hwnd);
end;
state:=state+[scDown];
PaintControl(0);
result:=false;
if (kind=0) and (control<>nil) then DoMouseDown(TWMMouse(message));
end;
{ WM_LBUTTONUP:
if scDown in state then begin
state:=state-[scDown];
PaintControl(0);
setredraw(false);
skinned:=false;
sendmessage(hwnd,WM_LBUTTONDOWN,message.WParam,message.LParam);
application.ProcessMessages;
sendmessage(hwnd,WM_LBUTTONUP,message.WParam,message.LParam);
skinned:=true;
setredraw(true);
if IsWindowVisible(hwnd) then
Invalidate;
application.ProcessMessages;
result:=false;
end; }
{ WM_LBUTTONDOWN, WM_LBUTTONDBLCLK:
begin
if not Focused then begin
SetFocus(hwnd);
end;
state:=state+[scDown];
setredraw(false);
// sendmessage(hwnd,WM_SETREDRAW,0,0);
default(message);
// sendmessage(hwnd,WM_SETREDRAW,1,0);
setredraw(true);
PaintControl(0);
result:=false;
end;
WM_LBUTTONUP:
if scDown in state then begin
state:=state-[scDown];
setredraw(false);
default(message);
setredraw(true);
if IsWindowVisible(hwnd) then
Invalidate;
result:=false;
end;}
WM_TIMER : begin
setredraw(true);
result:=false;
end;
WM_ERASEBKGND:begin
message.Result:=1;
result:=false;
end;
wm_paint: begin
wmpaint(message);
result:=false;
end;
{ wm_enable,CM_ENABLEDCHANGED:begin
WMEnable(message);
result:=false;
end; }
else result:=inherited beforeProc(message);
end;
end;
{function TSkinButton.BeforeProc(var Message: TMessage):boolean;
var s:string;
sf: Twinskinform;
begin
if message.msg= CM_VISIBLECHANGED then begin
if message.wParam=0 then begin
if redraw then setredraw(true);
end;
result:=true;
exit;
end else if isdefault then begin
default(message);
result:=false;
exit;
end;
result:=true;
case message.msg of
WM_LBUTTONDOWN, WM_LBUTTONDBLCLK:
begin
if not Focused then begin
SetFocus(hwnd);
end;
state:=state+[scDown];
PaintControl(0);
result:=false;
end;
WM_LBUTTONUP:
if scDown in state then begin
state:=state-[scDown];
PaintControl(0);
setredraw(false);
isdefault:=true;
sendmessage(hwnd,WM_LBUTTONDOWN,message.WParam,message.LParam);
sendmessage(hwnd,WM_LBUTTONUP,message.WParam,message.LParam);
isdefault:=false;
setredraw(true);
if IsWindowVisible(hwnd) then
Invalidate;
result:=false;
end;
WM_TIMER : begin
setredraw(true);
result:=false;
end;
WM_ERASEBKGND:begin
message.Result:=1;
result:=false;
end;
wm_paint: begin
wmpaint(message);
result:=false;
end;
else result:=inherited beforeProc(message);
end;
end;}
procedure TSkinButton.WMEnable(var Message: TMessage);
var dw: dword;
begin
{ dw:=GetWindowLong(hWnd,GWL_STYLE);
dw := dw and ( not WS_VISIBLE);
SetWindowLong( hwnd, GWL_STYLE, dw);
dw := dw or WS_VISIBLE;
SetWindowLong( hwnd, GWL_STYLE, dw);}
default(Message);
Invalidate;
end;
procedure TSkinButton.AfterProc(var Message: TMessage);
var sf:Twinskinform;
s:string;
begin
case message.msg of
{ CM_MOUSEENTER:
if Enabled then begin
state:=state+[scMouseIn];
Invalidate;
end;
CM_MOUSELEAVE:
if Enabled then begin
state:=state-[scMouseIn];
state:=state-[scDown];
Invalidate;
end; }
WM_MOUSEMove:begin
if enabled and (not (scmousein in state)) then begin
state:=state+[scMouseIn];
Invalidate;
end;
WinSkinData.DoTrackMouse(hwnd);
end;
WM_MOUSELEAVE: begin
// if (scDown in state) then begin
state:=state-[scMouseIn];
state:=state-[scDown];
invalidate;
// end;
end;
WM_LBUTTONUP:
if scDown in state then begin
state:=state-[scDown];
//PaintControl(0);
Invalidate;
s:=lowercase(GetWindowClassname(hwnd));
if control<>nil then begin
TACcontrol(control).Click ;
// postMessage(getparent(hwnd),WM_COMMAND,BN_CLICKED,hWnd)
end else if (s='tbutton') then
postMessage(getparent(hwnd),WM_COMMAND,BN_CLICKED,hWnd)
else
postMessage(getparent(hwnd),WM_COMMAND,BN_CLICKED*$100+GetDlgCtrlID(hwnd),hWnd);
end;
WM_SETTEXT: PaintControl(0);
CM_FOCUSCHANGED : invalidate;
CM_DIALOGKEY:invalidate;
WM_KEYDOWN:
if Message.WParam = VK_SPACE then begin
state:=state+[scDown];
Invalidate;
end;
WM_KEYUP:
if Message.WParam = VK_SPACE then begin
state:=state-[scDown];
Invalidate;
end;
else inherited AfterProc(message);
end;
end;
{procedure TSkinButton.DrawControl( dc:HDC; rc:TRect);
var i:integer;
r1:Trect;
acolor:Tcolor;
bfont,cfont:Hfont;
temp:Tbitmap;
begin
if fsd.button=nil then exit;
if fsd.Button.map.empty then exit;
i:=1;
temp:=Tbitmap.create;
Focused := (GetFocus= hWnd);
enabled := (GetWindowLong(hWnd,GWL_STYLE) and WS_DISABLED)=0;
caption:=getformcaption(hwnd);
if (caption='') and (control<>nil) then
caption:=Taccontrol(control).caption;
if focused then i:=4;
if (scDown in state) then i:=2
else if (scMouseIn in state) then i:=4;
if not enabled then i:=3;
r1:=rc;
offsetrect(r1,-r1.left,-r1.top);
temp.width:=r1.right;
temp.height:=r1.bottom;
DrawBMPSkin(temp,r1,fsd.button,i,5,fsd.button.Trans);
bfont:=sendmessage(hwnd,wm_getfont,0,0);
cfont:=selectobject(temp.canvas.handle,bfont);
SetTextColor(temp.canvas.handle,fsd.colors[csButtonText]);
if (i=1) then
SetTextColor(temp.canvas.handle,fsd.button.normalcolor2);
if (i=4) then
SetTextColor(temp.canvas.handle,fsd.button.overcolor2);
if (i=2) then
SetTextColor(temp.canvas.handle,fsd.button.downcolor2);
if not enabled then
SetTextColor(temp.canvas.handle,COLORREF(clBtnShadow));
DrawCaption(temp.canvas,r1,caption,enabled,false);
// DrawBuf( dc,rc);
BitBlt(dc,rc.left ,rc.top,rc.right-rc.left,rc.bottom-rc.Top,
temp.Canvas.Handle ,0 ,0 ,Srccopy);
selectobject(temp.canvas.handle,cfont);
temp.Free;
end;}
constructor TSkinButton.Create(AOwner: TComponent);
begin
inherited create(aowner);
btemp:=Tbitmap.create;
trans:=false;
isdefault:=false;
end;
destructor TSkinButton.Destroy;
begin
if btemp<>nil then btemp.free;
btemp:=nil;
inherited destroy;
end;
Procedure TSkinButton.Init(sf:Tcomponent;sd:TSkinData;acanvas:TCanvas;acolor:boolean=false);
var s:string;
begin
inherited init(sf,sd,acanvas,acolor);
kind :=0;
s:=lowercase(control.classname);
if pos('trz',s)=1 then kind:=1;
if pos('tel',s)=1 then kind:=1;
if (control.Tag=5555) or (xoTransparent in fsd.options) then
trans:=true;
end;
procedure TSkinButton.DrawBtnText(acanvas: TCanvas; rc:TRect;
text:String;Alignment:word=DT_CENTER);
const
Alignments: array[TAlignment] of Word = (DT_LEFT,DT_RIGHT,DT_CENTER );
var
r1: TRect;
DrawStyle: Longint;
s,s1:string;
begin
DrawStyle := DT_EXPANDTABS or Alignment or dt_WordBreak;
{ if multiline then begin
DrawStyle := DrawStyle or dt_WordBreak;
s:=WideStringToStringEx(caption);
s:=stringreplace(s,'||',#13#10,[rfReplaceAll]);
caption := StrToWideStr(s);
end;}
s:= StrToWideStr('||');
s1:= StrToWideStr(#13#10);
caption := StringReplaceW(caption,s,s1);
r1 := rc;
inflaterect(r1,-2,-2);
SetBkMode(aCanvas.Handle, TRANSPARENT);
with ACanvas do begin
Tnt_DrawTextW(ACanvas.Handle, caption,r1,DrawStyle or DT_CALCRECT or DT_NOCLIP);
offsetrect(r1,-r1.Left,-r1.Top);
drawstyle:=checkBiDi(drawStyle);
//DrawText(ACanvas.Handle,PChar(Text),Length(Text),r1,DrawStyle or DT_CALCRECT or DT_NOCLIP);
if Alignment=dt_center then
OffsetRect(r1, ((rc.right - rc.left) - (r1.right - r1.left)) div 2,
((rc.Bottom - rc.Top) - (r1.Bottom - r1.Top)) div 2-1)
else begin
OffsetRect(r1, 0,((rc.Bottom - rc.Top) - (r1.Bottom - r1.Top)) div 2-1);
r1.Left:=rc.left;r1.right:=rc.Right;
end;
// DrawText(ACanvas.Handle, PChar(Text),-1,r1,DrawStyle);
Tnt_DrawTextW(ACanvas.Handle, caption,r1,DrawStyle);
SetBkMode(aCanvas.Handle, OPAQUE);
if focused and not (xoNoFocusRect in fsd.Options) then begin
InflateRect(r1,2,2);
DrawFocusRect(r1);
end;
end;
end;
function TSkinButton.GetFontColor(var acolor:Tcolor):boolean;
var
font:Tfont;
b:boolean;
PropInfo:PPropInfo;
begin
b:=false;
font := Tfont(GetObjProp(control,'Font',Tfont));
if font<>nil then begin
PropInfo:=GetPropInfo(font,'Color');
if (PropInfo<>nil) and
(propinfo^.PropType^.Kind = tkInteger) then begin
acolor :=GetOrdProp(control,PropInfo);
b:=true;
end;
end;
result:=b;
end;
procedure TSkinButton.DrawControl( dc:HDC; rc:TRect);
var i:integer;
r1:Trect;
acolor,color0:Tcolor;
bfont,cfont:Hfont;
style:dword;
isdefault:boolean;
font:Tfont;
s:string;
begin
if fsd.button=nil then exit;
if fsd.Button.map.empty then exit;
i:=1;
style:=GetWindowLong(hWnd,GWL_STYLE);
Focused := (GetFocus= hWnd);
enabled := ( style and WS_DISABLED )=0;
// dw:= ( style and $0f );
// isdefault := (( style and $0f ) = BS_DEFPUSHBUTTON );
s := lowercase(GetEnumProperty(control,'Default'));
isdefault := (s = 'true');
multiline := false;
if (control<>nil) then begin
caption := GetStringProp(control,'Caption');
s := lowercase(GetEnumProperty(control,'MultiLine'));
if s='true' then multiline := true;
end else
caption:=getformcaption(hwnd);
if focused then i:=5;
if isdefault then i:=5;
if (scDown in state) then i:=2
else if (scMouseIn in state) then i:=4;
if not enabled then i:=3;
r1:=rc;
offsetrect(r1,-r1.left,-r1.top);
btemp.width:=r1.right;
btemp.height:=r1.bottom;
if trans then
DrawParentImage(control,btemp.canvas.handle,true)
else
fillBG(btemp.canvas.handle,r1);
{ if (not (xoTransparent in fsd.options)) or (control=nil) then begin
fillBG(btemp.canvas.handle,r1);
end
else if control<>nil then
DrawParentImage(control,btemp.canvas.handle,true);}
//else FillBG(btemp.canvas.handle,r1); }
DrawSkinMap( btemp.canvas.handle,r1,fsd.button,I,fsd.Button.frame);
if control<>nil then begin
font := Tfont(GetObjProp(control,'Font',Tfont));
if font<>nil then btemp.canvas.font.assign(font);
// if (i=1) and (fsd.button.newnormal) then
if (fsd.button.newnormal) then
btemp.canvas.Font.Color:= fsd.button.normalcolor2;
if (i=4) and (fsd.button.newover) then
btemp.canvas.Font.Color:= fsd.button.overcolor2;
if (i=2) and (fsd.Button.newdown) then
btemp.canvas.Font.Color:= fsd.button.downcolor2;
if not enabled then
btemp.canvas.Font.Color := clBtnShadow;
// getfontcolor(color0);
end else begin
bfont:=sendmessage(hwnd,wm_getfont,0,0);
cfont:=selectobject(btemp.canvas.handle,bfont);
SetTextColor(btemp.canvas.handle,ColorToRGB(fsd.colors[csButtonText]));
// if (i=1) and (fsd.button.newnormal) then
if (fsd.button.newnormal) then
SetTextColor(btemp.canvas.handle,ColorToRGB(fsd.button.normalcolor2));
// if ((i=4) or (i=5)) and (fsd.button.newover) then
if (i=4) and (fsd.button.newover) then
SetTextColor(btemp.canvas.handle,ColorToRGB(fsd.button.overcolor2));
if (i=2) and (fsd.Button.newdown) then
SetTextColor(btemp.canvas.handle,ColorToRGB(fsd.button.downcolor2));
if not enabled then
SetTextColor(btemp.canvas.handle,ColorToRGB(clBtnShadow));
end;
DrawBtnText(btemp.canvas,r1,caption);
// Bitmapdraw(dc,rc,btemp);
BitBlt(dc,rc.left ,rc.top,rc.right-rc.left,rc.bottom-rc.Top,
btemp.Canvas.Handle ,0 ,0 ,Srccopy);
selectobject(btemp.canvas.handle,cfont);
{$IFDEF buttontest}
skinaddlog(format('Button Draw %s %1x %1x',[caption,hwnd,dc]));
{$ENDIF}
end;
{procedure TSkinButton.DrawControl( dc:HDC; rc:TRect);
var i:integer;
r1:Trect;
acolor:Tcolor;
bfont,cfont:Hfont;
begin
if fsd.button=nil then exit;
if fsd.Button.map.empty then exit;
i:=1;
Focused := (GetFocus= hWnd);
enabled := (GetWindowLong(hWnd,GWL_STYLE) and WS_DISABLED)=0;
caption:=getformcaption(hwnd);
if (caption='') and (control<>nil) then
caption:=Taccontrol(control).caption;
if focused then i:=4;
if (scDown in state) then i:=2
else if (scMouseIn in state) then i:=4;
if not enabled then i:=3;
r1:=rc;
offsetrect(r1,-r1.left,-r1.top);
bg.width:=r1.right;
bg.height:=r1.bottom;
DrawSkin(r1,fsd.button,i,5,fsd.button.Trans);
// DrawSkinMap( dc:HDC; rc:TRect;aObject:TdataSkinObject;I,N:integer)
bfont:=sendmessage(hwnd,wm_getfont,0,0);
cfont:=selectobject(bg.canvas.handle,bfont);
SetTextColor(bg.canvas.handle,fsd.colors[csButtonText]);
if (i=1) then
SetTextColor(bg.canvas.handle,fsd.button.normalcolor2);
if (i=4) then
SetTextColor(bg.canvas.handle,fsd.button.overcolor2);
if (i=2) then
SetTextColor(bg.canvas.handle,fsd.button.downcolor2);
if not enabled then
SetTextColor(bg.canvas.handle,COLORREF(clBtnShadow));
DrawCaption(bg.canvas,r1,caption,enabled,false);
SetBkMode(bg.canvas.handle,OPAQUE);
DrawBuf( dc,rc);
selectobject(bg.canvas.handle,cfont);
end;}
{procedure TButtonGlyph.CalcButtonLayout(Canvas: TCanvas; const Client: TRect;
const Offset: TPoint; const Caption: string; Layout: TButtonLayout; Margin,
Spacing: Integer; var GlyphPos: TPoint; var TextBounds: TRect;
BiDiFlags: LongInt);}
{procedure TSkinBitButton.DrawControl( dc:HDC; rc:TRect);
var btn:TBitBtn;
acolor:Tcolor;
i,n,j:integer;
spacing,margin:integer;
r1,TextBounds:Trect;
Layout: TButtonLayout;
TextPos: TPoint;
GlyphPos, ClientSize, GlyphSize, TextSize: TPoint;
TotalSize: TPoint;
DrawStyle: Longint;
cfont,bfont:Hfont;
begin
if fsd.button=nil then exit;
if fsd.Button.map.empty then exit;
DrawStyle:=DT_LEFT;}
function StringReplaceW(s,s1,s2:widestring):widestring;
var i,p,l:integer;
begin
result:=s;
l:=length(s);
p:=pos(s1,s);
if p>0 then begin
result:=copy(s,1,p-1)+s2+copy(s,p+length(s1),l);
end;
end;
procedure TSkinBitButton.DrawControl( dc:HDC; rc:TRect);
var acolor:Tcolor;
i,j:integer;
r1,TextBounds:Trect;
Layout: TButtonLayout;
NumGlyphs,margin,spacing :integer;
TextPos: TPoint;
GlyphPos, ClientSize, GlyphSize, TextSize: TPoint;
TotalSize: TPoint;
DrawStyle: Longint;
cfont,bfont:Hfont;
font:Tfont;
style : dword;
s,s1:widestring;
bglyph:Tbitmap;
bglist:Timagelist;
imageindex,disabledindex:integer;
isdefault:boolean;
s2,bname:string;
begin
if fsd.button=nil then exit;
if fsd.Button.map.empty then exit;
s:=lowercase(GetEnumProperty(gcontrol,'Visible'));
if s = 'false' then exit;
if Length(PicField)>0 then begin
drawPicControl(dc,rc);
exit;
end;
// DrawStyle:=DT_LEFT;
Focused := (GetFocus= hWnd);
style := GetWindowLong(hWnd,GWL_STYLE);
enabled := ( style and WS_DISABLED )=0;
// caption:=getformcaption(hwnd);
//dw := ( style and $0f );
//isdefault := (dw = BS_DEFPUSHBUTTON );
s2 := lowercase(GetEnumProperty(control,'Default'));
isdefault := (s2 = 'true');
if control<>nil then
caption := GetStringProp(control,'Caption')
// caption := GetControlCaption(TACControl(control))
else
caption:=getformcaption(hwnd);
// btn:=TBitBtn(control);
// if btn.default then i:=5;
// s:=lowercase(GetEnumProperty(control,'Default'));
i:=1;
if Focused then i:=5;
if isdefault then i:=5;
if (scDown in state) then i:=2
else if (scMouseIn in state) then i:=4;
if not enabled then i:=3;
case i of
1: j:=1;
2: j:=3;
3: j:=2;
4: j:=1;
else j:=1;
end;
r1:=rc;
offsetrect(r1,-r1.left,-r1.top);
btemp.width:=r1.right;
btemp.height:=r1.bottom;
bfont:=sendmessage(hwnd,wm_getfont,0,0);
cfont:=selectobject(btemp.canvas.handle,bfont);
if trans then
DrawParentImage(control,btemp.canvas.handle,true)
else
fillBG(btemp.canvas.handle,r1);
DrawSkinMap( btemp.canvas.handle,r1,fsd.button,I,fsd.button.frame);
ClientSize := Point(rc.Right - rc.Left,rc.Bottom - rc.Top);
font := Tfont(GetObjProp(control,'Font',Tfont));
bglyph := Tbitmap(GetObjProp(control,'Glyph',Tbitmap));
bglist := Timagelist(GetObjProp(control,'Images',Timagelist));
NumGlyphs := GetIntProperty(control,'NumGlyphs') ;
imageindex := GetIntProperty(control,'ImageIndex') ;
disabledindex := GetIntProperty(control,'DisabledIndex') ;
if NumGlyphs<0 then NumGlyphs:=1;
Margin := GetIntProperty(control,'Margin') ;
Spacing := GetIntProperty(control,'Spacing') ;
s := lowercase(GetEnumProperty(control,'Layout'));
if s='blglyphleft' then layout:=blGlyphLeft
else if s='blglyphright' then layout:=blGlyphRight
else if s='blglyphtop' then layout:=blGlyphTop
else if s='blglyphbottom' then layout:=blGlyphbottom;
if (bGlyph <> nil) and (not bglyph.Empty) then
GlyphSize := Point(bGlyph.Width div NumGlyphs, bglyph.Height)
else if (bglist<>nil) and (imageindex<>-1) then
GlyphSize := Point(bglist.Width, bglist.Height)
else GlyphSize := Point(0, 0);
btemp.canvas.font.assign(font);
DrawStyle := dt_WordBreak;
s:= StrToWideStr('||');
s1:= StrToWideStr(#13#10);
caption := StringReplaceW(caption,s,s1);
TextBounds := r1;//Rect(0, 0, r1.right-GlyphSize.x, 0);
inflaterect(TextBounds,-2,-2);
case Layout of
blGlyphLeft,blGlyphRight: Dec(TextBounds.Right,GlyphSize.X+2);
blGlyphTop,blGlyphBottom: Dec(TextBounds.Bottom,GlyphSize.y+2)
end;
if Length(Caption) > 0 then begin
// TextBounds := r1;//Rect(0, 0, r1.right-GlyphSize.x, 0);
// DrawText(btemp.canvas.handle, PChar(Caption),-1, TextBounds,DT_CALCRECT or dt_left);
Tnt_DrawTextW(btemp.canvas.handle,caption,TextBounds,DT_CALCRECT or dt_left or dt_WordBreak);
TextSize := Point(TextBounds.Right - TextBounds.Left, TextBounds.Bottom -
TextBounds.Top);
end else begin
TextBounds := Rect(0, 0, 0, 0);
TextSize := Point(0,0);
end;
if Layout in [blGlyphLeft, blGlyphRight] then begin
GlyphPos.Y := (ClientSize.y - GlyphSize.Y + 1) div 2;
TextPos.Y := (ClientSize.y - TextSize.Y + 1) div 2;
end else begin
GlyphPos.X := (ClientSize.x - GlyphSize.X + 1) div 2;
TextPos.X := (ClientSize.x - TextSize.X + 1) div 2;
end;
// margin:=btn.margin;
// spacing:=btn.spacing;
if (TextSize.X = 0) or (GlyphSize.X = 0) then
Spacing := 0;
s := lowercase(GetEnumProperty(control,'Alignment'));
if (Margin = -1) or (s='tacenter') then begin
if Spacing = -1 then begin
TotalSize := Point(GlyphSize.X + TextSize.X, GlyphSize.Y + TextSize.Y);
if Layout in [blGlyphLeft, blGlyphRight] then
Margin := (ClientSize.x - TotalSize.X) div 3
else
Margin := (ClientSize.y - TotalSize.Y) div 3;
Spacing := Margin;
end else begin
TotalSize := Point(GlyphSize.X+Spacing+TextSize.X, GlyphSize.Y+
Spacing + TextSize.Y);
if Layout in [blGlyphLeft, blGlyphRight] then
Margin := (ClientSize.x - TotalSize.X ) div 2
else
Margin := (ClientSize.y - TotalSize.Y ) div 2;
end;
end else begin
if Spacing = -1 then begin
TotalSize := Point(ClientSize.x - (Margin + GlyphSize.X), ClientSize.y -
(Margin + GlyphSize.Y));
if Layout in [blGlyphLeft, blGlyphRight] then
Spacing := (TotalSize.X - TextSize.X) div 2
else
Spacing := (TotalSize.Y - TextSize.Y) div 2;
end;
end;
case Layout of
blGlyphLeft:
begin
GlyphPos.X := Margin;
TextPos.X := GlyphPos.X + GlyphSize.X + Spacing;
DrawStyle:=DT_left or DrawStyle;
end;
blGlyphRight:
begin
GlyphPos.X := ClientSize.x - Margin - GlyphSize.X;
TextPos.X := GlyphPos.X - Spacing - TextSize.X;
DrawStyle:=DT_RIGHT or DrawStyle;
end;
blGlyphTop:
begin
GlyphPos.Y := Margin;
TextPos.Y := GlyphPos.Y + GlyphSize.Y + Spacing;
DrawStyle:=DT_center or DrawStyle;
end;
blGlyphBottom:
begin
GlyphPos.Y := ClientSize.y - Margin - GlyphSize.Y;
TextPos.Y := GlyphPos.Y - Spacing - TextSize.Y;
DrawStyle:=DT_center or DrawStyle;
end;
end;
r1:=rect(glyphpos.x,glyphpos.y,0,0);
if (bglyph<>nil) and (not bglyph.Empty) then
DrawGlyph(btemp.canvas,r1,bglyph,j,NumGlyphs)
else if (bglist<>nil) then begin
if enabled then begin
if (imageindex<>-1) then
bglist.Draw(btemp.canvas, r1.Left, r1.Top, ImageIndex,Enabled);
end else begin
if (disabledindex<>-1) then
bglist.Draw(btemp.canvas, r1.Left, r1.Top, disabledIndex,enabled)
else if (imageindex<>-1) then
bglist.Draw(btemp.canvas, r1.Left, r1.Top, ImageIndex,Enabled);
end;
end;
TextBounds:= rect(textpos.x,textpos.y,textpos.x+TextSize.x,textpos.y+TextSize.y);
SetBkMode(btemp.Canvas.Handle, TRANSPARENT);
// if (i=1) and (fsd.button.newnormal) then
if (fsd.button.newnormal) then
btemp.canvas.Font.Color:= fsd.button.normalcolor2;
if (i=4) and (fsd.button.newover) then
btemp.canvas.Font.Color:= fsd.button.overcolor2;
if (i=2) and (fsd.Button.newdown) then
btemp.canvas.Font.Color:= fsd.button.downcolor2;
if not enabled then
btemp.canvas.Font.Color := clBtnShadow;
// btemp.canvas.Font.Assign(btn.Font);
// DrawText(btemp.canvas.Handle, PChar(btn.caption),Length(btn.caption),TextBounds,DrawStyle);
if length(caption)>0 then begin
drawstyle:=checkbidi(drawstyle);
Tnt_DrawTextW(btemp.canvas.Handle,caption,TextBounds,DrawStyle);
SetBkMode(btemp.canvas.Handle, OPAQUE);
if focused and not (xoNoFocusRect in fsd.Options) then begin
InflateRect(TextBounds,2,2);
DrawFocusRect(btemp.canvas.Handle,TextBounds);
end;
end;
BitBlt(dc,rc.left ,rc.top,rc.right-rc.left,rc.bottom-rc.Top,
btemp.Canvas.Handle ,0 ,0 ,Srccopy);
selectobject(btemp.canvas.handle,cfont);
end;
procedure TSkinBitButton.DrawPicControl( dc:HDC; rc:TRect);
var acolor:Tcolor;
i,j:integer;
r1,TextBounds:Trect;
Layout: TButtonLayout;
NumGlyphs,margin,spacing :integer;
TextPos: TPoint;
GlyphPos, ClientSize, GlyphSize, TextSize: TPoint;
TotalSize: TPoint;
DrawStyle: Longint;
cfont,bfont:Hfont;
font:Tfont;
style : dword;
s,s1:widestring;
isdefault:boolean;
GlyphObj : TObject ;
bGlyph : TGraphic;
begin
Focused := (GetFocus= hWnd);
style := GetWindowLong(hWnd,GWL_STYLE);
enabled := ( style and WS_DISABLED )=0;
//isdefault := (dw = BS_DEFPUSHBUTTON );
if control<>nil then
caption := GetStringProp(control,'Caption')
else
caption:=getformcaption(hwnd);
i:=1;
if Focused then i:=5;
// if isdefault then i:=5;
if (scDown in state) then i:=2
else if (scMouseIn in state) then i:=4;
if not enabled then i:=3;
case i of
1: j:=1;
2: j:=3;
3: j:=2;
4: j:=1;
else j:=1;
end;
r1:=rc;
offsetrect(r1,-r1.left,-r1.top);
btemp.width:=r1.right;
btemp.height:=r1.bottom;
bfont:=sendmessage(hwnd,wm_getfont,0,0);
cfont:=selectobject(btemp.canvas.handle,bfont);
if trans then
DrawParentImage(control,btemp.canvas.handle,true)
else
fillBG(btemp.canvas.handle,r1);
DrawSkinMap( btemp.canvas.handle,r1,fsd.button,I,fsd.button.frame);
ClientSize := Point(rc.Right - rc.Left,rc.Bottom - rc.Top);
NumGlyphs:=1;
GlyphObj := TObject(GetObjectProp(control,PicField,TObject));
if (GlyphObj<>nil) then begin
bGlyph := TGraphic(GetObjectProp(control,PicField,TGraphic));
end else bGlyph:=nil;
if (bGlyph <> nil) {and Assigned(bglyph.Graphic)} then
GlyphSize := Point(bGlyph.Width div NumGlyphs, bglyph.Height)
else GlyphSize := Point(0, 0);
font := Tfont(GetObjProp(control,'Font',Tfont));
NumGlyphs := GetIntProperty(control,'NumGlyphs') ;
if NumGlyphs<0 then NumGlyphs:=1;
Margin := GetIntProperty(control,'Margin') ;
Spacing := GetIntProperty(control,'Spacing') ;
s := lowercase(GetEnumProperty(control,'Layout'));
if s='blglyphleft' then layout:=blGlyphLeft
else if s='blglyphright' then layout:=blGlyphRight
else if s='blglyphtop' then layout:=blGlyphTop
else if s='blglyphbottom' then layout:=blGlyphbottom;
btemp.canvas.font.assign(font);
DrawStyle := dt_WordBreak;
s:= StrToWideStr('||');
s1:= StrToWideStr(#13#10);
caption := StringReplaceW(caption,s,s1);
TextBounds := r1;//Rect(0, 0, r1.right-GlyphSize.x, 0);
inflaterect(TextBounds,-2,-2);
case Layout of
blGlyphLeft,blGlyphRight: Dec(TextBounds.Right,GlyphSize.X+2);
blGlyphTop,blGlyphBottom: Dec(TextBounds.Bottom,GlyphSize.y+2)
end;
if Length(Caption) > 0 then begin
// TextBounds := r1;//Rect(0, 0, r1.right-GlyphSize.x, 0);
// DrawText(btemp.canvas.handle, PChar(Caption),-1, TextBounds,DT_CALCRECT or dt_left);
Tnt_DrawTextW(btemp.canvas.handle,caption,TextBounds,DT_CALCRECT or dt_left or dt_WordBreak);
TextSize := Point(TextBounds.Right - TextBounds.Left, TextBounds.Bottom -
TextBounds.Top);
end else begin
TextBounds := Rect(0, 0, 0, 0);
TextSize := Point(0,0);
end;
if Layout in [blGlyphLeft, blGlyphRight] then begin
GlyphPos.Y := (ClientSize.y - GlyphSize.Y + 1) div 2;
TextPos.Y := (ClientSize.y - TextSize.Y + 1) div 2;
end else begin
GlyphPos.X := (ClientSize.x - GlyphSize.X + 1) div 2;
TextPos.X := (ClientSize.x - TextSize.X + 1) div 2;
end;
// margin:=btn.margin;
// spacing:=btn.spacing;
if (TextSize.X = 0) or (GlyphSize.X = 0) then
Spacing := 0;
s := lowercase(GetEnumProperty(control,'Alignment'));
if (Margin = -1) or (s='tacenter') then begin
if Spacing = -1 then begin
TotalSize := Point(GlyphSize.X + TextSize.X, GlyphSize.Y + TextSize.Y);
if Layout in [blGlyphLeft, blGlyphRight] then
Margin := (ClientSize.x - TotalSize.X) div 3
else
Margin := (ClientSize.y - TotalSize.Y) div 3;
Spacing := Margin;
end else begin
TotalSize := Point(GlyphSize.X+Spacing+TextSize.X, GlyphSize.Y+
Spacing + TextSize.Y);
if Layout in [blGlyphLeft, blGlyphRight] then
Margin := (ClientSize.x - TotalSize.X ) div 2
else
Margin := (ClientSize.y - TotalSize.Y ) div 2;
end;
end else begin
if Spacing = -1 then begin
TotalSize := Point(ClientSize.x - (Margin + GlyphSize.X), ClientSize.y -
(Margin + GlyphSize.Y));
if Layout in [blGlyphLeft, blGlyphRight] then
Spacing := (TotalSize.X - TextSize.X) div 2
else
Spacing := (TotalSize.Y - TextSize.Y) div 2;
end;
end;
case Layout of
blGlyphLeft:
begin
GlyphPos.X := Margin;
TextPos.X := GlyphPos.X + GlyphSize.X + Spacing;
DrawStyle:=DT_left or DrawStyle;
end;
blGlyphRight:
begin
GlyphPos.X := ClientSize.x - Margin - GlyphSize.X;
TextPos.X := GlyphPos.X - Spacing - TextSize.X;
DrawStyle:=DT_RIGHT or DrawStyle;
end;
blGlyphTop:
begin
GlyphPos.Y := Margin;
TextPos.Y := GlyphPos.Y + GlyphSize.Y + Spacing;
DrawStyle:=DT_center or DrawStyle;
end;
blGlyphBottom:
begin
GlyphPos.Y := ClientSize.y - Margin - GlyphSize.Y;
TextPos.Y := GlyphPos.Y - Spacing - TextSize.Y;
DrawStyle:=DT_center or DrawStyle;
end;
end;
r1:=rect(glyphpos.x,glyphpos.y,0,0);
if (bglyph<>nil) {and Assigned(bglyph.Graphic)} then
btemp.Canvas.Draw(r1.left ,r1.top,bglyph);
TextBounds:= rect(textpos.x,textpos.y,textpos.x+TextSize.x,textpos.y+TextSize.y);
SetBkMode(btemp.Canvas.Handle, TRANSPARENT);
if (i=1) and (fsd.button.newnormal) then
btemp.canvas.Font.Color:= fsd.button.normalcolor2;
if (i=4) and (fsd.button.newover) then
btemp.canvas.Font.Color:= fsd.button.overcolor2;
if (i=2) and (fsd.Button.newdown) then
btemp.canvas.Font.Color:= fsd.button.downcolor2;
if not enabled then
btemp.canvas.Font.Color := clBtnShadow;
// btemp.canvas.Font.Assign(btn.Font);
// DrawText(btemp.canvas.Handle, PChar(btn.caption),Length(btn.caption),TextBounds,DrawStyle);
if length(caption)>0 then begin
Tnt_DrawTextW(btemp.canvas.Handle,caption,TextBounds,DrawStyle);
SetBkMode(btemp.canvas.Handle, OPAQUE);
if focused and not (xoNoFocusRect in fsd.Options) then begin
InflateRect(TextBounds,2,2);
DrawFocusRect(btemp.canvas.Handle,TextBounds);
end;
end;
BitBlt(dc,rc.left ,rc.top,rc.right-rc.left,rc.bottom-rc.Top,
btemp.Canvas.Handle ,0 ,0 ,Srccopy);
selectobject(btemp.canvas.handle,cfont);
end;
procedure TSkinBitButton.DrawGlyph( acanvas:Tcanvas; rc:TRect;
bmp:Tbitmap;I,N:integer);
var atemp:Tbitmap;
w,h,x,j:integer;
begin
atemp:=Tbitmap.create;
j:=i;
// if n<>4 then i:=1;
if j>n then i:=1;
w:=bmp.width div n;
h:=bmp.height;
atemp.height:=h;
atemp.width:=w;
x:=(i-1)*w;
if (j=2) and (n=1) then begin
atemp.Free;
atemp := GetDisableImg(bmp);
end else begin
atemp.canvas.copyrect( rect(0,0,w,h),bmp.canvas,rect(x,0,x+w,h));
end;
// atemp.canvas.copyrect( rect(0,0,w,h),bmp.canvas,rect(x,0,x+w,h));
// if (j=2) then
// ConvertBitmapToGrayscale (atemp);
atemp.Transparent := true;
atemp.TransparentMode := tmAuto;
// atemp.Transparent:=true;
// temp.Transparentcolor:=clFuchsia;
// atemp.Transparentcolor:=atemp.Canvas.Pixels[0, h-1];
// atemp.Transparentcolor:=atemp.Canvas.Pixels[0, 0];
acanvas.draw(rc.left,rc.top,atemp);
atemp.free;
end;
constructor TWMediaPlayer.Create(AOwner: TComponent);
begin
inherited create(aowner);
LoadBitmaps;
end;
destructor TWMediaPlayer.Destroy;
begin
inherited destroy;
DestroyBitmaps;
end;
procedure TWMediaPlayer.attach(askin:TSkinControl;aObj:Twincontrol);
var s:string;
parenthwnd:Thandle;
dw:Dword;
begin
obj:=aobj;
skincontrol:=askin;
fsd:=askin.fsd;
tag:=fsd.DisableTag;
setposition(obj);
parent := obj.Parent;
end;
procedure TWMediaPlayer.SetPosition(aObj:Twincontrol);
begin
obj:=aobj;
width:=obj.Width;
height:= obj.Height ;//div 2;
left:= obj.Left;
top:=obj.Top;
end;
procedure TWMediaPlayer.LoadBitmaps;
const
BtnStateName: array[TMPGlyph] of PChar = ('EN', 'DI', 'CL');
BtnTypeName: array[TMPBtnType] of PChar = ('MPPLAY', 'MPPAUSE', 'MPSTOP',
'MPNEXT', 'MPPREV', 'MPSTEP', 'MPBACK', 'MPRECORD', 'MPEJECT');
var
I: TMPBtnType;
J: TMPGlyph;
ResName: array[0..40] of Char;
begin
for I := Low(Buttons) to High(Buttons) do
begin
for J := Low(TMPGlyph) to High(TMPGlyph) do
begin
Buttons[I].Bitmaps[J] := TBitmap.Create;
Buttons[I].Bitmaps[J].Handle := LoadBitmap(HInstance,
StrFmt(ResName, '%s_%s', [BtnStateName[J], BtnTypeName[I]]));
end;
end;
end;
procedure TWMediaPlayer.DestroyBitmaps;
var
I: TMPBtnType;
J: TMPGlyph;
begin
for I := Low(Buttons) to High(Buttons) do begin
for J := Low(TMPGlyph) to High(TMPGlyph) do
Buttons[I].Bitmaps[J].Free;
end;
end;
procedure TWMediaPlayer.WMLButtonDown(Var aMsg: TMessage);
begin
IsDown:=true;
inherited;
obj.Perform(amsg.Msg,amsg.WParam,amsg.LParam);
ReleaseCapture;
Findbutton(amsg.LParamLo,amsg.LParamHi);
BtnClick:=BtnFocuse;
invalidate;
end;
procedure TWMediaPlayer.WMLButtonUp(Var aMsg: TMessage);
begin
IsDown:=false;
inherited;
Findbutton(amsg.LParamLo,amsg.LParamHi);
if btnfocuse=btnclick then
obj.Perform(amsg.Msg,amsg.WParam,amsg.LParam);
btnclick:=btnfocuse;
invalidate;
end;
procedure TWMediaPlayer.CheckButtons;
var I: TMPBtnType;
svisible:string;
senable:string;
s:string;
begin
svisible:=GetSetProp(obj,'VisibleButtons',true);
count:=0;
for I := Low(Buttons) to High(Buttons) do begin
s:=GetEnumName(TypeInfo(TMPBtnType), Ord(i));
buttons[i].Visible:= pos(s,svisible)>0;
if buttons[i].Visible then inc(count);
end;
end;
procedure TWMediaPlayer.FindButton(XPos, YPos: Integer);
var
I: TMPBtnType;
X: Integer;
begin
{which button was clicked}
X := 0;
for I := Low(Buttons) to High(Buttons) do
begin
if Buttons[I].Visible then
begin
if (XPos >= X) and (XPos <= X + BtnWidth) then begin
Break;
end;
Inc(X, BtnWidth);
end;
end;
BtnFocuse := I;
end;
procedure TWMediaPlayer.Paint;
var I: TMPBtnType;
svisible:string;
senable:string;
scolor:string;
s:string;
temp:Tbitmap;
r1,rc:Trect;
w,h,x,j:integer;
begin
// inherited Paint;
svisible:=GetSetProp(obj,'VisibleButtons',true);
senable:=GetSetProp(obj,'EnabledButtons',true);
scolor:=GetSetProp(obj,'ColoredButtons',true);
count:=0;
for I := Low(Buttons) to High(Buttons) do begin
s:=GetEnumName(TypeInfo(TMPBtnType), Ord(i));
buttons[i].Visible:= pos(s,svisible)>0;
if buttons[i].Visible then inc(count);
buttons[i].Enabled:= pos(s,senable)>0;
buttons[i].Colored:= pos(s,scolor)>0;
end;
rc:=rect(0,0,width,height);
if count=0 then begin
fillcolor(canvas.Handle,rc,fsd.colors[csButtonFace]);
exit;
end;
// rc:=rect(0,0,obj.width,obj.height);
w:= rc.right div count;
h:= rc.Bottom;
btnwidth:=w;
temp:=Tbitmap.create;
temp.width:= rc.Right;
temp.Height:= h;
temp.Canvas.brush.Color:= fsd.colors[csButtonFace];
temp.Canvas.FillRect(rc);
x:=0;
for I := Low(Buttons) to High(Buttons) do begin
r1:=rect(x,0,x+w,h);
j:=1;
if buttons[i].Visible then begin
DrawButton(temp.canvas,i,r1);
inc(x,w);
end;
end;
BitBlt(canvas.Handle,rc.left ,rc.top,rc.right,rc.bottom,
temp.Canvas.Handle ,0 ,0 ,Srccopy);
temp.free;
end;
procedure TWMediaPlayer.DrawButton(acanvas:Tcanvas;Btn:TMPBtnType;R:TRect);
var j:integer;
TheGlyph: TMPGlyph;
Bitmap: TBitmap;
x,y:integer;
begin
if Buttons[Btn].Enabled then begin
TheGlyph := mgEnabled;
if Buttons[Btn].Colored then
TheGlyph := mgColored;
end else TheGlyph := mgDisabled;
j:=1;
if IsDown and (btn=BtnClick) then j:=2;
if TheGlyph = mgDisabled then j:=3;
DrawRect2(acanvas.handle,r,fsd.button.map,
fsd.button.r,j,fsd.button.frame,fsd.button.trans,fsd.button.tile);
Bitmap := Buttons[Btn].Bitmaps[TheGlyph];
X := (r.Right-r.Left-Bitmap.Width) div 2;
Y := (r.Bottom - r.Top - Bitmap.Height) div 2;
if j=2 then begin
Inc(X);
Inc(Y);
end;
acanvas.BrushCopy(Bounds(r.Left + X, Y, Bitmap.Width, Bitmap.Height),
Bitmap, Rect(0, 0, Bitmap.Width, Bitmap.Height), clOlive);
end;
Procedure TSkinMP.Init(sf:Tcomponent;sd:TSkinData;acanvas:TCanvas;acolor:boolean=false);
var s:string;
begin
inherited init(sf,sd,acanvas,acolor);
mp:=TWMediaPlayer.create(sf);
mp.attach(self,control);
mp.Visible:=control.Visible;
{ mp.fsd := sd;
mp.obj:=control;
mp.Width:= control.Width ;
mp.Height:= control.Height div 2;
mp.left:=0;
mp.top:=0;
mp.Parent := control;}
end;
procedure TSkinMP.AfterProc(var Message: TMessage);
begin
case message.msg of
CM_VISIBLECHANGED : begin
mp.Visible:=control.Visible;
end;
WM_WINDOWPOSCHANGED: begin
if mp<>nil then mp.SetPosition(control);
end;
else inherited Afterproc(message);
end;
end;
procedure TSkinMP.Unsubclass;
begin
inherited unsubclass;
if skinstate<>skin_deleted then begin
if mp<>nil then mp.free;
mp:=nil;
end else begin
end;
end;
procedure TSkinMenuButton.DrawGlyph( acanvas:Tcanvas; rc:TRect;
bmp:Tbitmap;I,N:integer);
var atemp:Tbitmap;
w,h,x,j:integer;
begin
atemp:=Tbitmap.create;
j:=i;
// if n<>4 then i:=1;
if j>n then i:=1;
w:=bmp.width div n;
h:=bmp.height;
atemp.height:=h;
atemp.width:=w;
x:=(i-1)*w;
if (j=2) and (n=1) then begin
atemp.Free;
atemp := GetDisableImg(bmp);
end else begin
atemp.canvas.copyrect( rect(0,0,w,h),bmp.canvas,rect(x,0,x+w,h));
end;
// atemp.canvas.copyrect( rect(0,0,w,h),bmp.canvas,rect(x,0,x+w,h));
// if (j=2) then
// ConvertBitmapToGrayscale (atemp);
atemp.Transparent := true;
atemp.TransparentMode := tmAuto;
// atemp.Transparent:=true;
// temp.Transparentcolor:=clFuchsia;
// atemp.Transparentcolor:=atemp.Canvas.Pixels[0, h-1];
// atemp.Transparentcolor:=atemp.Canvas.Pixels[0, 0];
acanvas.draw(rc.left,rc.top,atemp);
atemp.free;
end;
procedure TSkinMenuButton.DrawControl( dc:HDC; rc:TRect);
var acolor:Tcolor;
i:integer;
r1,r2,TextBounds:Trect;
TextPos: TPoint;
ClientSize, GlyphSize, TextSize: TPoint;
arrowsize,GlyphPos,arrowpos: TPoint;
TotalSize: TPoint;
x,y:integer;
DrawStyle: Longint;
cfont,bfont:Hfont;
font:Tfont;
style : dword;
s,s1:widestring;
isdefault:boolean;
bglyph:Tbitmap;
Margin,Spacing :integer;
Layout: TButtonLayout;
begin
if fsd.button=nil then exit;
if fsd.Button.map.empty then exit;
// DrawStyle:=DT_LEFT;
Focused := (GetFocus= hWnd);
style := GetWindowLong(hWnd,GWL_STYLE);
enabled := ( style and WS_DISABLED )=0;
//isdefault := (dw = BS_DEFPUSHBUTTON );
if control<>nil then
caption := GetStringProp(control,'Caption')
// caption := GetControlCaption(TACControl(control))
else
caption:=getformcaption(hwnd);
i:=1;
if Focused then i:=4;
// if isdefault then i:=5;
if (scDown in state) then i:=2
else if (scMouseIn in state) then i:=4;
if not enabled then i:=3;
r1:=rc;
offsetrect(r1,-r1.left,-r1.top);
btemp.width:=r1.right;
btemp.height:=r1.bottom;
bfont:=sendmessage(hwnd,wm_getfont,0,0);
cfont:=selectobject(btemp.canvas.handle,bfont);
bglyph := Tbitmap(GetObjProp(control,'Glyph',Tbitmap));
Margin := GetIntProperty(control,'Margin') ;
Spacing := GetIntProperty(control,'Spacing') ;
Layout := blGlyphLeft;
if (bGlyph <> nil) and (not bglyph.Empty) then
GlyphSize := Point(bGlyph.Width, bglyph.Height)
else GlyphSize := Point(0, 0);
if trans then
DrawParentImage(control,btemp.canvas.handle,true)
else
fillBG(btemp.canvas.handle,r1);
DrawSkinMap( btemp.canvas.handle,r1,fsd.button,I,fsd.button.frame);
ClientSize := Point(rc.Right - rc.Left,rc.Bottom - rc.Top);
font := Tfont(GetObjProp(control,'Font',Tfont));
arrowsize := Point(8,3);
btemp.canvas.font.assign(font);
DrawStyle := dt_WordBreak;
s:= StrToWideStr('||');
s1:= StrToWideStr(#13#10);
caption := StringReplaceW(caption,s,s1);
TextBounds := Rect(0, 0, r1.right-GlyphSize.x-arrowsize.X, r1.Bottom);
inflaterect(TextBounds,-2,-2);
if Length(Caption) > 0 then begin
// TextBounds := r1;//Rect(0, 0, r1.right-GlyphSize.x, 0);
// DrawText(btemp.canvas.handle, PChar(Caption),-1, TextBounds,DT_CALCRECT or dt_left);
Tnt_DrawTextW(btemp.canvas.handle,caption,TextBounds,DT_CALCRECT or dt_left or dt_WordBreak);
TextSize := Point(TextBounds.Right - TextBounds.Left, TextBounds.Bottom -
TextBounds.Top);
end else begin
TextBounds := Rect(0, 0, 0, 0);
TextSize := Point(0,0);
end;
if (Margin = -1) then begin
if Spacing = -1 then begin
TotalSize := Point(GlyphSize.X + TextSize.X+arrowsize.X, GlyphSize.Y + TextSize.Y+arrowsize.Y);
if Layout in [blGlyphLeft, blGlyphRight] then
Margin := (ClientSize.x - TotalSize.X) div 4
else
Margin := (ClientSize.y - TotalSize.Y) div 4;
Spacing := Margin;
end else begin
TotalSize := Point(GlyphSize.X+Spacing+TextSize.X+spacing+arrowsize.X, GlyphSize.Y+
Spacing*2 + TextSize.Y+arrowsize.Y);
if Layout in [blGlyphLeft, blGlyphRight] then
Margin := (ClientSize.x - TotalSize.X ) div 2
else
Margin := (ClientSize.y - TotalSize.Y ) div 2;
end;
end else begin
if Spacing = -1 then begin
TotalSize := Point(ClientSize.x - (Margin*2 + GlyphSize.X-arrowsize.X), ClientSize.y -
(Margin*2 + GlyphSize.Y-arrowsize.Y));
if Layout in [blGlyphLeft, blGlyphRight] then
Spacing := (TotalSize.X - TextSize.X) div 2
else
Spacing := (TotalSize.Y - TextSize.Y) div 2;
end;
end;
GlyphPos.X := Margin;
GlyphPos.Y:= (ClientSize.y - GlyphSize.Y) div 2;
TextPos.Y := (ClientSize.y - TextSize.Y + 1) div 2;
textpos.x := GlyphPos.x+ GlyphSize.X+ Spacing;
arrowpos.X := TextPos.x+ Spacing*2+TextSize.x;
arrowpos.Y := (ClientSize.y - arrowsize.Y) div 2;
r2:=rect(glyphpos.x,glyphpos.y,0,0);
if (bglyph<>nil) and (not bglyph.Empty) then
DrawGlyph(btemp.canvas,r2,bglyph,1,1) ;
TextBounds:= rect(textpos.x,textpos.y,textpos.x+TextSize.x,textpos.y+TextSize.y);
if (i=1) and (fsd.button.newnormal) then
btemp.canvas.Font.Color:= fsd.button.normalcolor2;
if (i=4) and (fsd.button.newover) then
btemp.canvas.Font.Color:= fsd.button.overcolor2;
if (i=2) and (fsd.Button.newdown) then
btemp.canvas.Font.Color:= fsd.button.downcolor2;
btemp.Canvas.Brush.Color := clWindowText;
btemp.Canvas.Pen.Color := clWindowText;
if not enabled then begin
btemp.canvas.Font.Color := clBtnShadow;
btemp.Canvas.Brush.Color := clBtnShadow;
btemp.Canvas.Pen.Color := clBtnShadow;
end;
X := arrowpos.X;
Y := arrowpos.y + 2;
btemp.Canvas.Polygon( [ Point( X, Y ), Point( X - 3, Y - 3 ), Point( X + 3, Y - 3 ) ] );
SetBkMode(btemp.Canvas.Handle, TRANSPARENT);
Tnt_DrawTextW(btemp.canvas.Handle,caption,TextBounds,DrawStyle);
SetBkMode(btemp.canvas.Handle, OPAQUE);
if focused and not (xoNoFocusRect in fsd.Options) then begin
InflateRect(TextBounds,2,2);
DrawFocusRect(btemp.canvas.Handle,TextBounds);
end;
BitBlt(dc,rc.left ,rc.top,rc.right-rc.left,rc.bottom-rc.Top,
btemp.Canvas.Handle ,0 ,0 ,Srccopy);
selectobject(btemp.canvas.handle,cfont);
end;
Procedure TSkinSpeedButton.InitGraphicControl(sf:Tcomponent;sd:TSkinData;acanvas:TCanvas);
begin
fsd:=sd;
fCanvas:=acanvas;
gcontrol:=TGraphicControl(owner);
skinform:=sf;
OldWndProc:= gControl.WindowProc;
gControl.WindowProc := NewWndProc;
Twinskinform(skinform).addcontrollist(self);
skinstate:=skin_active;
if (gcontrol.Tag=5555) or (xoTransparent in fsd.options) then
trans:=true;
end;
constructor TSkinSpeedButton.Create(AOwner: TComponent);
begin
inherited create(aowner);
fReentr := False;
picfield := '';
// gcanvas:=Tcanvas.create;
end;
destructor TSkinSpeedButton.Destroy;
begin
// gcanvas.free;
if assigned(oldwndproc) then begin
if gcontrol<>nil then gControl.WindowProc := OldWndProc;
oldwndproc:=nil;
end;
inherited destroy;
end;
function TSkinSpeedButton.BeforeProc(var Message: TMessage):boolean;
var rc:Trect;
C :TCanvas;
begin
result:=true;
case message.msg of
WM_LBUTTONDOWN, WM_LBUTTONDBLCLK:
begin
default(message);
state:=state+[scDown];
PaintControl;
result:=false;
end;
WM_LBUTTONUP:
begin
result:=true;
end;
WM_Paint: begin
WMPaintSpeed(message);
result:=false;
// message.result:=1;
end;
else result:=inherited beforeProc(message);
end;
end;
{procedure TSkinSpeedButton.WMPaintSpeed(var Message:Tmessage);
var C : TControlCanvas;
rc:TREct;
begin
rc:=gcontrol.ClientRect;
OffsetRect( rc, -rc.left, -rc.top );
C := TControlCanvas.Create;
C.handle := TWMPaint(Message).DC;
try
C.Control := gControl;
DrawSpeedbtn( c,rc);
// DrawSpeedbtn(TAcGraphicControl(gcontrol).Canvas,rc);
finally
C.Free;
end;
message.result:=1;
end; }
procedure TSkinSpeedButton.WMPaintSpeed(var Message:Tmessage);
var C : TControlCanvas;
rc:TREct;
begin
rc:=gcontrol.ClientRect;
OffsetRect( rc, -rc.left, -rc.top );
if TWMPaint(Message).DC<>0 then begin
TAcGraphicControl(gcontrol).Canvas.Lock;
try
TAcGraphicControl(gcontrol).Canvas.Handle := TWMPaint(Message).DC;
try
DrawSpeedbtn(TAcGraphicControl(gcontrol).Canvas,rc);
finally
TAcGraphicControl(gcontrol).Canvas.Handle := 0;
end;
finally
TAcGraphicControl(gcontrol).Canvas.Unlock;
end;
end;
message.result:=1;
end;
procedure TSkinSpeedButton.AfterProc(var Message: TMessage);
begin
case message.msg of
CM_MOUSEENTER:
begin
state:=state+[scMouseIn];
// if gcontrol.Visible then
// gcontrol.Invalidate;
PaintControl;
end;
CM_MOUSELEAVE:
begin
state:=state-[scMouseIn];
state:=state-[scDown];
// if gcontrol.Visible then
// gcontrol.Invalidate ;
if gcontrol.Visible then
PaintControl;
end;
WM_LBUTTONUP:
begin
state:=state-[scDown];
PaintControl;
// TSpeedButton(gcontrol).click;
end;
WM_KEYDOWN:
if Message.WParam = VK_SPACE then begin
state:=state+[scDown];
PaintControl;
end;
WM_KEYUP:
if Message.WParam = VK_SPACE then begin
state:=state-[scDown];
PaintControl;
end;
WM_NCDESTROY,CM_RELEASE:begin
if assigned(oldwndproc) then begin
gControl.WindowProc := OldWndProc;
oldwndproc:=nil;
end;
end;
CM_FOCUSCHANGED : begin
end;
wm_enable,CM_ENABLEDCHANGED:;
else inherited AfterProc(Message);
end;
end;
{procedure TSkinSpeedButton.PaintControl(adc:HDC=0);
var rc:TRect;
C : TControlCanvas;
begin
rc:=gcontrol.ClientRect;
OffsetRect( rc, -rc.left, -rc.top );
C := TControlCanvas.Create;
try
// C.Control := gControl;
// if TAcGraphicControl(gcontrol).Canvas.handle<>0 then
// DrawSpeedbtn(TAcGraphicControl(gcontrol).Canvas,rc);
// Application.ProcessMessages;
DrawSpeedbtn(TAcGraphicControl(gcontrol).Canvas,rc);
// DrawSpeedbtn(gcontrol.c,rc);
finally
C.Free;
end;
end;}
procedure TSkinSpeedButton.PaintControl(adc:HDC=0);
var rc:TRect;
C : TControlCanvas;
begin
rc:=gcontrol.ClientRect;
OffsetRect( rc, -rc.left, -rc.top );
if TAcGraphicControl(gcontrol).Canvas.Handle<>0 then begin
TAcGraphicControl(gcontrol).Canvas.Lock;
try
DrawSpeedbtn(TAcGraphicControl(gcontrol).Canvas,rc);
finally
TAcGraphicControl(gcontrol).Canvas.Unlock;
end;
end;
end;
procedure TSkinSpeedButton.DrawSpeedbtn( acanvas:Tcanvas; rc:TRect);
var acolor:Tcolor;
i,n,j:integer;
r1,TextBounds:Trect;
TextPos: TPoint;
GlyphPos, ClientSize, GlyphSize, TextSize: TPoint;
TotalSize: TPoint;
DrawStyle: Longint;
Layout: TButtonLayout;
NumGlyphs,margin,spacing :integer;
bglyph:Tbitmap;
s:string;
font:Tfont;
flat:boolean;
enable:boolean;
begin
if fsd.button=nil then exit;
if fsd.Button.map.empty then exit;
s:=lowercase(GetEnumProperty(gcontrol,'Visible'));
if s = 'false' then exit;
if length(Picfield)>0 then begin
drawpicbtn(acanvas,rc);
exit;
end;
// RF: flag for reentrancy
if fReentr then Exit;
fReentr := True;
// acanvas.Lock;
try
DrawStyle:=DT_LEFT or dt_WordBreak;
i:=1;
if (scDown in state) then i:=2
else if (scMouseIn in state) then i:=4;
s:=lowercase(GetEnumProperty(gcontrol,'Enabled'));
if s='true' then enable:=true
else enable:=false;
if not enable then i:=3;
s:=lowercase(GetEnumProperty(gcontrol,'Down'));
if s='true' then i:=2 ;
j:=1;
case i of
1: j:=1;
2: j:=3;
3: j:=2;
4: j:=1;
end;
if s='true' then j:=4 ;
caption := GetStringProp(gcontrol,'Caption');
font := Tfont(GetObjProp(gcontrol,'Font',Tfont));
bglyph := Tbitmap(GetObjProp(gcontrol,'Glyph',Tbitmap));
NumGlyphs := GetIntProperty(gcontrol,'NumGlyphs') ;
if NumGlyphs<0 then NumGlyphs:=1;
// bglist := Timagelist(GetObjProp(gcontrol,'Images',Timagelist));
// imageindex := GetIntProperty(gcontrol,'ImageIndex') ;
// disabledindex := GetIntProperty(gcontrol,'DisabledIndex') ;
s:=lowercase(GetEnumProperty(gcontrol,'Flat'));
if s='true' then flat:=true
else flat:=false;
Margin := GetIntProperty(gcontrol,'Margin') ;
Spacing := GetIntProperty(gcontrol,'Spacing') ;
s := lowercase(GetEnumProperty(gcontrol,'Layout'));
if s='blglyphleft' then layout:=blGlyphLeft
else if s='blglyphright' then layout:=blGlyphRight
else if s='blglyphtop' then layout:=blGlyphTop
else if s='blglyphbottom' then layout:=blGlyphbottom;