Delphi控件源码

开发平台：

Delphi

WinSubClass.pas：源码内容

if not isunicode then findbtn;
hList:=0;
end;
end;
{Procedure TSkinCombox.Init(sf:Tcomponent;sd:TSkinData;acanvas:TCanvas;acolor:boolean=false);
begin
if inited then exit;
inherited init(sf,sd,acanvas,acolor);
dwStyle := GetWindowLong( hWnd, GWL_STYLE );
vb:=nil;
if true then begin
fillchar(info,sizeof(info),#0);
info.cbSize:=sizeof(tagCOMBOBOXINFO);
if GetComboBoxInfo(hwnd,info) then begin
hList:=info.hwndList ;
dwStyle := GetWindowLong( hlist, GWL_STYLE );
if not ispopupwindow(hlist) and (dwstyle and ws_child > 0) then begin
vb:=TSkinScrollbarH.Create(owner);
vb.Inithwnd(hlist,sd,nil,skinform);
end;
end;
end else begin
findbtn;
hList:=0;
end;
end; }
procedure TSkinCombox.ButtonProc(var Message: TMessage);
var s:string;
begin
message.result:=CallWindowProc(FBtnPrevWndProc,hbtn,message.msg,
message.WParam,message.LParam);
case message.msg of
WM_LBUTTONDOWN, WM_LBUTTONDBLCLK:
begin
state:=state+[scDown];
invalidate;
end;
wm_paint: begin
paintcontrol;
end;
WM_LBUTTONUP:
begin
state:=state-[scDown];
invalidate;
end;
end;
end;
procedure TSkinCombox.SkinDropList;
begin
{$IFDEF demo}
{$else}
dwStyle := GetWindowLong( hWnd, GWL_STYLE );
if ((dwStyle and CBS_DROPDOWN)=CBS_DROPDOWN) then begin
fillchar(info,sizeof(info),#0);
info.cbSize:=sizeof(tagCOMBOBOXINFO);
if (@pGetComboBoxInfo<>nil) and pGetComboBoxInfo(hwnd,info) then begin
hList:=info.hwndList ;
db:=TComboxScrollBar.Create(owner);
db.Inithwnd(hlist,fsd,nil,skinform);
end else begin
db:=nil;
end;
end;
{$endif}
end;
procedure TSkinCombox.DeleteDropList;
begin
db.Unsubclass;
db.Free;
db:=nil;
end;
procedure TSkinCombox.CNCommand(var Message: TWMCommand);
begin
case Message.NotifyCode of
CBN_DROPDOWN: begin
isDrop:= true;
// fsd.DoDebug('CBN_DROPDOWN');
// SkinDropList;
end;
CBN_CLOSEUP: begin
isDrop:= false;
// fsd.DoDebug('CBN_DROPUP');
// DeleteDropList;
end;
end;
end;
{type
TAcCombo = class(TCustomCombo);
procedure TSkinCombox.FindScrollbar;
var barinfo : tagScrollBarInfo;
b:boolean;
r:TRect;
ahwnd:Thandle;
begin
ahwnd:=TAcCombo(control).ListHandle;
fillchar(barinfo,sizeof(barinfo),#0);
barinfo.cbSize := SizeOf(barinfo);
b:= GetScrollBarInfo(hlist, OBJID_VSCROLL, barinfo);
if b then
r:= barinfo.rcScrollBar;
end;}
procedure TSkinCombox.AfterProc(var Message: TMessage);
var s:string;
p:Tpoint;
begin
{$IFDEF combobox}
s:= MsgtoStr(message);
if s<>'' then skinaddlog('****Combobox '+s);
{$ENDIF}
case message.msg of
{ CM_MOUSEENTER:
if Enabled then begin
state:=state+[scMouseIn];
// invalidate;
end;}
CM_MOUSELEAVE:
if (scMouseIn in state) then begin
state:=state-[scMouseIn];
invalidate;
end;
WM_KILLFOCUS,WM_SETFOCUS:;
WM_MouseMove: begin
P := point( Message.LParamLo, Message.LParamhi);
if (scMouseIn in state) then begin
if not PtInRect(rbtn,p) and Enabled then begin
state:=state-[scMouseIn];
invalidate;
end;
end else if PtInRect(rbtn,p) and Enabled then begin
state:=state+[scMouseIn];
invalidate;
end;
end;
WM_LBUTTONDOWN, WM_LBUTTONDBLCLK:
begin
// vb.AttachHwnd(self,hlist,sb_Vert);
// vb.Invalidate;
state:=state+[scDown];
invalidate;
end;
WM_NCPaint: invalidate;
WM_DRAWITEM: invalidate;
WM_LBUTTONUP:
begin
state:=state-[scDown];
invalidate;
end;
CN_COMMAND:CNCommand(TWMCommand(message));
{ WM_CTLCOLORLISTBOX : begin
if hlist<>message.LParam then begin
hlist:=message.LParam;
skinaddlog('******* skin combobox');
// box.Inithwnd(hlist,fsd,fcanvas,skinform);
end;
end;}
else inherited AfterProc(message);
end;
end;
procedure TSkinCombox.DrawSkinMap3( dc:HDC; rc:TRect;
bmp:Tbitmap;I,N:integer);
var temp:Tbitmap;
w,h,x:integer;
begin
temp:=Tbitmap.create;
w:=bmp.width div n;
h:=bmp.height;
// temp.height:=rc.bottom-rc.top;
temp.height:=h;
temp.width:=rc.right-rc.left;
x:=(i-1)*w;
temp.canvas.copyrect( rect(0,0,rc.right-rc.left,h),
bmp.canvas,rect(x,0,x+w,h));
DrawTranmap(DC,rc,temp);
temp.free;
end;
procedure TSkinCombox.DrawBorder( dc:HDC; rc:TRect);
var r,r1:Trect;
acolor:Tcolor;
c1:Tcolor;
b1,b2:HBRUSH;
s:string;
Exstyle:dword;
begin
getclientrect(hwnd,r1);
if (r.right=(r1.right-r1.left)) or
(r.bottom=(r1.bottom-r1.top)) then exit;
r1:=rc;
B1:=CreateSolidBrush(fsd.colors[csButtonShadow]);
FrameRect(dc,r1,b1);
c1:=clwhite;
B2:=CreateSolidBrush(c1);
InflateRect(r1,-1,-1);
FrameRect(dc,r1,b2);
deleteobject(B2);
deleteobject(B1);
end;
procedure TSkinCombox.DrawArrow( dc:HDC; rc:TRect;i:integer);
var w:integer;
r1,r2:Trect;
begin
// w:= fsd.comboxarrow.Map.Width div fsd.comboxarrow.frame;
GetWindowRect( hbtn, r1 );
GetWindowRect( hwnd, r2 );
offsetrect(r1,-r2.left,-r2.Top);
// r1:=Rect(0,0,width,control.Height-4);
// r2:=Rect((i-1)*w,0,i*w,fsd.comboxarrow.Map.height);
FillColor( dc,r1,fsd.colors[csbuttonface]);
DrawSkinMap1(dc,r1,fsd.comboxarrow.map,i,fsd.comboxarrow.frame);
end;
procedure TSkinCombox.DrawControl(dc:HDC; rc:TRect);
var cs,w,h,i,m,w1,h1,rg:integer;
r,r1,r2:Trect;
begin
if (fsd.combox=nil) or (fsd.combox.map.empty) then exit;
// if isdrop then findscrollbar;
dwStyle := GetWindowLong( hWnd, GWL_STYLE );
ExStyle := GetWindowLong( hWnd, GWL_ExSTYLE );
fillchar(info,sizeof(info),#0);
info.cbSize:=sizeof(tagCOMBOBOXINFO);
if @pGetComboBoxInfo<>nil then begin
pGetComboBoxInfo(hwnd,info);
rbtn:=info.rcButton;
if (info.stateButton and STATE_SYSTEM_INVISIBLE) = STATE_SYSTEM_INVISIBLE then begin
// drawedit(dc,rc);
exit;
end;
end;
if fsd.combox.style=1 then begin
DrawControl1( dc,rc);
exit;
end;
r:=rc;
offsetrect(r,-r.left,-r.Top);
r1:=r;
r2:=r;
Focused := (GetFocus= hWnd);
enabled := (dwstyle and WS_DISABLED)=0;
i:=1;
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;
w1 := GetSystemMetrics( SM_CXHSCROLL );
if not HasButton then begin
if fsd.combox.style=2 then begin
if (exstyle and WS_EX_LEFTSCROLLBAR) = 0 then
DrawRect2( dc,r2,fsd.combox.map,fsd.combox.r,i,fsd.ComBox.frame,1)
else if Assigned(fsd.Comboxborder) then begin
//r2.right:=r.left+w1+2;
DrawRect2( dc,r2,fsd.Comboxborder.map,fsd.Comboxborder.r,i,fsd.Comboxborder.frame,1);
end;
exit;
end;
end else begin
DrawBorder(dc,rc);
DrawArrow( dc,rc,i);
exit;
end;
if (exstyle and WS_EX_LEFTSCROLLBAR) = 0 then begin
rg:=ExcludeClipRect(dc,r1.left+2,r1.top+2,r1.right-w1-4,r1.bottom-2);
r2.Left:=r.Right-w1-2;
r1:=r2;
r1.Right:=r.Right-2;
DrawSkinMap( dc,r,fsd.Comboxborder,i,fsd.Comboxborder.frame);
DrawSkinMap2( dc,r2,fsd.combox.map,i,fsd.ComBox.frame);
end else begin
rg:=ExcludeClipRect(dc,r.left+w1+4,r.top+2,r.right-2,r.bottom-2);
r2.right:=r.left+w1+2;
r1:=r2;
r1.left:= 2;
r1.Right:=r1.left+w1;
DrawSkinMap( dc,r,fsd.Comboxborder,i,fsd.Comboxborder.frame);
DrawSkinMap2( dc,r2,fsd.combox.maskmap,i,fsd.ComBox.frame);
end;
rbtn:=r2;
if (fsd.ExtraImages<>nil) and (not fsd.ExtraImages.map.empty) then begin
w:= fsd.ExtraImages.map.width div fsd.ExtraImages.frame;
h:= fsd.ExtraImages.map.height;
r1.left:=r1.left+(r1.right-r1.left-w) div 2;
r1.top:=r1.top+(r1.bottom-r1.top-h) div 2;
r1.right:=r1.left+w;
r1.bottom:=r1.top+h;
DrawSkinMap1( dc,r1,fsd.ExtraImages.map,i,fsd.ExtraImages.frame);
// fcanvas.copyrect(r1,fsd.ExtraImages.map.canvas,rect(0,0,w1,h1));
// DrawSkinMap2( dc,r1,fsd.ExtraImages.map,i,fsd.ExtraImages.frame);
end;
// ExcludeClipRect(dc,0,0,0,0);
// deleteobject(rg);
// SetWindowRgn(hwnd,0,false);
end;
procedure TSkinCombox.DrawEdit( dc:HDC; rc:TRect);
var r1:Trect;
c1:Tcolor;
b1,b2:HBRUSH;
begin
r1:=rc;
B1:=CreateSolidBrush(fsd.colors[csButtonShadow]);
FrameRect(dc,r1,b1);
deleteobject(B1);
c1:=clwhite;
B2:=CreateSolidBrush(c1);
InflateRect(r1,-1,-1);
FrameRect(dc,r1,b2);
deleteobject(B2);
end;
procedure TSkinCombox.DrawControl1( dc:HDC; rc:TRect);
var w,w1,h,h1,i:integer;
r,r1,r2:Trect;
c:Tcolor;
temp:Tbitmap;
b:HBRUSH;
begin
r:=rc;
offsetrect(r,-r.left,-r.Top);
Focused := (GetFocus= hWnd);
enabled := (dwStyle and WS_DISABLED)=0;
i:=1;
if not enabled then i:=3;
if focused then i:=4;
if (scDown in state) then i:=2
else if (scMouseIn in state) then i:=4;
r1:=r;
w1:= fsd.combox.map.width div fsd.combox.frame;
h:= fsd.combox.map.height;
h1:= GetSystemMetrics(SM_CYVTHUMB);
fcanvas.handle:=dc;
c:=fcanvas.brush.color;
fcanvas.brush.handle:=GetCurrentObject(dc,OBJ_BRUSH);
InflateRect(R1, -1, -1);
fcanvas.FrameRect(R1);
InflateRect(R1, -1, -1);
//background
r2:=r1;
if (exstyle and WS_EX_LEFTSCROLLBAR) = 0 then
r1.left := r1.right- h1
else
r1.Right := r1.Left+ h1;
fcanvas.fillRect(R1);
//do not strech button
r1:=r2;
if (exstyle and WS_EX_LEFTSCROLLBAR) = 0 then
r1.left := r1.right - w1//GetSystemMetrics(SM_CYVTHUMB)
else
r1.Right := r1.Left + w1;//GetSystemMetrics(SM_CYVTHUMB);
if (h<h1) then r1.Bottom:=r1.Top+h;
c:=fcanvas.brush.color;
fcanvas.brush.color:=fsd.colors[csButtonShadow];
fcanvas.FrameRect(R);
fcanvas.brush.color:=c;
// fcanvas.FrameRect(R1);
rbtn:=r1;
DrawSkinMap1(dc,r1,fsd.combox.map,i,fsd.combox.frame);
// w:= fsd.ComBox.map.width div fsd.ComBox.frame;
// h:= fsd.ComBox.map.height;
// r2:=rect((i-1)*w,0,i*w,h);
// fcanvas.copyrect(r1,fsd.ComBox.map.canvas,r2);
end;
constructor TArrowButton.Create(AOwner: TComponent);
begin
control:=nil;
cw:= GetSystemMetrics( SM_CXHSCROLL );
hwnd:=0;
tabstop:=false;
inherited create(aowner);
end;
destructor TArrowButton.Destroy;
begin
inherited destroy;
end;
procedure TArrowButton.Attach(aobj:Tskincontrol;acontrol:Twincontrol);
var ExStyle : dword;
Style : dword;
r,r2:TRect;
begin
obj:=aobj;
control:=acontrol;
hwnd:= control.Handle;
ExStyle := GetWindowLong( hWnd, GWL_ExSTYLE );
getwindowrect(hwnd,r);
offsetrect(r,-r.Left,-r.Right);
ParentWindow:=hwnd;
self.width:=cw;
self.height:= control.Height-4; //cw+1;
self.Top := 0;
if (exstyle and WS_EX_LEFTSCROLLBAR) = 0 then begin
self.Left:=r.Right-cw-4;
end else begin
self.left:= 2;
end;
Style := GetWindowLong( hWnd, GWL_STYLE );
Style := Style or WS_CLIPCHILDREN;
SetWindowLong( hWnd, GWL_STYLE ,style);
end;
procedure TArrowButton.MoveArrow( r:TRect);
var ExStyle : dword;
begin
ExStyle := GetWindowLong( hWnd, GWL_ExSTYLE );
if (exstyle and WS_EX_LEFTSCROLLBAR) = 0 then begin
self.Left:=r.Right-cw-4;
end else begin
self.left:= 2;
end;
end;
procedure TArrowButton.CMMouseEnter(Var aMsg: TMessage);
begin
if control.Enabled then begin
state:=state+[scMouseIn];
invalidate;
end;
end;
procedure TArrowButton.CMMouseLeave(Var aMsg: TMessage);
begin
if control.Enabled then begin
state:=state-[scMouseIn];
invalidate;
end;
end;
procedure TArrowButton.WMLButtonDown(Var aMsg: TMessage);
var p:Tpoint;
begin
inherited;
inc(amsg.LParamLo,self.Left);
inc(amsg.LParamHi,self.Top);
postmessage(hwnd,WM_LButtonDown,amsg.WParam,amsg.lparam);
postmessage(hwnd,WM_LBUTTONUP,amsg.WParam,amsg.lparam);
invalidate;
end;
procedure TArrowButton.WMLButtonUP(Var aMsg: TMessage);
var p:Tpoint;
begin
inherited;
windows.setfocus(hwnd);
// invalidate;
end;
procedure TArrowButton.Paint;
var i,w:integer;
r1,r2:Trect;
begin
i:=1;
if (scMouseIn in state) then i:=4;
w:= obj.fsd.comboxarrow.Map.Width div obj.fsd.comboxarrow.frame;
r1:=Rect(0,0,width,control.Height-4);
r2:=Rect((i-1)*w,0,i*w,obj.fsd.comboxarrow.Map.height);
canvas.Brush.color := obj.fsd.colors[csbuttonface];
canvas.FillRect(r1);
canvas.copyrect(r1,obj.fsd.comboxarrow.map.canvas,r2);
end;
destructor TSkinDateTime.Destroy;
begin
inherited destroy;
end;
procedure TSkinDateTime.Init(sf:Tcomponent;sd:TSkinData;acanvas:TCanvas;acolor:boolean=false);
begin
if inited then exit;
inherited init(sf,sd,acanvas,acolor);
arrow:=TArrowButton.create(self);
arrow.attach(self,control);
end;
procedure TSkinDateTime.AfterProc(var Message: TMessage);
var s:string;
dwstyle:dword;
begin
case message.msg of
WM_Size:begin
if arrow<>nil then arrow.repaint;
//invalidate;
end;
else inherited Afterproc(message);
end;
end;
procedure TSkinDateTime.DrawControl( dc:HDC; rc:TRect);
var r,r1:Trect;
acolor:Tcolor;
c1:Tcolor;
b1,b2:HBRUSH;
s:string;
Exstyle:dword;
begin
getclientrect(hwnd,r1);
arrow.MoveArrow(rc);
if (r.right=(r1.right-r1.left)) or
(r.bottom=(r1.bottom-r1.top)) then exit;
r1:=rc;
B1:=CreateSolidBrush(fsd.colors[csButtonShadow]);
FrameRect(dc,r1,b1);
c1:=clwhite;
B2:=CreateSolidBrush(c1);
InflateRect(r1,-1,-1);
FrameRect(dc,r1,b2);
// InflateRect(r1,-1,-1);
// FrameRect(dc,r1,b2);
// dec(r1.Bottom);
// FrameRect(dc,r1,b2);
deleteobject(B2);
deleteobject(B1);
end;
constructor TWScrollbar.Create(AOwner: TComponent);
begin
control:=nil;
cw:= GetSystemMetrics( SM_CXHSCROLL );
hwnd:=0;
tabstop:=false;
inherited create(aowner);
scrollpos:=-1;
end;
destructor TWScrollbar.Destroy;
begin
inherited destroy;
end;
procedure TWScrollbar.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
with Params do begin
ExStyle := WS_EX_TOOLWINDOW;
end;
end;
procedure TWScrollbar.attach(aobj:TSkinControl;aControl:Twincontrol;aType:byte);
var s:string;
parenthwnd:Thandle;
dw:Dword;
begin
obj:=aobj;
hwnd:=acontrol.handle;
control:=acontrol;
sbtype:=aType;
sbDir:=sbType;
color := obj.GetParentColor(obj.fsd.colors[csbuttonface]);
if (sbdir=sb_CTL) and (control<>nil) then begin
s:=lowercase(GetEnumProperty(control,'Kind'));
if s='sbhorizontal' then sbdir:=sb_HORZ
else sbdir:=sb_vert;
// if control.ClassName='T32ScrollBar' then
// sbtype:=sb_vert;
end;
parenthwnd:=GetParent(hWnd);
// dw:=GetWindowLong(parenthwnd,GWL_STYLE) ;
// if parenthwnd= 0 then exit;
ParentWindow:=parenthwnd;
setposition(hwnd);
// SetWindowLong(ParentWindow,GWL_STYLE,dw or WS_CLIPSIBLINGS ) ;
end;
procedure TWScrollbar.attachHwnd(aobj:TSkinControl;ahwnd:Thandle;aType:byte);
var s:string;
parenthwnd:Thandle;
begin
obj:=aobj;
hwnd:=ahwnd;
control:=nil;
sbtype:=aType;
sbDir:=sbType;
parenthwnd:=GetParent(hWnd);
ParentWindow:=parenthwnd;
setposition(hwnd);
end;
// MapWindowPoints(ComboWnd, Handle, Point, 1);
procedure TWScrollbar.HideScrollbar;
begin
ShowWindow(handle,SW_HIDE);
sbVisible:=false;
visible:=false;
end;
procedure TWScrollbar.ButtonUp;
begin
fdown:=false;
ReleaseCapture;
if sbtype=SB_CTL then invalidate;
end;
procedure TWScrollbar.SetPosition(ahwnd:Thandle);
var parenthwnd,prehwnd:Thandle;
r1:TRect;
p,p1:Tpoint;
barinfo : tagScrollBarInfo;
b:boolean;
dw:dword;
begin
hwnd:=ahwnd;
parenthwnd:=GetParent(hWnd);
fillchar(barinfo,sizeof(barinfo),#0);
barinfo.cbSize := SizeOf(barinfo);
if sbtype=SB_VERT then begin
b:=obj.fsd.GetScrollBarInfo(hwnd, OBJID_VSCROLL, barinfo);
end else if sbtype=SB_Horz then begin
b:= obj.fsd.GetScrollBarInfo(hwnd, OBJID_HSCROLL, barinfo);
end else if sbtype=SB_CTL then
b:= GetControlInfo2(barinfo);
sbVisible:=b;
if not b then begin
exit; //recreatewnd
end;
dw:=GetWindowLong(hWnd,GWL_STYLE);
if (dw and ws_visible)=0 then begin
sbVisible:=false;
ShowWindow(handle,SW_HIDE);
exit;
end;
if ((barinfo.rgstate[0] and STATE_SYSTEM_INVISIBLE)>0) then begin
if sbDir=SB_vert then
ShowWindow(handle,SW_HIDE)
else
ShowWindow(handle,SW_HIDE);
sbVisible:=false;
end else begin
r1:= barinfo.rcScrollBar;
p:=r1.TopLeft;
windows.screentoclient(hwnd,p);
sbrect.TopLeft:=p;
p:=r1.BottomRight;
windows.screentoclient(hwnd,p);
sbrect.BottomRight:=p;
offsetrect(r1,-r1.left,-r1.top);
if sbDir=SB_vert then len:=r1.Bottom
else len:=r1.Right;
p:=point(barinfo.rcScrollBar.Left,barinfo.rcScrollBar.Top);
offsetSC:=p;
windows.screentoclient(parenthwnd,p);
// p1:=barinfo.rcScrollBar.TopLeft;
// MapWindowPoints(0,hwnd,P1, 1);
prehwnd:=GetNextWindow(hwnd,GW_HWNDPREV);
if prehwnd=0 then prehwnd:=HWND_TOP;
ShowWindow(handle,SW_Show);
sbVisible:=true;
if sbtype<>SB_CTL then begin
SetWindowPos(handle, prehwnd, p.x,p.Y,r1.Right,r1.Bottom,0);//SWP_NOREDRAW);
MoveWindow( handle,p.x,p.Y,r1.Right,r1.Bottom,true);
end else begin
p:=point(barinfo.rcScrollBar.Left,barinfo.rcScrollBar.Top);
SetWindowPos(handle, prehwnd, p.x,p.Y,r1.Right,r1.Bottom,0);//SWP_NOREDRAW);
MoveWindow( handle,p.x,p.Y,r1.Right,r1.Bottom,true);
end;
end;
end;
function TWScrollbar.GetScrollPos(p:Tpoint):integer;
var x:integer;
begin
if sbDir=SB_Horz then x:=p.x
else x:=p.y;
if x<cw then result:=SB_LINEUP
else if x<thumbtop then result:=SB_PAGEUP
else if x<thumbbottom then result:=SB_THUMBTRACK
else if x<len-cw then result:=SB_PAGEDOWN
else result:=SB_LINEDOWN;
end;
procedure TWScrollbar.WMERASEBKGND(var Msg: TMessage);
begin
// inherited;
// if obj.sizing then inherited;
Msg.Result := 1;
end;
procedure TWScrollbar.WMLButtonDBClick(Var aMsg: TMessage);
begin
WMLButtonDown(amsg);
end;
function TWScrollbar.GetControlInfo(var info:tagScrollBarInfo):boolean;
var sb:TScrollbar;
p:TPoint;
asize:integer;
amax:integer;
begin
result:=false;
if control=nil then exit;
sb:=TScrollbar(control);
result:=true;
p:=point(0,0);
windows.ClientToScreen(hwnd,p);
info.rcScrollBar := sb.ClientRect;
offsetrect(info.rcScrollBar,p.x,p.Y);
if sbDir=sb_horz then len:=info.rcScrollBar.Right-info.rcScrollBar.Left
else len:=info.rcScrollBar.bottom-info.rcScrollBar.top;
amax:=sb.Max-sb.Min;
if sb.PageSize<>0 then begin
asize:=MulDiv(len-2*cw,sb.pagesize-1,amax);
if sb.Position<>sb.Min then
info.xyThumbTop := cw+MulDiv(len-2*cw,sb.Position-sb.Min,amax)
else
info.xyThumbTop := cw;
end else begin
asize:=cw;
if sb.Position<>sb.Min then
info.xyThumbTop := cw+MulDiv(len-3*cw,sb.Position-sb.Min,amax)
else
info.xyThumbTop := cw;
end;
info.xyThumbBottom := info.xyThumbTop+asize;
end;
function TWScrollbar.GetControlInfo2(var info:tagScrollBarInfo):boolean;
var sb:TScrollbar;
p:TPoint;
asize:integer;
amax:integer;
si:SCROLLINFO;
begin
result:=false;
if control=nil then exit;
sb:=TScrollbar(control);
result:=true;
p:=point(0,0);
windows.ClientToScreen(hwnd,p);
// info.rcScrollBar := sb.ClientRect;
info.rcScrollBar := sb.BoundsRect;
// offsetrect(info.rcScrollBar,p.x,p.Y);
si.cbSize := sizeof( si );
si.fMask := SIF_ALL;
if sbDir=sb_horz then begin
GetScrollInfo( hWnd, SB_CTL, si );
end else begin
GetScrollInfo( hWnd, SB_CTL ,si );
end;
if sbDir=sb_horz then len:=info.rcScrollBar.Right-info.rcScrollBar.Left
else len:=info.rcScrollBar.bottom-info.rcScrollBar.top;
amax:=si.nMax-si.nMin;
if amax=0 then amax:=9999999;
if si.nPage<>0 then begin
asize:=MulDiv(len-2*cw,si.nPage-1,amax);
if asize<8 then begin
asize := 8;
if si.npos<>si.nMin then
info.xyThumbTop := cw + Muldiv(len - 2*cw-asize, si.nPos-si.nMin,amax)
else
info.xyThumbTop := cw;
end else begin
if si.npos<>si.nMin then
info.xyThumbTop := cw+MulDiv(len-2*cw,si.npos-si.nMin,amax)
else
info.xyThumbTop := cw;
end;
end else begin
asize:=cw;
if si.npos<>si.nMin then
info.xyThumbTop := cw+MulDiv(len-3*cw,si.npos-si.nMin,amax)
else
info.xyThumbTop := cw;
end;
info.xyThumbBottom := info.xyThumbTop+asize;
end;
procedure TWScrollbar.WMMouseLeave(Var aMsg: TMessage);
begin
if not fdown then begin
scrollpos:=-1;
invalidate();
end;
end;
procedure TWScrollbar.WMMouseMove(Var aMsg: TMessage);
var p:Tpoint;
i:integer;
begin
inherited;
P := point(amsg.LParamLo,amsg.LParamhi);
i:=getscrollpos(p) ;
if i<>scrollpos then begin
scrollpos:=i;
invalidate();
end;
WinSkinData.DoTrackMouse(Handle);
end;
procedure TWScrollbar.WMLButtonDown(Var aMsg: TMessage);
var p:Tpoint;
x:integer;
barinfo : tagScrollBarInfo;
b:boolean;
begin
inherited;
P := point(amsg.LParamLo,amsg.LParamhi);
GetCursorPos(trackp);
fillchar(barinfo,sizeof(barinfo),#0);
barinfo.cbSize := SizeOf(barinfo);
if sbtype=SB_VERT then begin
b:=obj.fsd.GetScrollBarInfo(hwnd, OBJID_VSCROLL, barinfo);
end else if sbtype=SB_Horz then begin
b:= obj.fsd.GetScrollBarInfo(hwnd, OBJID_HSCROLL, barinfo);
end else if sbtype=SB_CTL then
b:= GetControlInfo(barinfo);
if b then begin
trackthumb:=barinfo.xyThumbTop;
end;
scrollpos:=getscrollpos(p) ;
if sbtype=SB_CTL then begin
end else begin
offsetSC:=point(barinfo.rcScrollBar.Left,barinfo.rcScrollBar.Top);
amsg.LParamLo:=amsg.LParamLo+offsetSc.x;// inc(amsg.LParamLo,offsetSc.x);
amsg.LParamHi:=amsg.LParamHi+offsetSc.y;//inc(amsg.LParamHi,offsetSc.y);
end;
fdown:=true;
invalidate;
scrollpos:=getscrollpos(p) ;
releasecapture;
if sbtype=SB_VERT then begin
sendmessage(hwnd,CM_Scroll1,C_Paramv,amsg.lparam);
end else if sbtype=SB_HORZ then
sendmessage(hwnd,CM_Scroll1,C_Paramh,amsg.lparam)
else
sendmessage(hwnd,CM_Scroll2,c_paramB,amsg.lparam);
fdown:=false;
ReleaseCapture;
if sbtype=SB_CTL then invalidate;
end;
procedure TWScrollbar.WMLButtonUp(Var aMsg: TMessage);
var p:Tpoint;
x:integer;
begin
inherited;
P := point(amsg.LParamLo,amsg.LParamhi);
if sbdir<>SB_CTL then begin
inc(amsg.LParamLo,offsetSc.x);
inc(amsg.LParamHi,offsetSc.y);
end;
fdown:=false;
ReleaseCapture;
if sbtype=SB_VERT then
postmessage(hwnd,CM_Scroll3,C_Paramv,amsg.lparam)
else if sbtype=SB_HORZ then
postmessage(hwnd,CM_Scroll3,C_Paramh,amsg.lparam)
else
postmessage(hwnd,CM_Scroll4,c_paramB,amsg.lparam);
if sbtype=SB_CTL then invalidate;
end;
procedure TWScrollbar.doLog(Message: TMessage);
var s:string;
begin
{$IFDEF test}
s:= MsgtoStr(message);
if s<>'' then form1.memo2.lines.add(s);
{$ENDIF}
end;
procedure TWScrollbar.GetThumb(rc:TRect);
var p:Tpoint;
size:integer;
begin
GetCursorPos(p);
size:=thumbbottom-thumbtop;
thumbtop:=trackthumb;
if(sbDir=sb_Vert) then
inc(thumbtop,p.Y-trackp.y)
else
inc(thumbtop,p.x-trackp.x);
if thumbtop<cw then thumbtop:=cw;
if thumbtop>Len-cw-size then thumbtop:=Len-cw-size;
thumbbottom:=thumbtop+size;
end;
procedure TWScrollbar.Paint;
var rc,rc1,rc2:TRect;
p:Tpoint;
barinfo : tagScrollBarInfo;
b,sbenable:boolean;
temp:TBitmap;
fsd:TSkindata;
bw,i1,i2,swidth,n:integer;
begin
// if not sbvisible then exit;
fsd:=obj.fsd;
if (fsd.SArrow=nil) or fsd.sarrow.map.empty then exit;
fillchar(barinfo,sizeof(barinfo),#0);
barinfo.cbSize := SizeOf(barinfo);
if sbtype=SB_VERT then begin
b:=fsd.GetScrollBarInfo(hwnd, OBJID_VSCROLL, barinfo);
end else if sbtype=SB_Horz then begin
b:= fsd.GetScrollBarInfo(hwnd, OBJID_HSCROLL, barinfo);
end else if sbtype=SB_CTL then
b:= GetControlInfo2(barinfo);
// b:= GetScrollBarInfo(obj.hwnd, OBJID_CLIENT, barinfo);
if not b then exit; //recreatewnd
if (barinfo.rgstate[0] and STATE_SYSTEM_INVISIBLE)>0 then exit;
if (barinfo.rgstate[0] and STATE_SYSTEM_UNAVAILABLE)>0 then
sbEnable:=false
else sbEnable:=true;
// if self.enabled<>sbenable then self.Enabled:=sbenable;
bw:=cw;
rc:= barinfo.rcScrollBar;
offsetrect(rc,-rc.left,-rc.top);
if (rc.Bottom<0) or (rc.Right<0) then exit;
if (rc.Bottom>Height) or (rc.Right>Width) then exit;
// if (rc.right>fsd.cxMax) or (rc.Bottom>fsd.cyMax) then exit;
if sbtype=SB_vert then len:=rc.Bottom
else len:=rc.Right;
swidth:=fsd.SArrow.map.height;
// if swidth>cw then swidth:=cw;
if abs(swidth-cw)>2 then swidth:=cw;
//Tscrollbar
if sbtype=SB_CTL then begin
if sbDir=sb_Horz then rc.bottom:=swidth
else rc.right:=swidth;
end;
temp:=Tbitmap.create;
try
temp.width:=rc.right;
temp.height:=rc.bottom;
except
temp.Free;
exit;
end;
SetStretchBltMode(temp.canvas.handle,STRETCH_DELETESCANS);
temp.canvas.brush.color:=fsd.colors[csbuttonface];
temp.canvas.fillrect(rc);
//for ws_vscroll ws_hscroll
if sbtype<>SB_CTL then begin
if sbDir=sb_Horz then rc.bottom:=swidth
else rc.right:=swidth;
end;
rc1:=rc;
i1:=1;
if not sbEnable then i1:=3;
if sbDir=SB_Horz then begin
rc1.left:=rc1.left+bw;
rc1.right:=rc1.right-bw;
DrawRect2(temp.canvas.handle,rc1,fsd.HBar.map,
fsd.HBar.r,i1,4,fsd.hbar.trans,fsd.hbar.tile);
end else begin
rc1.top:=rc1.top+bw;
rc1.bottom:=rc1.bottom-bw;
DrawRect2(temp.canvas.handle,rc1,fsd.VBar.map,
fsd.VBar.r,i1,4,fsd.vbar.trans,fsd.hbar.tile);
end;
//Button
rc1 := rc; rc2 := rc;
if ( sbDir=SB_Horz ) then begin //HBar
if (rc.right)<2*bw then bw := rc.right div 2;
rc1.right := rc1.left + bw;
rc2.left := rc2.right - bw;
i1:=1;i2:=5;
end else begin// SB_VERT
if rc.bottom<2*bw then bw := rc.bottom div 2;
rc1.bottom := rc1.top + bw;
rc2.top := rc2.bottom - bw;
i1:=9;i2:=13;
// if fdown and (scrollpos=SB_LINEUP) then inc(i1);
// if fdown and (scrollpos=SB_LINEDown) then inc(i2);
end;
if (scrollpos=SB_LINELeft) then begin
if fdown then inc(i1)
else inc(i1,3);
end;
if (scrollpos=SB_LINERight) then begin
if fdown then inc(i2)
else inc(i2,3);
end;
obj.DrawSkinMap3( temp.canvas,rc1,fsd.SArrow.map,i1,23);
obj.DrawSkinMap3( temp.canvas,rc2,fsd.SArrow.map,i2,23);
if fdown and (scrollpos=SB_THUMBTRACK) and (sbtype<>sb_Ctl) then
GetThumb(rc)
else begin
thumbtop:=barinfo.xyThumbTop;
thumbBottom:=barinfo.xyThumbBottom;
end;
i1:=1;
if (scrollpos=SB_THUMBTRACK) then begin
if fdown then inc(i1)
else inc(i1,2);
end;
if sbEnable then begin
if ( sbDir=SB_VERT ) then begin
i2:=20;
rc1:=Rect(0,thumbtop,swidth,thumbbottom);
if (thumbtop<Height) and (thumbbottom<Height) then
DrawRect2(temp.canvas.handle,rc1,fsd.VSlider.map,
fsd.Vslider.r,i1,fsd.Hslider.frame,fsd.hslider.trans)
end else begin// SB_HORZ
i2:=17;
rc1:=Rect(thumbtop,0,thumbbottom,swidth);
if (thumbtop<Width) and (thumbbottom<Width) then
DrawRect2(temp.canvas.handle,rc1,fsd.HSlider.map,
fsd.Hslider.r,i1,fsd.Hslider.frame,fsd.hslider.trans)
end;
if (scrollpos=SB_THUMBTRACK) then begin
if fdown then inc(i2)
else inc(i2,2);
end;
bw := fsd.SArrow.map.Height;
if (thumbbottom-thumbtop+2)>bw then begin
n:=(thumbbottom-thumbtop-bw) div 2 ;
if ( sbDir=SB_VERT ) then begin
rc2:=Rect(0,thumbtop+n,swidth,thumbtop+n+bw) ;
if (rc2.Top<Height) and (rc2.Bottom<Height)then
obj.DrawSkinMap3( temp.canvas,rc2,fsd.SArrow.map,i2,23);
end else begin
rc2:=Rect(thumbtop+n,0,thumbtop+n+bw,swidth);
if (rc2.left<Width) and (rc2.Right<Width) then
obj.DrawSkinMap3( temp.canvas,rc2,fsd.SArrow.map,i2,23);
end;
end;
end;
//windows.getclientrect(hwnd,rc);
rc:=clientrect;
if sbtype=SB_CTL then
StretchBlt(canvas.Handle,rc.Left,rc.Top,rc.Right,rc.Bottom,
temp.Canvas.Handle ,0 ,0 ,temp.width,temp.height,Srccopy)
else
StretchBlt(canvas.Handle,0,0,temp.width,temp.height,
temp.Canvas.Handle ,0 ,0 ,temp.width,temp.height,Srccopy);
temp.free;
end;
{constructor TEScrollbar.Create(AOwner: TComponent);
begin
control:=nil;
cw:= GetSystemMetrics( SM_CXHSCROLL );
hwnd:=0;
inherited create(aowner);
end;
destructor TEScrollbar.Destroy;
begin
inherited destroy;
end;
procedure TEScrollbar.attach(aobj:TSkinControl;aParentControl:Twincontrol;
aScrollbar:Tcontrol;aType:byte);
var s:string;
begin
obj:=aobj;
Pcontrol:=aParentControl;
hwnd:=aParentControl.handle;
control:=ascrollbar;
sbtype:=aType;
sbDir:=sbType;
if (aType=255) and (control<>nil) then begin
s:=lowercase(GetEnumProperty(control,'Kind'));
if s='sbhorizontal' then sbdir:=sb_HORZ
else sbdir:=sb_vert;
end;
ParentWindow:=GetParent(hWnd);
setposition;
end;
procedure TEScrollbar.ButtonUp;
begin
fdown:=false;
ReleaseCapture;
invalidate;
end;
procedure TEScrollbar.HideScrollbar;
begin
ShowWindow(handle,SW_HIDE);
sbVisible:=false;
end;
procedure TEScrollbar.SetPosition;
var r1:TRect;
p,p1:Tpoint;
barinfo : tagScrollBarInfo;
b:boolean;
Parenthwnd: Thandle;
begin
fillchar(barinfo,sizeof(barinfo),#0);
barinfo.cbSize := SizeOf(barinfo);
GetControlInfo(barinfo);
// sbVisible:=b;
if barinfo.rgstate[0] >0 then begin
ShowWindow(handle,SW_HIDE);
sbVisible:=false;
end else begin
r1:= barinfo.rcScrollBar;
sbrect:=r1;
ParentHwnd := GetParent(hWnd);
p:=point(r1.Left,r1.Top);
MapWindowPoints(hwnd,parenthwnd,P, 1);
offsetrect(r1,-r1.Left,-r1.Top);
if sbDir=SB_vert then len:=r1.Bottom
else len:=r1.Right;
SetWindowPos(handle, HWND_TOP, p.X,p.y,r1.Right,r1.Bottom,SWP_SHOWWINDOW or SWP_NOREDRAW);
// if sbDir=SB_vert then
// SetWindowPos(handle, HWND_TOP, r1.Left,r1.Top,r1.Right,r1.Bottom,SWP_SHOWWINDOW or SWP_NOREDRAW)
// else
// SetWindowPos(handle, HWND_TOP, r1.Left,r1.Top,r1.Right,r1.Bottom,SWP_SHOWWINDOW or SWP_NOREDRAW);
end;
end;
function TEScrollbar.GetControlInfo(var info:tagScrollBarInfo):boolean;
var p:TPoint;
asize:integer;
pagesize,amax,amin:integer;
position:integer;
s:string;
begin
result:=false;
if control=nil then exit;
p:=point(0,0);
windows.ClientToScreen(hwnd,p);
info.rcScrollBar := rect(control.left,control.top,
control.left+control.Width,control.top+control.height);
// offsetrect(info.rcScrollBar,p.x,p.Y);
if sbDir=sb_horz then len:=info.rcScrollBar.Right-info.rcScrollBar.Left
else len:=info.rcScrollBar.bottom-info.rcScrollBar.top;
PageSize := GetIntProperty(control,'PageSize') ;
amax := GetIntProperty(control,'Max') ;
amin := GetIntProperty(control,'Min') ;
Position := GetIntProperty(control,'Position') ;
// s := lowercase(GetEnumProperty(control,'Visible'));
// if s='true' then sbVisible:=true
// else sbVisible:=false;
sbVisible:=control.Visible;
result:=sbVisible;
if PageSize<>0 then begin
asize:=MulDiv(len-2*cw,pagesize-amin,amax);
if Position<>0 then
info.xyThumbTop := cw+MulDiv(len-2*cw,Position,amax)
else
info.xyThumbTop := cw;
end else begin
asize:=cw;
if Position<>0 then
info.xyThumbTop := cw+MulDiv(len-3*cw,Position,amax)
else
info.xyThumbTop := cw;
end;
info.xyThumbBottom := info.xyThumbTop+asize;
end;
function TEScrollbar.GetScrollPos(p:Tpoint):integer;
var x:integer;
begin
if sbDir=SB_Horz then x:=p.x
else x:=p.y;
if x<cw then result:=SB_LINEUP
else if x<thumbtop then result:=SB_PAGEUP
else if x<thumbbottom then result:=SB_THUMBTRACK
else if x<len-cw then result:=SB_PAGEDOWN
else result:=SB_LINEDOWN;
end;
procedure TEScrollbar.GetThumb(rc:TRect);
var p:Tpoint;
size:integer;
begin
GetCursorPos(p);
size:=thumbbottom-thumbtop;
thumbtop:=trackthumb;
if(sbDir=sb_Vert) then
inc(thumbtop,p.Y-trackp.y)
else
inc(thumbtop,p.x-trackp.x);
if thumbtop<cw then thumbtop:=cw;
if thumbtop>Len-cw-size then thumbtop:=Len-cw-size;
thumbbottom:=thumbtop+size;
end;
procedure TEScrollbar.WMLButtonDown(Var aMsg: TMessage);
var p:Tpoint;
x:integer;
barinfo : tagScrollBarInfo;
b:boolean;
begin
inherited;
P := point(amsg.LParamLo,amsg.LParamhi);
// inc(amsg.LParamLo,Sbrect.left);
// inc(amsg.LParamHi,sbRect.top);
GetCursorPos(trackp);
fillchar(barinfo,sizeof(barinfo),#0);
barinfo.cbSize := SizeOf(barinfo);
b:= GetControlInfo(barinfo);
if b then begin
trackthumb:=barinfo.xyThumbTop;
end;
scrollpos:=getscrollpos(p);
// SetCapture(handle);
fdown:=true;
invalidate;
control.Perform(CM_Scroll2,c_paramB,amsg.lparam);
// postmessage(hwnd,CM_Scroll2,c_paramB,amsg.lparam);
end;
procedure TEScrollbar.WMERASEBKGND(var Msg: TMessage);
begin
Msg.Result := 1;
end;
procedure TEScrollbar.Paint;
var rc,rc1,rc2:TRect;
p:Tpoint;
barinfo : tagScrollBarInfo;
b,sbenable:boolean;
temp:TBitmap;
fsd:TSkindata;
bw,i1,i2,swidth:integer;
begin
fsd:=obj.fsd;
if (fsd.SArrow=nil) or fsd.sarrow.map.empty then exit;
fillchar(barinfo,sizeof(barinfo),#0);
barinfo.cbSize := SizeOf(barinfo);
b:= GetControlInfo(barinfo);
if barinfo.rgstate[0]>1 then
sbEnable:=false;
bw:=cw;
rc:= barinfo.rcScrollBar;
offsetrect(rc,-rc.left,-rc.top);
if sbtype=SB_vert then len:=rc.Bottom
else len:=rc.Right;
swidth:=fsd.SArrow.map.height;
if swidth+3<cw then swidth:=cw;
temp:=Tbitmap.create;
temp.width:=rc.right;
temp.height:=rc.bottom;
SetStretchBltMode(temp.canvas.handle,STRETCH_DELETESCANS);
temp.canvas.brush.color:=fsd.colors[csbuttonface];
temp.canvas.fillrect(rc);
if sbDir=sb_Horz then rc.bottom:=swidth
else rc.right:=swidth;
rc1:=rc;
i1:=1;
if not sbEnable then i1:=3;
if sbDir=SB_Horz then begin
rc1.left:=rc1.left+bw;
rc1.right:=rc1.right-bw;
DrawRect2(temp.canvas.handle,rc1,fsd.HBar.map,
fsd.HBar.r,i1,4,fsd.hbar.trans,fsd.hbar.tile);
end else begin
rc1.top:=rc1.top+bw;
rc1.bottom:=rc1.bottom-bw;
DrawRect2(temp.canvas.handle,rc1,fsd.VBar.map,
fsd.VBar.r,i1,4,fsd.vbar.trans,fsd.hbar.tile);
end;
//Button
rc1 := rc; rc2 := rc;
if ( sbDir=SB_Horz ) then begin //HBar
if (rc.right)<2*bw then bw := rc.right div 2;
rc1.right := rc1.left + bw;
rc2.left := rc2.right - bw;
i1:=1;i2:=5;
if fdown and (scrollpos=SB_LINELeft) then inc(i1);
if fdown and (scrollpos=SB_LINERight) then inc(i2);
end else begin// SB_VERT
if rc.bottom<2*bw then bw := rc.bottom div 2;
rc1.bottom := rc1.top + bw;
rc2.top := rc2.bottom - bw;
i1:=9;i2:=13;
if fdown and (scrollpos=SB_LINEUP) then inc(i1);
if fdown and (scrollpos=SB_LINEDown) then inc(i2);
end;
obj.DrawSkinMap3( temp.canvas,rc1,fsd.SArrow.map,i1,23);
obj.DrawSkinMap3( temp.canvas,rc2,fsd.SArrow.map,i2,23);
if (scrollpos=SB_THUMBTRACK) then
GetThumb(rc)
else begin
thumbtop:=barinfo.xyThumbTop;
thumbBottom:=barinfo.xyThumbBottom;
end;
// thumbtop:=barinfo.xyThumbTop;
// thumbBottom:=barinfo.xyThumbBottom;
i1:=1;
if fdown and (scrollpos=SB_THUMBTRACK) then
inc(i1);
if ( sbDir=SB_VERT ) then begin
rc1:=Rect(0,thumbtop,swidth,thumbbottom);
DrawRect2(temp.canvas.handle,rc1,fsd.VSlider.map,
fsd.Vslider.r,i1,fsd.Hslider.frame,fsd.hslider.trans)
end else begin// SB_HORZ
rc1:=Rect(thumbtop,0,thumbbottom,swidth);
DrawRect2(temp.canvas.handle,rc1,fsd.HSlider.map,
fsd.Hslider.r,i1,fsd.Hslider.frame,fsd.hslider.trans)
end;
StretchBlt(canvas.Handle,0,0,temp.width,temp.height,
temp.Canvas.Handle ,0 ,0 ,temp.width,temp.height,Srccopy);
temp.free;
end;}
constructor TSkinScrollbar.Create(AOwner: TComponent);
begin
inherited create(aowner);
hb:=nil;
vb:=nil;
sizing:=false;
border:=false;
kind:=0;
nobe:=true;
end;
destructor TSkinScrollbar.Destroy;
begin
// if control=nil then begin
if hb<>nil then
hb.free;
if vb<>nil then
vb.free;
hb:=nil;
vb:=nil;
// end;
inherited;
end;
procedure TSkinScrollbar.InitScrollbar(acontrol:Twincontrol;sd:TSkinData;acanvas:TCanvas;sf:Tcomponent);
var s:string;
PropInfo:PPropInfo;
begin
fsd:=sd;
skinform:=sf;
control:=acontrol;
hwnd := control.handle;
painted:= (Win32Platform = VER_PLATFORM_WIN32_NT) and (Win32MajorVersion >= 5) and (Win32MinorVersion >= 1);
Twinskinform(skinform).addcontrollist(self);
s:=lowercase(GetEnumProperty(control,'BorderStyle'));
if s<>'bsnone' then border:=true;
if control<>nil then s:=control.classname;
if s='TImageScrollBox' then border:=false;
if kind=1 then border:=false;
PropInfo:=GetPropInfo(control,'FixedColor');
if (PropInfo<>nil) and
(propinfo^.PropType^.Kind = tkInteger) then begin
oldcolor :=Tcolor(GetOrdProp(control,PropInfo));
newcolor:=true;
SetProperty(control,'FixedColor',inttostr(fsd.colors[csbuttonface]));
end;
hb:=TWscrollbar.create(self);
hb.attach(self,control,sb_horz);
vb:=TWscrollbar.create(self);
vb.attach(self,control,sb_vert);
hb.Enabled:=control.Enabled;
vb.Enabled:=control.Enabled;
if not control.Visible then begin
vb.HideScrollbar;hb.HideScrollbar;
end;
OldWndProc:= Control.WindowProc;
Control.WindowProc := NewWndProc;
end;
Procedure TSkinScrollBar.SkinChange;
var s:string;
PropInfo:PPropInfo;
begin
// inherited Skinchange;
PropInfo:=GetPropInfo(control,'FixedColor');
if (PropInfo<>nil) and
(propinfo^.PropType^.Kind = tkInteger) then begin
oldcolor :=Tcolor(GetOrdProp(control,PropInfo));
newcolor:=true;
SetProperty(control,'FixedColor',inttostr(fsd.colors[csbuttonface]));
end;
end;
procedure TSkinScrollBar.SetScrollbarPos(message:TMessage);
begin
if hb<>nil then hb.SetPosition(hwnd);
if vb<>nil then vb.SetPosition(hwnd);
end;
procedure TSkinScrollBar.DrawBorder( dc:HDC; rc:TRect);
var r,r1:Trect;
acolor:Tcolor;
c1:Tcolor;
b1,b2:HBRUSH;
s:string;
begin
r1:=rc;
B1:=CreateSolidBrush(fsd.colors[csButtonShadow]);
// B1:=CreateSolidBrush(fsd.colors[csButtonDkshadow]);
FrameRect(dc,r1,b1);
c1:=fsd.colors[csButtonface];//clwhite;
B2:=CreateSolidBrush(c1);
InflateRect(r1,-1,-1);
FrameRect(dc,r1,b2);
deleteobject(B2);
deleteobject(B1);
end;
procedure TSkinScrollBar.DrawControl( dc:HDC; rc:TRect);
var r:Trect;
style:dword;
begin
// painted:=true;
style:=GetWindowLong(hWnd,GWL_STYLE);
if (vb<>nil) then begin
if vb.sbvisible then vb.Invalidate
else if (style and ws_vscroll)>0 then
vb.SetPosition(hwnd);
end;
if (hb<>nil) then begin
if hb.sbvisible then hb.Invalidate
else if (style and ws_hscroll)>0 then
hb.SetPosition(hwnd);
end;
if (vb<>nil) and (hb<>nil) and vb.sbvisible and hb.sbvisible then begin
r:=rect(vb.sbRect.left+2,hb.sbRect.top+2,vb.sbRect.right+2,hb.sbRect.bottom+2);
FillBG( dc,r);
end;
// if border then drawborder(dc,rc);
end;
procedure TSkinScrollbar.BENCPAINT(adc:HDC);
var rc:TRect;
begin
if GetWindowRect( hWnd, rc ) then begin;
try
OffsetRect( rc, -rc.left, -rc.top );
DrawBorder(adc,rc);
except
end;
end;
end;
function TSkinScrollbar.BeforeProc(var Message: TMessage):boolean;
var
DC: HDC;
begin
case message.msg of
WM_NCPAINT:
begin
if border then begin
default(message);
DC := GetWindowDC(Control.Handle);
BENCPaint(DC);
ReleaseDC(Control.Handle, DC);
Result := False;
end else result:=true;
end
else result:=inherited beforeProc(message);
end;
end;
procedure TSkinScrollbar.AfterProc(var Message: TMessage);
var s:string;
dwstyle:dword;
begin
{$IFDEF scrollbartest}
s:= MsgtoStr(message);
if s<>'' then fsd.DoDebug('Scrollbar '+s);
{$ENDIF}
case message.msg of
CM_VISIBLECHANGED : begin
if message.wParam=0 then begin
vb.HideScrollbar;hb.HideScrollbar;
end else begin
SetScrollbarPos(message);
end;
end;
CM_ENABLEDCHANGED:begin
hb.Enabled:= control.Enabled;
vb.Enabled:= control.Enabled;
end;
CM_RECREATEWND: begin
if (control<>nil) and (skinform<>nil) then
postmessage(Twinskinform(skinform).hwnd,CN_ReCreateWnd,hwnd,0);
end;
WM_Size,WM_WINDOWPOSCHANGED:begin
sizing:=true;
SetScrollbarPos(message);
//invalidate;
end;
WM_VSCROLL: begin
vb.scrollpos:= message.WParamLo;
vb.Invalidate;
end;
WM_HSCROLL: begin
hb.scrollpos:= message.WParamLo;
hb.Invalidate;
end;
WM_MOUSEWHEEL: begin
if (vb<>nil) and vb.sbvisible then vb.Invalidate;
if (hb<>nil) and hb.sbvisible then hb.Invalidate;
end;
CM_BENCPAINT: begin
if Message.LParam = BE_ID then begin
if Message.WParam <> 0 then begin
BENCPAINT(Message.WParam);
end;
Message.Result := BE_ID;
end ;
end;
else inherited Afterproc(message);
end;
end;
procedure TSkinScrollBar.Unsubclass;
begin
if newcolor then
SetProperty(control,'FixedColor',inttostr(oldcolor));
newcolor:=false;
inherited unsubclass;
if skinstate<>skin_deleted then begin
if hb<>nil then hb.free;
hb:=nil;
if vb<>nil then vb.free;
vb:=nil;
end else begin
end;
end;
constructor TComboxScrollBar.Create(AOwner: TComponent);
begin
inherited create(aOwner);
control:=nil;
cw:= GetSystemMetrics( SM_CXHSCROLL );
end;
destructor TComboxScrollBar.Destroy;
begin
inherited destroy;
end;
procedure TComboxScrollBar.AfterProc(var Message: TMessage);
begin
case message.msg of
WM_NCPaint: begin
PaintControl;
end;
WM_HSCROLL : begin
PaintControl;
end;
WM_VSCROLL : begin
PaintControl;
end;
$1ae: paintcontrol;
else inherited AfterProc(message);
end;
end;
function TComboxScrollBar.WMNCPaint(var message:TMessage):boolean;
var style:Dword;
begin
{ style:=GetWindowLong(hWnd,GWL_STYLE);
if (style and WS_VSCROLL) >0 then begin
style := style and (not WS_VSCROLL);
SetWindowLong(hWnd,GWL_STYLE,style);
default(message);
style := style or WS_VSCROLL;
SetWindowLong(hWnd,GWL_STYLE,style);
paintcontrol(message.WParam);
end else begin
default(message);
end; }
// result:=false;
result:=true;
end;
function TComboxScrollBar.BeforeProc(var Message: TMessage):boolean;
var s:string;
begin
{$IFDEF combox}
s:= MsgtoStr(message);
if s<>'' then begin
s:=format('ComboxScrollbar %s %1x %1x',[s,message.msg,message.wparam,message.lparam]);
end else begin
s:=format('ComboxScrollbar %1x %1x %1x',[message.msg,message.wparam,message.lparam]);
end;
skinaddlog(s);
{$ENDIF}
case message.msg of
WM_NCMouseMove:begin
if message.wparam in [HTVSCROLL,HTHSCROLL] then
result:=false;
end;
WM_NCPAINT:begin
result:= WMNCPaint(message);
end;
WM_NCLButtonDown:begin
if NCLButtonDown(message) then result:=false
else result:=true;
end;
else result:=inherited BeforeProc(message);
end;
end;
function TComboxScrollBar.NCLButtonDown(var Message: TMessage):boolean;
var p0,p:Tpoint;
msgid:longword;
pos:integer;
barinfo : tagScrollBarInfo;
b:boolean;
bar :integer;
bw:integer;
trackpos,inloop:boolean;
Msg: TMsg;
x,x0,maxx,minx,oldpos,oldthumb,xthumb:integer;
si:SCROLLINFO;
begin
result:=false;
if message.wparam <> HTVSCROLL then exit;
fillchar(barinfo,sizeof(barinfo),#0);
barinfo.cbSize := SizeOf(barinfo);
P := point(message.LParamLo,message.LParamhi);
if(message.wParam = HTHSCROLL) then begin
msgid := WM_HSCROLL;
bar := SB_Horz;
b:= fsd.GetScrollBarInfo(hwnd, OBJID_HSCROLL, barinfo);
end else if(message.wParam = HTVSCROLL) then begin
msgid := WM_VSCROLL;
bar := SB_Vert;
b:=fsd.GetScrollBarInfo(hwnd, OBJID_VSCROLL, barinfo);
end;
if not b then exit;
if bar=SB_Horz then x:=p.x-barinfo.rcScrollBar.left
else x:=p.y-barinfo.rcScrollBar.top;
if (x<barinfo.xyThumbTop) or (x>barinfo.xyThumbBottom) then exit;
//drag thumb
SetCapture(hwnd);
GetCursorPos(p0);
si.cbSize := sizeof( SCROLLINFO );
si.fMask := SIF_ALL;
GetScrollInfo( hWnd, bar, si );
oldpos:=si.nPos;
oldthumb:=barinfo.xyThumbTop-cw;
x0:=oldpos;
maxx:= (barinfo.rcScrollBar.Bottom-barinfo.rcScrollBar.Top)-2*cw;
bw:=(barinfo.xyThumbBottom-barinfo.xyThumbTop);
SetCapture(hwnd);
trackpos:=true;
repeat
if PeekMessage(Msg, 0, 0, 0, PM_REMOVE) then begin
case Msg.message of
WM_Mousemove,WM_NCMouseMove:begin
TranslateMessage(Msg);
DispatchMessage(Msg);
GetCursorPos(p);
if(bar=SB_Vert) then begin
xthumb:= oldthumb+p.y-p0.y;
end else begin
xthumb:= oldthumb+p.x-p0.x;
end;
if xthumb<0 then xthumb:=0;
if si.npage=0 then begin
if xthumb>maxx-bw then xthumb:=maxx-bw;
x:= muldiv(xthumb,(si.nMax-si.nmin),maxx)+si.nmin;
if x>si.nmax then x:=si.nmax;
end else begin
if xthumb>(maxx-bw) then xthumb:=maxx-bw+1;
x:= muldiv(xthumb,(si.nmax-si.nmin-si.nPage),maxx-bw)+si.nmin;
// if x>si.nMax-si.nMin-si.nPage-4 then
// fsd.DoDebug(format('thumb %1d x %1d max %1d',[xthumb,x,si.nMax]));
if x>=(si.nmax-si.npage) then
x:=si.nmax-si.npage+1;
end;
if x<si.nmin then x:= si.nmin;
if x<>x0 then begin
si.fMask:=SIF_POS;
si.npos:=x;
si.nTrackPos:=x;
// si.thumbpos:=xthumb;
// SetScrollInfo(hwnd,bar,si,false);
sendmessage(hwnd,msgid,MAKEWPARAM(SB_THUMBTRACK,x),0);
end;
x0:=x;
end;
WM_NCLBUTTONUP,WM_LBUTTONUP: begin
// setscrollbar(true,sp[bar].MsgID);
trackpos:=false;
sendmessage(hwnd,msgid,MAKEWPARAM(SB_THUMBPOSITION,x),0);
postmessage(hwnd,msgid,SB_ENDSCROLL,0);
end;
else
TranslateMessage(Msg);
DispatchMessage(Msg);
end;
end;
until not trackpos;
ReleaseCapture;
result:=true;
end;
procedure TComboxScrollBar.Unsubclass;
begin
inherited unsubclass;
end;
procedure TComboxScrollBar.GetThumb(rc:TRect);
var p:Tpoint;
size:integer;
begin
GetCursorPos(p);
size:=thumbbottom-thumbtop;
thumbtop:=trackthumb;
if(sbDir=sb_Vert) then
inc(thumbtop,p.Y-trackp.y)
else
inc(thumbtop,p.x-trackp.x);
if thumbtop<cw then thumbtop:=cw;
if thumbtop>Len-cw-size then thumbtop:=Len-cw-size;
thumbbottom:=thumbtop+size;
end;
//paint two bar,check two bar
procedure TComboxScrollBar.DrawControl( dc:HDC; rc:TRect);
begin
paintscrollbar(dc,rc,SB_Vert);
end;
procedure TComboxScrollBar.PaintScrollbar( dc:HDC; rc:TRect; sbtype:integer );
var rc1,rc2,rr,rr2,rr1:TRect;
p:Tpoint;
b,sbenable:boolean;
temp:TBitmap;
bw,i1,i2,swidth,n:integer;
_width,_height:integer;
barinfo : tagScrollBarInfo;
begin
// if not sbvisible then exit;
if (fsd.SArrow=nil) or fsd.sarrow.map.empty then exit;
GetWindowRect(hwnd,rr1);
_width:= rr1.Right-rr1.Left;
_height:= rr1.Bottom-rr1.Top;
fillchar(barinfo,sizeof(barinfo),#0);
barinfo.cbSize := SizeOf(barinfo);
if sbtype=SB_VERT then begin
b:=fsd.GetScrollBarInfo(hwnd, OBJID_VSCROLL, barinfo);
end else if sbtype=SB_Horz then begin
b:= fsd.GetScrollBarInfo(hwnd, OBJID_HSCROLL, barinfo);
end ;
if not b then exit; //recreatewnd
if (barinfo.rgstate[0] and STATE_SYSTEM_INVISIBLE)>0 then exit;
if (barinfo.rgstate[0] and STATE_SYSTEM_UNAVAILABLE)>0 then
sbEnable:=false
else sbEnable:=true;
bw:=cw;
rr:= barinfo.rcScrollBar;
rr2:=rr;
// _width:= rr.Right-rr.Left;
// _height:= rr.Bottom-rr.Top;
offsetrect(rr,-rr.left,-rr.top);
if (rr.Bottom<0) or (rr.Right<0) then exit;
if (rr.Bottom>_height) or (rr.Right>_width) then exit;
if sbtype=SB_vert then len:=rc.Bottom
else len:=rc.Right;
swidth:=fsd.SArrow.map.height;
//swidth
if abs(swidth-cw)>2 then swidth:=cw;
if sbtype=SB_vert then rr.Right:=swidth
else rr.Bottom:=swidth;
temp:=Tbitmap.create;
try
temp.width:=rr.Right;
temp.height:=rr.Bottom;
except
temp.Free;
exit;
end;
SetStretchBltMode(temp.canvas.handle,STRETCH_DELETESCANS);
temp.canvas.brush.color:=fsd.colors[csbuttonface];
temp.canvas.fillrect(rr);
//for ws_vscroll ws_hscroll
// if sbtype<>SB_CTL then begin
// if sbDir=sb_Horz then rc.bottom:=swidth
// else rc.right:=swidth;
// end;
rc1:=rr;
i1:=1;
if not sbEnable then i1:=3;
if sbtype=SB_Horz then begin
rc1.left:=rc1.left+bw;
rc1.right:=rc1.right-bw;
DrawRect2(temp.canvas.handle,rc1,fsd.HBar.map,
fsd.HBar.r,i1,4,fsd.hbar.trans,fsd.hbar.tile);
end else begin
rc1.top:=rc1.top+bw;
rc1.bottom:=rc1.bottom-bw;
DrawRect2(temp.canvas.handle,rc1,fsd.VBar.map,
fsd.VBar.r,i1,4,fsd.vbar.trans,fsd.hbar.tile);
end;
//Button
rc1 := rr; rc2 := rr;
if ( sbtype=SB_Horz ) then begin //HBar
if (rc.right)<2*bw then bw := rc.right div 2;
rc1.right := rc1.left + bw;
rc2.left := rc2.right - bw;
i1:=1;i2:=5;
end else begin// SB_VERT
if rc.bottom<2*bw then bw := rc.bottom div 2;
rc1.bottom := rc1.top + bw;
rc2.top := rc2.bottom - bw;
i1:=9;i2:=13;
// if fdown and (scrollpos=SB_LINEUP) then inc(i1);
// if fdown and (scrollpos=SB_LINEDown) then inc(i2);
end;
if (scrollpos=SB_LINELeft) then begin
if fdown then inc(i1)
else inc(i1,3);
end;
if (scrollpos=SB_LINERight) then begin
if fdown then inc(i2)
else inc(i2,3);
end;
DrawSkinMap3( temp.canvas,rc1,fsd.SArrow.map,i1,23);
DrawSkinMap3( temp.canvas,rc2,fsd.SArrow.map,i2,23);
if fdown and (scrollpos=SB_THUMBTRACK) then
GetThumb(rr)
else begin
thumbtop:=barinfo.xyThumbTop;
thumbBottom:=barinfo.xyThumbBottom;
end;
i1:=1;
if (scrollpos=SB_THUMBTRACK) then begin
if fdown then inc(i1)
else inc(i1,2);
end;
if sbEnable then begin
if ( sbtype=SB_VERT ) then begin
i2:=20;
rc1:=Rect(0,thumbtop,swidth,thumbbottom);
if (thumbtop<_Height) and (thumbbottom<_Height) then
DrawRect2(temp.canvas.handle,rc1,fsd.VSlider.map,
fsd.Vslider.r,i1,fsd.Hslider.frame,fsd.hslider.trans)
end else begin// SB_HORZ
i2:=17;
rc1:=Rect(thumbtop,0,thumbbottom,swidth);
if (thumbtop<_Width) and (thumbbottom<_Width) then
DrawRect2(temp.canvas.handle,rc1,fsd.HSlider.map,
fsd.Hslider.r,i1,fsd.Hslider.frame,fsd.hslider.trans)
end;
if (scrollpos=SB_THUMBTRACK) then begin
if fdown then inc(i2)
else inc(i2,2);
end;
bw := fsd.SArrow.map.Height;
if (thumbbottom-thumbtop+2)>bw then begin
n:=(thumbbottom-thumbtop-bw) div 2 ;
if ( sbtype=SB_VERT ) then begin
rc2:=Rect(0,thumbtop+n,swidth,thumbtop+n+bw) ;
if (rc2.Top<_Height) and (rc2.Bottom<_Height)then
DrawSkinMap3( temp.canvas,rc2,fsd.SArrow.map,i2,23);
end else begin
rc2:=Rect(thumbtop+n,0,thumbtop+n+bw,swidth);
if (rc2.left<_Width) and (rc2.Right<_Width) then
DrawSkinMap3( temp.canvas,rc2,fsd.SArrow.map,i2,23);
end;
end;
end;
StretchBlt(Dc,rr2.Left-rr1.Left,rr2.Top-rr1.Top,temp.width,temp.height,
temp.Canvas.Handle ,0 ,0 ,temp.width,temp.height,Srccopy);
temp.free;
end;
constructor TSkinScrollbarH.Create(AOwner: TComponent);
begin
inherited create(aowner);
hb:=nil;
vb:=nil;
end;
destructor TSkinScrollbarH.Destroy;
begin
if hb<>nil then hb.free;
if vb<>nil then vb.free;
hb:=nil;
vb:=nil;
inherited;
end;
procedure TSkinScrollbarH.InitHwnd(ahwnd:Thandle;sd:TSkinData;acanvas:TCanvas;sf:Tcomponent);
begin
skinform:=sf;
fsd:=sd;
fCanvas:=acanvas;
hwnd := ahwnd;
control:=nil;
Twinskinform(skinform).addcontrollist(self);
hb:=TWscrollbar.create(self);
hb.attachhwnd(self,hwnd,sb_horz);
vb:=TWscrollbar.create(self);
vb.attachhwnd(self,hwnd,sb_vert);
FObjectInst := MakeObjectInstance(NewWndProc);
FPrevWndProc := Pointer(GetWindowLong(hwnd,GWL_WNDPROC));
SetWindowLong(hwnd, GWL_WNDPROC,LongInt(FObjectInst));
skinstate:=skin_active;
end;
procedure TSkinScrollBarH.SetScrollbarPos(message:TMessage);
begin
if hb<>nil then hb.SetPosition(hwnd);
if vb<>nil then vb.SetPosition(hwnd);
end;
procedure TSkinScrollbarH.AfterProc(var Message: TMessage);
var s:string;
begin
if not IsWindowVisible(hwnd) then
vb.HideScrollbar;
case message.msg of
// WM_NCPaint:begin
WM_Size,WM_NCPaint:begin
SetScrollbarPos(message);
invalidate;
end;
WM_VSCROLL: begin
if vb<>nil then begin
vb.scrollpos:= message.WParamLo;
vb.Invalidate;
end;
end;
WM_HSCROLL: begin
if hb<>nil then begin
hb.scrollpos:= message.WParamLo;
hb.Invalidate;
end;
end;
else inherited Afterproc(message);
end;
end;
procedure TSkinScrollBarH.Unsubclass;
begin
inherited unsubclass;
if skinstate<>skin_deleted then begin
if hb<>nil then hb.free;
hb:=nil;
if vb<>nil then vb.free;
vb:=nil;
end;
end;
procedure TSkinScrollBarH.DrawControl( dc:HDC; rc:TRect);
var r:Trect;
begin
if (vb<>nil) and vb.sbvisible then vb.Invalidate;
if (hb<>nil) and hb.sbvisible then hb.Invalidate;
if (vb<>nil) and (hb<>nil) and vb.sbvisible and hb.sbvisible then begin
r:=rect(vb.sbRect.left,hb.sbRect.top,vb.sbRect.right+2,hb.sbRect.bottom+2);
FillBG( dc,r);
end;
end;
Procedure TSkinHeader.Inithwnd(ahwnd:Thandle;sd:TSkinData;acanvas:TCanvas;sf:Tcomponent);
begin
inherited InitHwnd(ahwnd,sd,acanvas,sf);
indexitem:=-1;
// trackinfo.cbSize:=16;
// trackinfo.hwndTrack:=ahwnd;
// trackinfo.dwFlags:=2;
// Twinskinform(owner).addcontrollist(self);
end;
procedure TSkinHeader.Init(sf:Tcomponent;sd:TSkinData;acanvas:TCanvas;acolor:boolean=false);
begin
inherited init(sf,sd,acanvas,acolor);
indexitem:=-1;
end;
destructor TSkinHeader.Destroy;
begin
setlength(items,0);
inherited destroy;
end;
function TSkinHeader.BeforeProc(var Message: TMessage):boolean;
var s:string;
begin
result:=true;
{$IFDEF headertest}
case message.msg of
WM_Notify: begin
s:='HeaderControl WM_Notify '+ inttostr(TWMNotify(message).NMHdr^.code);
end;
else s:= MsgtoStr(message);
end;
if s<>'' then skinaddlog('HeaderControl '+s);
{$endif headertest}
case message.msg of
WM_ERASEBKGND:
if (fsd.header<>nil) and (not fsd.header.map.empty) then begin
// ERASEBKGND(message.wparam);
message.result:=1;
result:=false;
end;
wm_paint: begin
wmpaint(message);
result:=false;
end;
else result:=inherited beforeproc(message);
end;
end;
procedure TSkinHeader.WMMouseMove(var Message: TMessage);
var i:integer;
p:Tpoint;
begin
P := point( Message.LParamLo, Message.LParamhi);
for i:=0 to high(items) do begin
if PtInRect(items[i],p) and (i<>indexitem) then begin
indexitem:=i;
invalidate;
// fsd.DoDebug('hower:'+inttostr(i));
end;
end;
WinSkinData.DoTrackMouse(hwnd);
end;
procedure TSkinHeader.AfterProc(var Message: TMessage);
var trackinfo : TTrackMouseEvent;
begin
case message.msg of
WM_MOUSEMOVE: WMMouseMove(message);
WM_MOUSELEAVE: begin
indexitem:=-1;
invalidate;
end;
else inherited Afterproc(message);
end;
end;
procedure TSkinHeader.DrawControl( dc:HDC; rc:TRect);
var r1:TRect;
i,n,x:integer;
bfont,cfont:Hfont;
temp,temp2:Tbitmap;
imglist:Himagelist;
begin
if (fsd.header=nil) or (fsd.header.map.empty) then exit;
x:=0;
temp:=Tbitmap.create;
temp.width:=rc.right-rc.left;
temp.height:=rc.bottom-rc.top;
bfont:=sendmessage(hwnd,wm_getfont,0,0);
enabled:=true;
// temp.canvas.Font.Color := fsd.colors[csButtonText];
// temp.canvas.Font.style := [];
cfont:=selectobject(temp.canvas.handle,bfont);
SetBkMode(temp.canvas.Handle, TRANSPARENT);
imglist:=sendmessage(hwnd,HDM_GETIMAGELIST,0,0);
n:=Header_GetItemCount(hwnd);
SetLength(items,n);
for i:= 0 to n-1 do begin
if Header_GetItemRect(hwnd,i,@r1)<>0 then begin
drawitem(imglist,temp.canvas,r1,i);
Items[i]:=r1;
InflateRect(Items[i],-3,0);
if x<r1.right then x:=r1.right;
end;
end;
if x<rc.right then begin
r1:=rect(x,rc.top,rc.right,rc.bottom);
temp2:=GetHMap(r1,fsd.header.map,fsd.header.r,1,
fsd.header.frame,fsd.header.tile);
temp.canvas.draw(r1.left,r1.top,temp2);
temp2.free;
end;
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;
procedure TSkinHeader.DrawItemImgCaption(acanvas: TCanvas; rc:TRect;
ImgList:hImageList;imgIndex:integer;text:widestring;talign:integer=DT_CENTER);
var
imgrect,textrect,r1,r2: TRect;
DrawStyle: Longint;
h,w,margin:integer;
begin
ImageList_GetIconSize(ImgList,w,h);
if (imgindex<>-1) and (ImgList<>0) and ((rc.Right-rc.left)>w) then begin
imgrect:=rect(0,0,w,h);
end else begin
imgrect:=rect(0,0,0,0);
w:=0;
end;
//DrawStyle:= DrawStyle or dt_WordBreak ;
DrawStyle := DT_END_ELLIPSIS or DT_EXPANDTABS ;//DT_SINGLELINE;// or DT_CENTER;
textrect:=rc;
if (ImgList<>0) and (imgindex<>-1) then dec(textrect.right,-(2+w));
if Length(Text)>0 then
TNT_DrawTextw(acanvas.Handle,Text,textrect,DrawStyle or DT_CALCRECT or DT_NOCLIP)
// DrawText(acanvas.Handle,PChar(Text),Length(Text),textrect,DrawStyle or DT_CALCRECT or DT_NOCLIP)
else textrect.right:=textrect.left;
offsetrect(imgrect,rc.left,rc.top);
case talign of
DT_CENTER :
margin:=(rc.right-rc.left-w-(textrect.right-textrect.left)) div 2;
DT_Left :
margin:=3;
DT_right :
margin:=(rc.right-rc.left-w-(textrect.right-textrect.left))-2;
end;
if margin<2 then margin:=1;
offsetrect(imgrect,margin,(rc.bottom-rc.top-w) div 2);
OffsetRect(textrect,margin+w,
((rc.Bottom - rc.Top)-(textrect.Bottom-textrect.Top)) div 2);
if (ImgList<>0) and (ImgIndex<>-1) then
ImageList_Draw(imglist,ImgIndex,ACanvas.handle,
imgrect.Left, imgrect.Top,ILD_TRANSPARENT);
if Length(Text)=0 then exit;
SetBkMode(aCanvas.Handle, TRANSPARENT);
ACanvas.Brush.Style := bsClear;
ACanvas.font.style:=[];
if fsd.hasColors[csText] then
ACanvas.Font.Color := fsd.colors[csText];
if not enabled then ACanvas.Font.Color := clBtnShadow;
if textrect.Left<rc.Left then textrect.Left:=rc.Left;
if textrect.right>rc.right then textrect.right:=rc.right;
DrawStyle:=CheckBiDi(DrawStyle);
// DrawText(ACanvas.Handle, PChar(Text),Length(Text),textrect,DrawStyle);
Tnt_DrawTextW(ACanvas.Handle,Text,textrect,DrawStyle);
end;
procedure TSkinHeader.DrawItem(ImgList:hImageList;acanvas:Tcanvas;rc:Trect;index:Integer);
var Item: THDItemW;
Buffer: array[0..200] of Char;
temp:Tbitmap;
text:widestring;
DrawStyle: Longint;
imgindex:integer;
r1:Trect;
i:integer;
begin
FillChar(Item, SizeOf(Item), 0);
FillChar(Buffer, SizeOf(Buffer), 0);
// Item.pszText:=buffer;
Item.pszText:=Pwidechar(@buffer);
Item.cchTextMax:=SizeOf(Buffer);
Item.mask := HDI_TEXT or HDI_FORMAT or HDI_IMAGE;
SendMessage(Hwnd, HDM_GETITEMW, index, Longint(@Item));
i:=1;
if index=indexitem then i:=2;
temp:=GetHMap(rc,fsd.header.map,fsd.header.r,i,
fsd.header.frame,fsd.header.tile);
text:=_Wstr(Item.pszText,-1);
if text<>'' then begin
case (item.fmt and $0ff) of
HDF_CENTER : DrawStyle:=DT_CENTER;
HDF_RIGHT : DrawStyle:=DT_Right;
else DrawStyle:=DT_Left;
end;
r1:=rc;
if item.fmt and (LVCFMT_IMAGE or LVCFMT_COL_HAS_IMAGES)=0 then begin
item.iImage:=-1;
end;
offsetrect(r1,-r1.Left,-r1.Top);
//DrawStyle:= DrawStyle or dt_WordBreak ;
DrawItemImgCaption(temp.canvas,r1,imglist,item.iImage,text,DrawStyle);
end;
BitBlt(acanvas.handle,rc.left ,rc.top,rc.right-rc.left,rc.bottom-rc.top,
temp.Canvas.Handle ,0 ,0 ,Srccopy);
temp.free;
{ DrawText(dc,PChar(Text),Length(Text),r1,DrawStyle or DT_CALCRECT );
case DrawStyle of
DT_CENTER :
OffsetRect(r1,((rc.right-rc.left)-(r1.right-r1.left)) div 2,
((rc.Bottom-rc.Top)-(r1.Bottom-r1.Top)) div 2);
DT_Right :
OffsetRect(r1, ((rc.right-rc.left)-(r1.right-r1.left)-4),
((rc.Bottom - rc.Top) - (r1.Bottom - r1.Top)) div 2);
else OffsetRect(r1, 4,((rc.Bottom - rc.Top) - (r1.Bottom - r1.Top)) div 2);
end;
DrawText(dc, PChar(text), -1, r1, Drawstyle);}
end;
Procedure TSkinListview.InitScrollbar(acontrol:Twincontrol;sd:TSkinData;acanvas:TCanvas;sf:Tcomponent);
var hhwnd:Thandle;
begin
inherited initScrollbar(acontrol,sd,acanvas,sf);
// hhwnd := 0 ;
hhwnd := SendMessage(acontrol.handle, LVM_GETHEADER, 0, 0);
if hhwnd<>0 then begin
header:=Tskinheader.create(self.owner);
header.inithwnd(hhwnd,sd,acanvas,sf);
end;
end;
{function TSkinListview.BeforeProc(var Message: TMessage):boolean;
begin
case message.msg of
WM_Notify: begin
WMNotify(TWMNotify(message));
// if (message.result=CDRF_NOTIFYITEMDRAW) //then result:=false;
// or (message.result=CDRF_SKIPDEFAULT) then result:=false;
end;
else inherited beforeproc(message);
end;
end; }
procedure TSkinListview.WMNotify(var Message: TWMNotify);
var s:string;
begin
s:='';
with Message do
case NMHdr^.code of
// NM_RELEASEDCAPTURE: s:='NM_RELEASEDCAPTURE '+inttostr(NMHdr^.code);
NM_CUSTOMDRAW : begin
s:='NM_CUSTOMDRAW ';
with PNMCustomDraw(NMHdr)^ do begin
case dwDrawStage of
CDDS_PREPAINT: begin
s:=s+'CDDS_PREPAINT ';
Result := CDRF_NOTIFYITEMDRAW ;
end;
CDDS_ITEMPREPAINT : begin
s:=s+'CDDS_ITEMPREPAINT ';
// result:=CDRF_SKIPDEFAULT;
end;
end;
end;
end;
HDN_BEGINDRAG:s:='Header HDN_BEGINDRAG'+inttostr(NMHdr^.code);
HDN_ENDDRAG :s:='Header HDN_ENDDRAG';
HDN_ITEMCLICKW :s:='Header HDN_ITEMCLICKW';
else s:=' WMNotify'+inttostr(NMHdr^.code);
end;
// if s<>'' then skinaddlog(s);
end;
procedure TSkinListview.SetHeaderOwnerDraw;
var
hHeader: THandle;
hdi: THDItem;
i: Integer;
flg: Boolean;
view:TSkinAcListView;
begin
if fsd.header=nil then exit;
if fsd.header.map.empty then exit;
view:=TSkinAcListView(control);
hHeader := SendMessage(hwnd, LVM_GETHEADER, 0, 0);
flg := False;
for i := 1 to view.Columns.Count do begin
hdi.mask := HDI_FORMAT;
Header_GetItem(hHeader, i - 1, hdi);
hdi.mask := HDI_FORMAT;
if hdi.fmt <> HDF_OWNERDRAW then
Flg := True;
hdi.fmt := HDF_OWNERDRAW;
Header_SetItem(hHeader, i - 1, hdi);
end;
end;
procedure TSkinListview.HeaderProc(var Message: TMessage);
begin
case message.msg of
{ WM_DRAWITEM: begin
if (TWMDrawItem(Message).DrawItemStruct^.CtlType = ODT_HEADER) then begin
// DrawHeaderItem(TWMDrawItem(Message).DrawItemStruct^);
// done:=true;
// Message.Result := 0;
end;
end; }
WM_ERASEBKGND:
if (fsd.header<>nil) and (not fsd.header.map.empty) then begin
// ERASEBKGND(message.wparam);
message.result:=1;
done:=true;
end;
{ WM_Paint:
if (fsd.header<>nil) and (not fsd.header.map.empty) then begin
// ERASEBKGND(message.wparam);
Drawheader;
message.result:=0;
done:=true;
end;}
else with message do
Result := CallWindowProc(FDefHeaderProc,hhwnd, Msg, WParam, LParam);
end;
end;
procedure TSkinListview.DrawHeaderItem(DrawItemStruct: TDrawItemStruct);
const LV_MAX_COLS = 255;
var
s,anchor,stripped: string;
ali: DWord;
xsize,ysize: Integer;
vcenter,iCount,ID : Integer;
parr:array[0..LV_MAX_COLS] of Integer;
view:TSkinAcListView;
r1:Trect;
function Min(a,b: Integer):Integer;
begin
if a > b then
Result := b
else
Result := a;
end;
begin
for iCount := 0 to LV_MAX_COLS do
parr[iCount] := iCount;
view:=TSkinAcListView(control);
iCount := view.Columns.count;
SendMessage(Hwnd,LVM_GETCOLUMNORDERARRAY,iCount,longint(@parr));
with DrawItemStruct do begin
if (Integer(itemID) < view.Columns.Count) then begin
s := view.Columns[parr[itemID]].Caption;
fCanvas.Handle := hDC;
fCanvas.Brush.Color:=clwhite;
r1:= rcitem;
// Inflaterect(r1,2,2);
// offsetrect(r1,-1,-1);
// fCanvas.Fillrect(r1);
{ Inflaterect(rcitem,-2,-1);
case Columns[itemID].Alignment of
taLeftJustify:ali := DT_LEFT;
taCenter:ali := DT_CENTER;
taRightJustify:ali := DT_RIGHT;
else
ali := 0;
end;}
end;
end;
end;
procedure TSkinListview.Drawheader;
var dc:HDC ;
rc,r1:TRect;
view:TSkinAcListView;
i,x:integer;
begin
if not GetWindowRect( hhWnd, rc ) then exit;
OffsetRect( rc, -rc.left, -rc.top );
DC := GetWindowDC( hhWnd );
view:=TSkinAcListView(control);
x:=1;
for i:= 0 to view.Columns.count-1 do begin
r1:=rect(x,rc.top,x+view.columns[i].width,rc.bottom);
drawitem(dc,r1,view.columns[i]);
x:=x+view.columns[i].width;
end;
if x<rc.right then begin
r1:=rect(x,rc.top,rc.right,rc.bottom);
drawitem(dc,r1,nil);
end;
ReleaseDC( hhwnd, DC );
end;
procedure TSkinListview.drawitem(dc:HDC; rc:TRect;acolumn:TListColumn);
const
Alignments: array[TAlignment] of Longint = (DT_LEFT, DT_RIGHT, DT_CENTER);
var temp:TBitmap;
FontHeight: Integer;
Flags: Longint;
acolor:Tcolor;
begin
if (rc.right<rc.left) or (rc.bottom<rc.top) then exit;
temp:=GetHMap(rc,fsd.header.map,fsd.header.r,1,
fsd.header.frame,fsd.statusbar.tile);
BitBlt(dc,rc.left ,rc.top,rc.right-rc.left,rc.bottom-rc.top,
temp.Canvas.Handle ,0 ,0 ,Srccopy);
temp.free;
if acolumn=nil then exit;
{ if text='' then exit;
with fCanvas do begin
SetBkMode(Handle, TRANSPARENT);
Font := TAcControl(control).Font;
font.style:=[];
FontHeight := TextHeight('W');
if (fsd.GetPrecolor(acolor,fsd.statusbar.normalcolor)) then
fcanvas.Font.Color:= acolor;
with rc do begin
Top := ((Bottom + Top) - FontHeight) div 2;
Bottom := Top + FontHeight;
// left:=left+fsd.statusbar.r.left;
left:=left+2;
end;
Flags := DT_EXPANDTABS or DT_VCENTER or Alignments[Align];
// Flags := DrawTextBiDiModeFlags(Flags);
DrawText(Handle, PChar(text), -1, rc, Flags);
end;}
end;
function TSkinSizer.BeforeProc(var Message: TMessage):boolean;
begin
result := inherited beforeProc(message);
{ result:=true;
case message.msg of
WM_ERASEBKGND: begin
Message.Result := 0;
result:=false;
end;
else result:=inherited beforeProc(message);
end; }
end;
procedure TSkinSizer.DrawControl( dc:HDC; rc:TRect);
var b1:HBRUSH;
begin
B1:=CreateSolidBrush(fsd.colors[csButtonFace]);
fillRect(dc,rc,b1);
deleteobject(B1);
end;
procedure TSkinTabsheet.DrawControl( dc:HDC; rc:TRect);
var b1:HBRUSH;
begin
B1:=CreateSolidBrush(fsd.colors[csButtonFace]);
fillRect(dc,rc,b1);
deleteobject(B1);
if control<>nil then
TAcWincontrol(control).PaintControls(dc,nil);
end;
function TSkinTabsheet.BeforeProc(var Message: TMessage):boolean;
var r:Trect;
begin
result:=inherited beforeProc(message);
case message.msg of
wm_paint,wm_print:
if kind = 0 then begin
wmpaint(message);
result:=false;
end;
WM_ERASEBKGND:
if kind = 0 then begin
GetClientRect(hwnd,r);
FillRect( message.wparam,r,fsd.BGbrush);
message.Result:=1;
result:=false;
end ;
end;
end;
{Procedure TSkinTabsheet.Init(sf:Tcomponent;sd:TSkinData;acanvas:TCanvas;acolor:boolean=false);
begin
inherited init(sf,sd,acanvas,acolor);
end; }
function TSkinBoxH.BeforeProc(var Message: TMessage):boolean;
var b1:HBRUSH;
dc:HDC;
rc:Trect;
begin
// inherited beforeProc(message);
result:=true;
case message.msg of
WM_ERASEBKGND: begin
dc:=message.WParam;
GetWindowRect( hWnd, rc );
offsetrect(rc,-rc.Left,-rc.Top);
B1:=CreateSolidBrush(fsd.colors[csButtonFace]);
fillRect(dc,rc,b1);
deleteobject(B1);
Message.Result := 0;
result:=false;
end;
WM_CTLCOLORSTATIC:begin
default(message);
message.Result:=fsd.BGBrush;
result:=false;
end;
else result:=inherited beforeProc(message);
end;
end;
destructor TSkinScControl.Destroy;
begin
if sb<>nil then
sb.free;
sb:=nil;
inherited;
end;
procedure TSkinScControl.InitScrollbar(acontrol:Twincontrol;sd:TSkinData;acanvas:TCanvas;sf:Tcomponent);
begin
fsd:=sd;
skinform:=sf;
control:=acontrol;
hwnd := control.handle;
Twinskinform(skinform).addcontrollist(self);
sb:=TWscrollbar.create(self);
sb.ShowHint := control.ShowHint;
sb.Hint := control.Hint;
sb.attach(self,control,sb_ctl);
if not control.Visible then begin
sb.HideScrollbar;
end;
OldWndProc:= Control.WindowProc;
Control.WindowProc := NewWndProc;
end;
// SBM_SETSCROLLINFO: begin
procedure TSkinScControl.AfterProc(var Message: TMessage);
var s:string;
dwstyle:dword;
begin
case message.msg of
CM_VISIBLECHANGED : begin
if message.wParam=0 then begin
sb.HideScrollbar ;
end else begin
if sb<>nil then sb.SetPosition(hwnd);
end;
end;
WM_WINDOWPOSCHANGED: begin
if sb<>nil then sb.SetPosition(hwnd);
end;
WM_NCPaint:begin
if control<>nil then
hwnd := control.handle;
if sb<>nil then sb.SetPosition(hwnd);
end;
SBM_SETSCROLLINFO:begin
if sb<>nil then sb.Invalidate;
end;
CN_VSCROLL : begin
if sb<>nil then sb.Invalidate;
end;
else inherited Afterproc(message);
end;
end;
procedure TSkinScControl.DrawControl( dc:HDC; rc:TRect);
begin
if (sb<>nil) then sb.Invalidate;
end;
procedure TSkinScControl.Unsubclass;
begin
inherited unsubclass;
if skinstate<>skin_deleted then begin
if sb<>nil then sb.free;
sb:=nil;
end;
end;
{procedure TSkinSceControl.InitScrollbar(acontrol:Twincontrol;ascrollbar:Tcontrol;aType:integer;
sd:TSkinData;sf:Tcomponent);
begin
fsd:=sd;
skinform:=sf;
control:=nil;
scecontrol := ascrollbar;
hwnd:=0;
Twinskinform(skinform).addcontrollist(self);
sb:=TEscrollbar.create(owner);
sb.attach(self,acontrol,ascrollbar,atype);
OldWndProc:= scecontrol.WindowProc;
scecontrol.WindowProc := NewWndProc;
end;
procedure TSkinSceControl.AfterProc(var Message: TMessage);
var s:string;
begin
case message.msg of
wm_Lbuttondown:begin
if sb.fdown then sb.buttonup;
end;
WM_NCPaint:begin
if control<>nil then
hwnd := control.handle;
if sb<>nil then sb.SetPosition;
end;
SBM_SETSCROLLINFO:begin
if sb<>nil then sb.Invalidate;
end;
WM_WINDOWPOSCHANGED : begin
if sb<>nil then sb.SetPosition;
end;
else inherited Afterproc(message);
end;
end;
procedure TSkinSceControl.DrawControl( dc:HDC; rc:TRect);
begin
if sb<>nil then sb.Invalidate;
end;
procedure TSkinSceControl.Unsubclass;
begin
inherited unsubclass;
if assigned(oldwndproc) then begin
if scecontrol<>nil then sceControl.WindowProc := OldWndProc;
oldwndproc:=nil;
end;
if sb<>nil then sb.free;
sb:=nil;
end;}
procedure TSkinObjImage.Init(sf:Tcomponent;sd:TSkinData;acanvas:TCanvas;acolor:boolean=false);
begin
if inited then exit;
fsd:=sd;
skinform:=sf;
fCanvas:=acanvas;
control:=Twincontrol(owner);
hwnd := control.handle;
Twinskinform(skinform).addcontrollist(self);
ChangeImage;
// control.Invalidate;
inited:=true;
skinstate:=skin_active;
end;
procedure TSkinObjImage.ChangeImage;
begin
if kind=1 then SetRzImage
else if kind=2 then SetRzRadio
else if kind=3 then setDevCheck;
end;
procedure TSkinObjImage.SetRzRadio;
var i,n,w,h,x:integer;
temp,bmp,sbmp:Tbitmap;
r1,r2:TRect;
begin
if fsd.Button=nil then exit;
if fsd.button.radiomap.empty then exit;
n:= fsd.button.radioframe;
sbmp:=fsd.button.radiomap;
w:= sbmp.width div n;
h:= sbmp.Height;
temp:=Tbitmap.create;
temp.Width:=w*6;
temp.Height := h;
r1:=rect(0,0,w,h);
temp.Canvas.CopyRect(rect(0,0,w,h),sbmp.Canvas,r1);
temp.Canvas.CopyRect(rect(w*2,0,w*3,h),sbmp.Canvas,r1);
r1:=rect(w,0,2*w,h);
temp.Canvas.CopyRect(rect(w,0,w*2,h),sbmp.Canvas,r1);
temp.Canvas.CopyRect(rect(w*3,0,w*4,h),sbmp.Canvas,r1);
r1:=rect(2*w,0,3*w,h);
temp.Canvas.CopyRect(rect(w*4,0,w*5,h),sbmp.Canvas,r1);
r1:=rect(3*w,0,4*w,h);
temp.Canvas.CopyRect(rect(w*5,0,w*6,h),sbmp.Canvas,r1);
bmp := TBitmap(GetObjProp(control,'CustomGlyphs',TBitmap));
if bmp<>nil then begin
//copybmp(temp,bmp);
bmp.assign(temp);
setproperty(control,'transparentcolor',inttostr(clFuchsia));
setproperty(control,'UseCustomGlyphs','false');
setproperty(control,'UseCustomGlyphs','true');
end;
temp.free;
end;
procedure TSkinObjImage.SetDevCheck;
var i,n,w,h,x:integer;
temp,bmp,sbmp:Tbitmap;
r1,r2:TRect;
obj1:TObject;
begin
if fsd.Button=nil then exit;
if fsd.button.checkmap.empty then exit;
n:= fsd.button.checkframe;
sbmp:=fsd.button.checkmap;
w:= sbmp.width div n;
h:= sbmp.Height;
temp:=Tbitmap.create;
temp.Width:=w*6;
temp.Height := h;
r1:=rect(0,0,w,h);
temp.Canvas.CopyRect(rect(0,0,w,h),sbmp.Canvas,r1);
temp.Canvas.CopyRect(rect(w*3,0,w*4,h),sbmp.Canvas,r1);
r1:=rect(w,0,2*w,h);
temp.Canvas.CopyRect(rect(w,0,w*2,h),sbmp.Canvas,r1);
temp.Canvas.CopyRect(rect(w*4,0,w*5,h),sbmp.Canvas,r1);
if n=5 then begin
r1:=rect(4*w,0,5*w,h);
temp.Canvas.CopyRect(rect(2*w,0,w*3,h),sbmp.Canvas,r1);
temp.Canvas.CopyRect(rect(w*5,0,w*6,h),sbmp.Canvas,r1);
end;
obj1 := GetObjectProp(control,'Properties');
if obj1<>nil then begin
bmp := TBitmap(GetObjProp(obj1,'Glyph',TBitmap));
if bmp<>nil then begin
//copybmp(temp,bmp);
bmp.Assign(temp);
bmp.TransparentColor:= clFuchsia;
bmp.Transparent:=false;
end;
end;
temp.free;
end;
procedure TSkinObjImage.SetRzImage;
var i,n,w,h,x:integer;
temp,bmp:Tbitmap;
r1,r2:TRect;
begin
if fsd.Button=nil then exit;
if fsd.button.checkmap.empty then exit;
n:= fsd.button.checkframe;
w:= fsd.button.checkmap.width div n;
h:= fsd.button.CheckMap.Height;
temp:=Tbitmap.create;
temp.Width:=w*9;
temp.Height := h;
r1:=rect(0,0,w,h);
r2:=rect(0,0,w,h);
temp.Canvas.CopyRect(rect(0,0,w,h),fsd.button.CheckMap.Canvas,r1);
temp.Canvas.CopyRect(rect(w*3,0,w*4,h),fsd.button.CheckMap.Canvas,r1);
r1:=rect(w,0,2*w,h);
temp.Canvas.CopyRect(rect(w,0,w+w,h),fsd.button.CheckMap.Canvas,r1);
temp.Canvas.CopyRect(rect(w*4,0,w*5,h),fsd.button.CheckMap.Canvas,r1);
r1:=rect(2*w,0,3*w,h);
temp.Canvas.CopyRect(rect(6*w,0,7*w,h),fsd.button.CheckMap.Canvas,r1);
r1:=rect(3*w,0,4*w,h);
temp.Canvas.CopyRect(rect(7*w,0,8*w,h),fsd.button.CheckMap.Canvas,r1);
if n=5 then begin
r1:=rect(4*w,0,5*w,h);
temp.Canvas.CopyRect(rect(2*w,0,3*w,h),fsd.button.CheckMap.Canvas,r1);
temp.Canvas.CopyRect(rect(5*w,0,6*w,h),fsd.button.CheckMap.Canvas,r1);
temp.Canvas.CopyRect(rect(8*w,0,9*w,h),fsd.button.CheckMap.Canvas,r1);
end;
bmp := TBitmap(GetObjProp(control,'CustomGlyphs',TBitmap));
if bmp<>nil then begin
//copybmp(temp,bmp);
bmp.assign(temp);
setproperty(control,'transparentcolor',inttostr(clFuchsia));
setproperty(control,'UseCustomGlyphs','false');
setproperty(control,'UseCustomGlyphs','true');
end;
temp.free;
end;
procedure TSkinObjImage.SkinChange;
begin
ChangeImage;
end;
procedure TSkinObjImage.Unsubclass;
var obj1:Tobject;
bmp:Tbitmap;
begin
if kind=1 then
setproperty(control,'UseCustomGlyphs','false');
if kind=2 then
setproperty(control,'UseCustomGlyphs','false');
if kind=3 then begin
obj1 := GetObjectProp(control,'Properties');
if obj1<>nil then begin
bmp := TBitmap(GetObjProp(obj1,'Glyph',TBitmap));
if bmp<>nil then
bmp.Assign(nil);
end;
end;
end;
procedure TSkinAdvPage.Init(sf:Tcomponent;sd:TSkinData;acanvas:TCanvas;acolor:boolean=false);
begin
if inited then exit;
inherited init(sf,sd,acanvas,acolor);
ChangeImage;
// control.Invalidate;
inited:=true;
skinstate:=skin_active;
end;
function TSkinAdvPage.FindScroll:boolean;
var Wnd: THandle;
begin
Wnd := FindWindowEx(hwnd, 0, 'msctls_updown32', nil);
if (Wnd<>0) and (updown=nil) then begin
updown:=Tskinupdown.create(self.owner);
updown.inithwnd(wnd,fsd,fcanvas,skinform);
end;
result:= (GetWindowLong(wnd,GWL_STYLE) and WS_visible)>0;
end;
procedure TSkinAdvPage.ChangeImage;
begin
if kind=4 then setAdvPage;
end;
procedure TSkinAdvPage.SkinChange;
begin
ChangeImage;
end;
procedure TSkinAdvPage.SetAdvPage;
var temp,bmp,sbmp:Tbitmap;
r1,r2:TRect;
begin
if fsd.tab=nil then exit;
r1 := Rect(0,0,100,21);
temp := GetHMap(r1,fsd.tab.map,fsd.tab.r,1,fsd.tab.frame,fsd.tab.trans,0);
bmp := TBitmap(GetObjProp(control,'TabBackGround',TBitmap));
if bmp<>nil then begin
bmp.assign(temp);
end;
temp.free;
temp := GetHMap(r1,fsd.tab.map,fsd.tab.r,2,fsd.tab.frame,fsd.tab.trans,0);
bmp := TBitmap(GetObjProp(control,'TabBackGroundActive',TBitmap));
if bmp<>nil then begin
bmp.assign(temp);
end;
temp.free;
// obj1 := GetObjectProp(control,'Properties');
// if obj1<>nil then begin
end;
procedure TSkinAdvPage.Unsubclass;
var obj1:Tobject;
bmp:Tbitmap;
begin
bmp := TBitmap(GetObjProp(control,'TabBackGround',TBitmap));
if bmp<>nil then bmp.Assign(nil);
bmp := TBitmap(GetObjProp(control,'TabBackGroundActive',TBitmap));
if bmp<>nil then bmp.Assign(nil);
end;
procedure TSkinAdvPage.DrawControl( dc:HDC; rc:TRect);
begin
FindScroll();
end;
function TSkinTabBtn.BeforeProc(var Message: TMessage):boolean;
begin
case message.msg of
wm_paint: begin
wmpaint(message);
result:=false;
end;
else result:=inherited beforeProc(message);
end;
end;
procedure TSkinTabBtn.DrawControl( dc:HDC; rc:TRect);
var i,j,n,m,bw,w,h,x,y,truerect:integer;
rt,r1,r2,r3,r4:Trect;
item: TC_ITEM;
s:string;
b: boolean;
acolor:Tcolor;
TCItemW: TTCItemW;
TCItem: TTCItem;
Buffer: array[0.._maxcaption-1] of Char;
imglist:Himagelist;
bfont,cfont:Hfont;
wnd:Thandle;
ws:widestring;
Drawtemp:Tbitmap;
begin
b:=(fsd.button<>nil) and (not fsd.button.map.empty);
rt:=rc;
enabled:= control.Enabled;
SendMessage( hWnd, TCM_ADJUSTRECT, 0, integer(@RT) );
InflateRect( rt, 4, 4 );
inc(rt.top,1);
r2:=rect(rc.left,rc.top,rc.right,rt.top);
w:=r2.right-r2.left;
h:=r2.bottom-r2.top;
m:= sendmessage(hwnd,TCM_GETITEMCOUNT,0,0);
n:= sendmessage(hwnd,TCM_GETCURFOCUS,0,0);
sendmessage(hwnd,TCM_GETITEMRECT,n,integer(@r1));
imglist:=sendmessage(hwnd,TCM_GETIMAGELIST,0,0);
drawtemp:=Tbitmap.create;
Drawtemp.PixelFormat:= pf24bit;
if b then begin
//tab area
Drawtemp.width:=w;
Drawtemp.height:=h;
fillbg(Drawtemp.canvas.handle,rect(0,0,w,h));
bfont:=sendmessage(hwnd,wm_getfont,0,0);
cfont := selectobject(drawtemp.canvas.handle,bfont);
// drawtemp.Canvas.Font.Assign(Tacwincontrol(control).font);
SetTextColor(Drawtemp.canvas.handle,ColorToRGB(clblack));
for i:= 0 to m-1 do begin
if isunicode then begin
TCItemW.mask := TCIF_IMAGE or TCIF_STATE or TCIF_TEXT ;
TCItemW.pszText := Pwidechar(@buffer);
TCItemW.cchTextMax := _maxcaption;
SendMessage(Hwnd,TCM_GETITEMW, I,Longint(@TCItemW));
ws:=_Wstr(TCItemW.pszText,-1);
end else begin
TCItem.mask := TCIF_IMAGE or TCIF_STATE or TCIF_TEXT ;
TCItem.pszText := Pchar(@buffer);
TCItem.cchTextMax := _maxcaption;
SendMessage(Hwnd,TCM_GETITEM, I,Longint(@TCItem));
ws:=StrToWideStr(buffer);
end;
TrueRect:=sendmessage(hwnd,TCM_GETITEMRECT,i,integer(@r1));
if TrueRect=0 then continue;
offsetrect(r1,0,1);
if i=n then j:=2 else j:=1;
DrawRect2(Drawtemp.canvas.Handle,r1,fsd.Button.Map,fsd.button.r,j,fsd.button.frame,
fsd.button.trans,fsd.button.tile);
if (j=1) and (fsd.button.newnormal) then
SetTextColor(Drawtemp.canvas.handle,ColorToRGB(fsd.button.normalcolor2));
if (j=2) and (fsd.Button.newdown) then
SetTextColor(Drawtemp.canvas.handle,ColorToRGB(fsd.button.downcolor2));
if isunicode then
DrawImgCaption(Drawtemp.canvas,r1,imglist,TCItemW.iImage,ws)
else
DrawImgCaption(Drawtemp.canvas,r1,imglist,TCItem.iImage,ws);
end; //end for
selectobject(drawtemp.canvas.handle,cfont);
BitBlt(dc,r2.left,r2.top,r2.right,r2.bottom,
drawtemp.Canvas.Handle ,0 ,0 ,SrcCopy);
end;
drawtemp.Free;
end;
function GetDisableImg(FOriginal:TBitmap):Tbitmap;
const
ROP_DSPDxax = $00E20746;
var
TmpImage, DDB, MonoBmp: TBitmap;
IWidth, IHeight: Integer;
IRect, ORect: TRect;
I: TButtonState;
DestDC: HDC;
begin
TmpImage := TBitmap.Create;
IWidth := FOriginal.Width;
IHeight := FOriginal.Height;
TmpImage.Width := FOriginal.Width;
TmpImage.Height := FOriginal.Height;
IRect := Rect(0, 0, TmpImage.Width, TmpImage.Height);
TmpImage.Canvas.Brush.Color := clBtnFace;
TmpImage.Palette := CopyPalette(FOriginal.Palette);
MonoBmp := nil;
DDB := nil;
try
MonoBmp := TBitmap.Create;
DDB := TBitmap.Create;
DDB.Assign(FOriginal);
DDB.HandleType := bmDDB;
{ Create a disabled version }
with MonoBmp do
begin
Assign(FOriginal);
HandleType := bmDDB;
Canvas.Brush.Color := clBlack;
Width := IWidth;
if Monochrome then
begin
Canvas.Font.Color := clWhite;
Monochrome := False;
Canvas.Brush.Color := clWhite;
end;
Monochrome := True;
end;
with TmpImage.Canvas do
begin
Brush.Color := clBtnFace;
FillRect(IRect);
Brush.Color := clBtnHighlight;
SetTextColor(Handle, clBlack);
SetBkColor(Handle, clWhite);
BitBlt(Handle, 1, 1, IWidth, IHeight,
MonoBmp.Canvas.Handle, 0, 0, ROP_DSPDxax);
Brush.Color := clBtnShadow;
SetTextColor(Handle, clBlack);
SetBkColor(Handle, clWhite);
BitBlt(Handle, 0, 0, IWidth, IHeight,
MonoBmp.Canvas.Handle, 0, 0, ROP_DSPDxax);
end;
finally
DDB.Free;
MonoBmp.Free;
end;
result := TmpImage;
end;
end.