?? winsubclass.pas
字號:
// 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
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -