📄 winskinform.pas
字号:
end;
procedure TWinSkinForm.DeleteSysbtn;
var i:integer;
begin
for i:= 0 to high(SysBtn) do SysBtn[i].free;
setlength(sysbtn,0);
end;
procedure TWinSkinForm.DeleteControl(c:TSkinControl);
var i:integer;
begin
if controllist=nil then exit;
for i:= controllist.count-1 downto 0 do begin
if Controllist.items[i]=c then begin
controllist.delete(i);
break;
end;
end;
end;
procedure TWinSkinForm.DeleteSkinDeleted;
var i:integer;
c:TSkinControl;
begin
for i:= controllist.count-1 downto 0 do begin
c:=TSkinControl(Controllist.items[i]);
if c.skinstate=skin_deleted then begin
controllist.delete(i);
c.free;
end;
end;
end;
procedure TWinSkinForm.DeleteControls;
var i:integer;
c:TSkinControl;
acontrol:Tcontrol;
begin
// for i:= controllist.count-1 to 0 do begin
while controllist.count>0 do begin
c:=TSkinControl(Controllist.items[0]);
if (c.control<>nil) and (c.control is TToolbar) then
Ttoolbar(c.control).OnCustomDrawButton:=nil;
if c.skinstate<>skin_deleted then c.unsubclass;
controllist.delete(0);
c.free;
end;
controllist.clear;
end;
function TWinSkinForm.AddControlList(acontrol:TSkinControl):boolean;
var i:integer;
c:TSkinControl;
b:boolean;
begin
b:=false;
for i:= 0 to controllist.count-1 do begin
c:=TSkinControl(Controllist.items[i]);
if c=acontrol then begin
b:=true;
break;
end;
end;
if not b then controllist.add(acontrol);
result:=b;
end;
procedure TWinSkinForm.CreateCaptionFont;
var
NonClientMetrics: TNonClientMetrics;
begin
If Assigned(CaptionFont) then FreeAndNIL(CaptionFont);
CaptionFont := TFont.Create;
NonClientMetrics.cbSize := SizeOf(NonClientMetrics);
if SystemParametersInfo(SPI_GETNONCLIENTMETRICS, 0, @NonClientMetrics, 0) then
CaptionFont.Handle := CreateFontIndirect(NonClientMetrics.lfCaptionFont);
end;
procedure TWinSkinForm.changemdistyle;
var Style: Longint;
begin
if fform.clienthandle<>0 then begin
Style := GetWindowLong(fform.ClientHandle, GWL_STYLE);
Style := Style and not WS_VSCROLL and not WS_HSCROLL;
SetWindowLong(fform.ClientHandle, GWL_STYLE, Style);
Style := GetWindowLong(fform.ClientHandle, GWL_EXSTYLE);
Style := Style and not WS_EX_CLIENTEDGE;
SetWindowLong(fform.ClientHandle, GWL_EXSTYLE, Style);
SetWindowPos(fform.ClientHandle, 0, 0,0,0,0, SWP_FRAMECHANGED or SWP_NOACTIVATE or
SWP_NOMOVE or SWP_NOSIZE or SWP_NOZORDER);
end;
end;
procedure TWinSkinForm.SetActive(const Value: boolean);
begin
end;
procedure TWinSkinForm.InitTform(afsd:Tskindata;aform:Tform);
begin
fform:=aform;
fform.autoscroll:=false;
if (xcMainMenu in afsd.SkinControls) then begin
OldWndProc:= fform.WindowProc;
fform.WindowProc := NewWndProc;
end;
InitSkin(afsd);
formcolor:=aform.color;
aform.color:= afsd.colors[csButtonFace];
if (xcPopupMenu in afsd.SkinControls) then
InitPopMenu(aForm,true,false);
if (xcMenuitem in afsd.SkinControls) then
InitMainMenu(aForm,true,false);
end;
procedure TWinSkinForm.InitSkin(afsd:Tskindata);
var Exdwstyle:Dword;
r1,r2:Trect;
begin
{ if not (xcMainMenu in afsd.SkinControls) then begin
InitSkin2(afsd);
exit;
end;}
if (FObjectInst=nil) Then begin
fsd:=afsd;
timer:=TTimer.create(self);
timer.Interval:=250;
timer.Ontimer:=Ontimer;
timer.enabled:=false;
// CreateCaptionFont;
sMainMenu := xcMainMenu in fsd.SkinControls;
dwstyle := GetWindowLong( hwnd, GWL_STYLE );
ExdwStyle := GetWindowLong(hwnd, GWL_EXSTYLE);
bidileft := (exdwstyle and WS_EX_LEFTSCROLLBAR)>0;
hsysmenu:=GetSystemMenu(hWnd, FALSE);
geticon(iconbmp);
// caption := 'VCLSkin Demo';//getformcaption(hwnd);
classname:=getwindowclassname(hwnd);
parenthwnd:=GetWindow(hWnd, GW_OWNER);
GetClientRect(hwnd,fClientRect);
getwindowrect(hwnd,r1);
GetClientRect(hwnd,r2);
oldsize:=rect(0,0,r1.right-r1.left-(r2.right-r2.left),
r1.bottom-r1.top-(r2.bottom-r2.top));
formicons:=[];
if ((dwstyle and WS_SYSMENU)>0) or (hsysmenu>0) then
formicons:=formicons+[sbisystem];
if (dwstyle and WS_MINIMIZEBOX)>0 then
formicons:=formicons+[sbimin];
if (dwstyle and WS_MAXIMIZEBOX)>0 then
formicons:=formicons+[sbimax];
createsysmenu;
getwindowstate;
fsizeable := (dwstyle and WS_SIZEBOX)>0;
GetFormstyle;
if (Exdwstyle and ws_ex_mdichild)>0 then begin
formstyle:=sfsMDIChild;
end;
// formborder := sbsDialog;
formborder := sbsSingle;
if ((dwstyle and WS_popup)>0) and
((dwstyle and WS_Caption)<>WS_Caption) then
formborder:=sbsnone
else if ((dwstyle and WS_THICKFRAME)>0) or
// ((ExdwStyle and WS_EX_WINDOWEDGE)>0) or
//( formstyle=sfsMDIChild ) or
((dwstyle and WS_SIZEBOX)>0) then
formborder:=sbsSizeable
else if ((dwstyle and DS_MODALFRAME)>0) then
formborder := sbsDialog;
if pos('.UnicodeClass',classname)>0 then isunicode:=true
else isunicode:=false;
if classname='#32770' then formborder := sbsDialog;
if classname='TMessageForm' then formborder := sbsDialog;
if formstyle=sfsmdiform then begin
menuauto:=fsd.menuUpdate;
subclassMDI;
end;
if (xcMainMenu in afsd.SkinControls) then begin
hmenu:=GetMenu(hWnd);
if (hmenu<>0) and (formstyle<>sfsMDIChild) then begin
menu:=TWinSkinMenu.create(self);
menu.fsd:=fsd;
Menu.sf := self;
MenuHeight := GetSystemMetrics(SM_CYMENU);
//***************
if fform<>nil then menu.menu:= fform.menu;
menu.UpdataBtn;
end;
if ((formstyle<>sfsmdichild) or (not skinmanager.mdimax)) and (windowstate<>swsmin) then
EnableSysbtn(false);
InitSkinData;
end else skinstate := skin_active;
FObjectInst := MakeObjectInstance(WinWndProc);
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 (formstyle=sfsmdichild) and (windowstate=swsmax) and (not skinmanager.mdimax) then
skinmanager.setmdimax(true);
if fform<>nil then
InitControls(fform)
else InitHwndControls;
{$IFDEF test}
SkinAddLog(format('%s skin active %1x',[caption,hwnd]));
{$ENDIF}
InvalidateRect(hwnd, 0,true);
end;
end;
procedure TWinSkinForm.InitSkin2(afsd:Tskindata);
begin
fsd:=afsd;
timer:=TTimer.create(self);
timer.Interval:=250;
timer.Ontimer:=Ontimer;
timer.enabled:=false;
classname:=getwindowclassname(hwnd);
GetFormstyle;
if formstyle=sfsmdiform then
subclassMDI;
InitSkinData;
if fform<>nil then
InitControls(fform)
else InitHwndControls;
// InvalidateRect(hwnd, 0,true);
// Refresh;
// SetWindowPos(hwnd, 0, 0, 0, 0, 0,
// SWP_NOCOPYBITS or SWP_NOACTIVATE or SWP_NOMOVE or SWP_NOSIZE or SWP_NOZORDER);
{$IFDEF test}
SkinAddLog(format('%s skin active %1x',[caption,hwnd]));
{$ENDIF}
end;
procedure TWinSkinForm.EnableSysbtn(b:boolean);
var dwstyle:Dword;
begin
//mdichildmax has all sysbtn
if (formstyle=sfsmdichild) and (skinmanager.mdimax)
and (not b) then exit;
hassysbtn:=b;
dwstyle := GetWindowLong( hwnd, GWL_STYLE );
if b then begin
if sbisystem in formicons then
dwstyle := dwstyle or WS_SYSMENU;
if sbimin in formicons then
dwstyle := dwstyle or WS_MINIMIZEBOX;
if sbimax in formicons then
dwstyle := dwstyle or WS_MAXIMIZEBOX;
if sbicaption in formicons then
dwstyle := dwstyle or WS_CAPTION;
end else begin
{ if (parenthwnd=0) or (formstyle=sfsmdiform) then begin
formicons := formicons + [sbicaption];
dwstyle := dwstyle and ( not WS_CAPTION);
end else begin
dwstyle := dwstyle and (not WS_MINIMIZEBOX);
dwstyle := dwstyle and (not WS_MAXIMIZEBOX);
dwstyle := dwstyle and ( not WS_SYSMENU);
end; }
if (parenthwnd<>0) or (formstyle=sfsmdichild) then begin
dwstyle := dwstyle and (not WS_MINIMIZEBOX);
dwstyle := dwstyle and (not WS_MAXIMIZEBOX);
dwstyle := dwstyle and ( not WS_SYSMENU);
end else begin
formicons := formicons + [sbicaption];
dwstyle := dwstyle and ( not WS_CAPTION);
end;
// {$IFnDEF taskbar}
// {$else}
// {$ENDIF}
end;
SetWindowLong( hwnd, GWL_STYLE, dwstyle );
end;
procedure TWinSkinForm.SubclassMDI;
begin
FMDIObjectInst := MakeObjectInstance(WinMDIProc);
FMDIWndProc := Pointer(GetWindowLong(Clienthwnd,GWL_WNDPROC));
SetWindowLong(Clienthwnd, GWL_WNDPROC,LongInt(FMDIObjectInst));
end;
procedure TWinSkinForm.UnSubclassMDI;
begin
if FMDIObjectInst<>nil then begin
SetWindowLong(Clienthwnd, GWL_WNDPROC,LongInt(FMDIWndProc));
FreeObjectInstance(FMDIObjectInst);
FMDIObjectInst:=nil;
end;
end;
procedure TWinSkinForm.DefaultMDI(Var Msg: TMessage);
begin
msg.result:=CallWindowProc(FMDIWndProc,Clienthwnd,Msg.msg,msg.WParam,msg.LParam);
end;
procedure TWinSkinForm.AddSysMenuitem(acaption:string;action:integer);
var item:Tmenuitem;
begin
Item := TMenuItem.Create(sysmenu);
item.Caption := acaption;
item.Tag:=action;
item.onclick:=dosysmenu;
item.OnDrawItem := DrawMenuItem;
item.OnMeasureItem := MeasureItempop;
item.ImageIndex :=action;
if action=3 then
item.ShortCut := TextToShortCut('Shift+F4');
Sysmenu.Items.Add(item);
end;
procedure TWinSkinForm.CreateSysmenu;
begin
if sysmenu<>nil then begin
sysmenu.free;
sysmenu:=nil;
end;
sysmenu:=Tpopupmenu.create(self);
sysmenu.Tag:=c_skintag;
sysmenu.OwnerDraw := true;
sysmenu.Images:=fsd.bmpmenu;
AddSysMenuitem(' Restore ',0);
if sbimax in formicons then AddSysMenuitem(' Maximize ',1);
if sbimin in formicons then AddSysMenuitem(' Minimize ',2);
AddSysMenuitem('-',100);
AddSysMenuitem(' Close ',3);
end;
procedure TWinSkinForm.ResizeForm(i:integer);
var w,h,minwidth,w2:integer;
r1,r2,r3:Trect;
fdc:HDC;
acanvas:TCanvas;
hctrl,temp : Thandle;
p:Tpoint;
begin
if windowstate<>swsmax then begin
GetWindowRect(hwnd,r2);
w:=fClientRect.right+bw.left+bw.right;
if i=0 then begin
if fform<>nil then begin
fClientRect.bottom:=r2.bottom-r2.top-menuheight-GetSystemMetrics(SM_CYFRAME)*2-GetSystemMetrics(SM_CYCAPTION);
W := fform.clientWidth + Bw.Left + bw.right;
//fClientRect.bottom:=fform.ClientHeight;
//fClientRect.right:=fform.ClientWidth;
end;
h:=fClientRect.bottom+bw.top+bw.bottom+menuheight;
end else begin
GetClientRect(hwnd,fClientRect);
h:=fClientRect.bottom+bw.top+bw.bottom + menuheight;
end;
if ((classname='TMessageForm') or (classname='#32770'))
and (i=0) then begin
caption := getformcaption(hwnd);
FDC := GetWindowDC(hwnd);
acanvas:=Tcanvas.create;;
acanvas.Handle := fdc;
acanvas.font := CaptionFont;
charwidth := acanvas.Textwidth(caption);
acanvas.free;
ReleaseDc(hwnd,fdc);
// minwidth := (length(caption))*charwidth+bw.Left+bw.Right+
// fsd.title.r.left+fsd.title.r.right;
// +fsd.title.backleft+fsd.title.backright;
minwidth := charwidth+fsd.title.r.left+fsd.title.r.right;
if w<minwidth then begin
w2:=(minwidth-w) div 2;
hCtrl := GetTopWindow( hWnd );
while ( hCtrl<>0 ) do begin
temp := GetNextWindow( hCtrl, GW_HWNDNEXT );
GetWindowRect(hCtrl,r3);
p:=point(r3.Left,r3.Top);
screentoclient(hwnd,p);
SetWindowPos(hCtrl, 0, p.X+w2, p.y,
r3.right-r3.Left,r3.Bottom-r3.Top,
SWP_NOSENDCHANGING or SWP_NOOWNERZORDER );
hCtrl := temp ;
end;
w:=minwidth;
end;
end;
SetWindowPos(hwnd, 0, r2.left, r2.top, w, h,
SWP_NOMOVE or SWP_DRAWFRAME or SWP_NOZORDER );
// SWP_NOREDRAW or SWP_NOMOVE or SWP_NOZORDER );
end else Refresh;
end;
procedure TWinSkinForm.RePaint(ahwnd:Thandle);
var w,h:integer;
r,r2:Trect;
begin
// GetWindowRect(ahwnd,r2);
// SetWindowPos(ahwnd, 0, r2.left, r2.top, r2.right-r2.left, r2.bottom-r2.top,
// SWP_DRAWFRAME or SWP_NOZORDER or SWP_NOACTIVATE);
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -