Delphi控件源码

开发平台：

Delphi

WinSkinForm.pas：源码内容

Unit WinSkinForm;
{$I Compilers.Inc}
{$IFDEF demo}
{.$define test}
{$ELSE}
{.$define test}
{$ENDIF}
{$WARNINGS OFF}
{$HINTS OFF}
{$RANGECHECKS OFF}
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
ExtCtrls,StdCtrls,ComCtrls,Menus,Buttons,ImgList,grids,commctrl,
WinSkinData,winsubclass,Consts,typinfo;
const
CN_FormUPdate = WM_USER + $3102;
CN_NewForm = WM_USER + $3103;
CN_IsSkined = WM_USER + $3123;
CN_NewMDIChild = WM_USER + $3116;
CN_ReCreateWnd = WM_USER + $3117;
CN_MenuSelect = WM_USER + $3118;
cKey1 = 27969;
cKey2 = 380323;
MAX_CLASSNAME =100;
MAX_MENUITEM_TEXT =64;
Max_MenuitemID=$1000;
c_demo : Array[0..12] of char =
(#$0ca, #$33, #$70, #$30, #$0f1, #$9a,
#$01, #$65, #$0e9, #$32, #$0dc, #$82,#$4f);
type
TWinSkinForm = class;
TWinSkinSpy = class;
NMCSBCUSTOMDRAW = record
hdr : NMHDR;
dwDrawStage :DWORD;
hdc : HDC ;
rc : TRect;
uItem :UINT ;
uState :UINT ;
nBar : UINT ;
end;
pNMCSBCUSTOMDRAW=^NMCSBCUSTOMDRAW;
TNCObject = class(Tobject)
private
public
SF: TWinSkinForm;
fsd : TSkinData;
bounds : Trect;
visible:boolean;
state : integer;
enabled : boolean;
procedure MouseDown; virtual;
procedure MouseUp; virtual;
procedure MouseEnter; virtual;
procedure MouseLeave; virtual;
procedure Draw;virtual;
end;
TMenuBtn = class(TNCObject)
private
public
menuitem: Tmenuitem;
FSD : TSkinData;
index: integer;
caption :widestring;
enabled:boolean;
hsubmenu:Hmenu;
mid: integer;
procedure draw;override;
end;
TWinSysButton = class(TNCObject)
private
public
data : TDataSkinSysButton;
procedure draw;override;
end;
TWinSkinMenu = class(TComponent)
private
procedure Copymenu(source,dst:Hmenu);
public
Buttons: array of TMenuBtn;
menu: Tmainmenu;
Bar : Trect;
FSD : TSkinData;
SF : TWinSkinForm;
bkmap : Tbitmap;
count:integer;
topmenu:boolean;
hmenu:HMenu;
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure UpdataBtn;
procedure UpdataBtn1;
procedure UpdataBtn2(newmenu:Thandle);
procedure UpdataBtn3;
procedure DrawMenu(dc:HDC;rc:TRect);
function FindBtn(p:Tpoint):TNcobject;
procedure MouseMove(p:Tpoint);
procedure SetMenuRect;
end;
TSkinFormStyle = (sfsNormal,sfsMDIform,sfsMDIChild,sfsChild);
TSkinFormBorder = (sbsSizeable,sbsSingle,sbsNone,sbsDialog);
TSkinWindowState = (swsNormal,swsMax,swsMin);
TSkinFormIcon = (sbiMax,sbiMin,sbiHelp,sbisystem,sbicaption);
TSkinFormIcons = set of TSkinFormIcon;
TWinSkinForm = class(TComponent)
private
done,done2 : boolean;
OldWndProc: TWndMethod;
FPrevWndProc: Pointer;
FObjectInst: Pointer;
FMDIWndProc: Pointer;
FMDIObjectInst: Pointer;
CaptionFont: Tfont;
FActive: boolean;
BorderIcons:TBorderIcons;
FOverrideOwnerDraw: boolean;
timer:TTimer;
bstr,astr:widestring;
classname:string;
hassysbtn,menuauto,sMainMenu:boolean;
fClientRect:TRect;
msglock:integer;
poptime : dword;
DoubleTime : integer;
charwidth:integer;
parenthwnd:Thandle;
DefIcon: HIcon;
Iconx : integer;
procedure GetIcon(var bmp:Tbitmap);
procedure DeleteControls;
procedure SetActive(const Value: boolean);
procedure WinWndProc(var aMsg: TMessage);
procedure NewWndProc(var aMsg: TMessage);
procedure Default(Var Msg: TMessage);
procedure WMActive(Var Msg: TMessage);
procedure WMNCCalcSize(Var Msg: TMessage);
procedure WMNCActive(Var Msg: TMessage);
procedure WMNCPaint(Var Msg: TMessage);
procedure WMNCMouseMove(Var Msg: TMessage);
procedure WMNCLButtonDown(var Msg:TMessage);
procedure WMNCLBUTTONDBLCLK(Var Msg: TMessage);
procedure WMNCLButtonUp(var Msg:TMessage);
procedure WMNCRButtonUp(var Msg:TMessage);
procedure WMMouseMove(Var Msg: TMessage);
procedure WMNCHitTest(Var Msg: TMessage);
procedure WMSysCommand(var Msg: Tmessage);
procedure WMCommand(var Msg: Tmessage);
procedure WMINITMENU(hm:Hmenu);
procedure WMMEASUREITEM(var Msg: Tmessage);
procedure WMMEASUREITEMH(var Msg: Tmessage);
procedure WMDRAWITEM(var Msg: Tmessage);
// procedure WMPaint(var Msg: Tmessage);
procedure WMERASEBKGND(var Msg: TMessage);
procedure WMSize(Var Msg: TMessage);
procedure WMGetMinMaxInfo(Var Msg: TMessage);
procedure CMDialogChar(var Message: TMessage);
procedure WMCtlcolor(Var Msg: TMessage);
procedure WMWINDOWPOSCHANGED(Var Msg: TMessage);
procedure WMWindowPosChanging(Var Msg: TMessage);
procedure WMMDIACTIVATE(var aMsg: TMessage);
procedure WMMDIACTIVATE2(Var Msg: TMessage);
procedure WMMDITile(var aMsg: TMessage);
procedure WMReCreateWnd(var Msg: Tmessage);
procedure DrawLine(acanvas:Tcanvas;rc:TRect);
procedure CreateCaptionFont;
procedure Drawborder(n:integer;Rc:Trect;dc:HDC);
procedure SetSysbtnRect;
procedure DrawAllSysbtn(acanvas:Tcanvas;rc:TRect);
procedure DrawMin(dc:HDC);
function SysBtnVisible(i:integer):boolean;
function FindBtn(Point: TPoint): TNcobject;
function GetWinXY(x,y:Smallint):Tpoint;
procedure SysBtnAction(x,y:smallint);
// procedure UpdateNc;
// procedure UpdateNc(Rgn: HRgn=1);
procedure UpdateNc(adc:HDC=0);
procedure DrawFLine(dc:HDC);
procedure ToolBarDrawButton(Sender: TToolBar;
Button: TToolButton; State: TCustomDrawState; var DefaultDraw: Boolean);
procedure ToolBarDrawBackground(Sender: TToolBar; const ARect: TRect; var DefaultDraw: Boolean);
procedure MeasureItemPop(Sender: TObject; ACanvas: TCanvas;
var Width, Height: Integer);
function GetMenuBG:Tbitmap;
procedure DrawMenuCaption(ACanvas: TCanvas; ARect: TRect);
procedure WMDrawMenuitem(var Msg: Tmessage);
procedure WMDrawMenuitemH(var Msg: Tmessage);
procedure DrawHMenuItem2(Amenu:Hmenu;Sender:TObject; ACanvas: TCanvas; ARect: TRect;
Selected: Boolean);
function CreateMenuItem(amenu:Hmenu;aid:integer):Tmenuitem;
procedure DefaultMenuItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect;
Selected: Boolean);
procedure DrawItemText(Item:TMenuitem;ACanvas: TCanvas;
ARect: TRect;Selected:boolean);
procedure DoDrawText(item:Tmenuitem;ACanvas: TCanvas; const ACaption: widestring;
var Rect: TRect; Selected: Boolean; Flags: Longint);
procedure OnTimer(Sender: TObject);
// procedure ClearTempMenu;
procedure CancelMenu;
function FindButtonFromAccel(Accel: Word): TMenuBtn;
procedure CreateSysmenu;
procedure CreateSysmenu2;
procedure DoSysMenu(Sender: TObject);
procedure DoSysMenu2(Sender: TObject);
function IsScrollControl(acontrol:TComponent):boolean;
procedure KeepClient;
procedure SelectMDIform(Sender: TObject);
procedure ChangeMDIStyle;
function Lookupcontrol(ahwnd:Thandle):Tskincontrol;
procedure GetWindowstate;
procedure GetFormstyle;
procedure PopSysmenu(p:Tpoint);
procedure MDIChildAction(const action:Integer);
procedure UnSubclassMDI;
procedure SubclassMDI;
procedure WinMDIProc(var aMsg: TMessage);
procedure DefaultMDI(Var Msg: TMessage);
procedure DeleteSkinDeleted;
procedure InitToolbarMenu(Item: TMenuItem;enable:boolean);
procedure DrawIcon(dc:HDC;rc:Trect);
procedure AfterSkin;
procedure DoSkinEdit(aEdit: Twincontrol);
procedure GetBorderSize;
procedure UpdateStyle(b:boolean);
procedure DisableControl(Comp: TControl);
function CheckSysmenu:boolean;
procedure MenuSelect(var Msg:TMessage);
procedure BeginUpdate;
procedure StopUpdate;
procedure InitSkin(afsd:Tskindata);
function GetSysBtnHint(i:integer):string;
protected
caption : widestring;
bw,wTr,ctr,oldsize : TRect;
MenuHeight,BtnCount : integer;
fInMenu,Creating,bidileft :boolean;
fSizeable,fMaxable,fminable:boolean;
isunicode,ismessagebox:boolean;
ischildform:boolean;
// FTempMenu :Tpopupmenu;
// FButtonMenu : Tmenuitem;
backstr:string;
sysmenu:TPopupmenu;
ClientHwnd,NewChildHwnd : Thandle;
hmenu,hsysmenu,tempmenu,activemenu:hmenu;
formcolor:Tcolor;
dwstyle:dword;
RightBtn:integer;
procedure Notification(AComponent: TComponent;
Operation: TOperation); override;
procedure DrawSysbtn(btn:TWinsysButton;i:integer);
procedure ResizeForm(i:integer);
function FindSkinComp(acomp:Tcontrol):boolean;
function FindSkinComp2(ctrl:Twincontrol):boolean;
procedure InitControlA(wForm: TWinControl);
procedure InitChildCtrl(wForm: TWinControl);
function Find3rdControl(aname:string;comp:Twincontrol):boolean;
procedure HintReset();
public
ActiveBtn : TNCObject;
crop: boolean;
WinRgn : THandle;
FForm: TForm;
Hwnd : Thandle;
fCanvas,fcanvas2: TCanvas;
fsd : TSkinData;
menu :TWinSkinMenu;
SysBtn : array of TWinSysButton;
IconBmp:Tbitmap;
CaptionBuf:Tbitmap;
Controllist:Tlist;
fwidth,fheight:integer;
crwidth,crheight:integer;
FWindowActive : boolean;
FormStyle: TSkinFormStyle;
FormBorder: TSkinFormBorder ;
FormIcons: TSkinFormIcons;
Windowstate: TSkinWindowState;
Skinstate:integer;
Activeskincontrol:Tskincontrol;
mode:integer;
formclass:string;
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Refresh;
procedure Minimize;
procedure Maximize;
procedure Restore;
procedure RestoreMDI;
// property Form: TForm read FForm write fform;
procedure UnSubclass;
procedure UnSubclass2;
procedure UnSubclass3;
function CheckMenu(Button: TMenuBtn): Boolean;
function MDIChildMax:boolean;
procedure ClickButton(Button: TMenuBtn);
procedure getClipMap(fbmp:Tbitmap);
procedure doLog(msg:string);
procedure InitPopMenu(wForm: TWinControl; Enable, Update: boolean );
procedure InitMainMenu(wForm: TWinControl; Enable, Update: boolean );
property Active: boolean read FActive write setactive;
procedure SkinChange;
procedure AddSysMenuitem(acaption:string;action:integer);
procedure EnableSysbtn(b:boolean);
procedure Uncropwindow;
procedure Cropwindow;
procedure InitTform(afsd:Tskindata;aform:Tform);
procedure InitControls(wForm: TWinControl);
procedure AddComp(Comp: TControl;wForm: TWinControl);
procedure InitNestform(wForm: Twincontrol);
procedure RePaint(ahwnd:Thandle);
procedure InitSkinData;
procedure UpdateMainMenu;
procedure DeleteSysbtn;
function AddControlList(acontrol:TSkinControl):boolean;
procedure AddControlh(ahwnd :HWND);
procedure InitHwndControls(ahwnd:Thandle);
procedure DeleteControl(c:TSkinControl);
procedure DrawMenuItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect;
Selected: Boolean);
procedure MeasureItem(Sender: TObject; ACanvas: TCanvas;
var Width, Height: Integer);
procedure InitDlg(afsd:Tskindata);
published
end;
TWinSkinSpy = class(TComponent)
protected
procedure Notification(AComponent: TComponent;
Operation: TOperation); override;
public
sf:TWinskinform;
destructor Destroy; override;
end;
procedure Bitmapdraw(DC:HDC;Dst:Trect;Bmp:TBitmap);
procedure DrawBGbmp(acanvas:Tcanvas;Dst:Trect;Bitmap:TBitmap;SrcRect: TRect);
function BitmapToRegion(bmp: TBitmap; xx,yy:integer;TransparentColor: TColor=clFuchsia;
RedTol: Byte=1; GreenTol: Byte=1; BlueTol: Byte=1): HRGN;
procedure DrawRect1(DC:HDC;Dst:Trect;Bmp:TBitmap;I,N:integer;Trans:integer=0);
procedure DrawRect2(DC:HDC;Dst:Trect;Bmp:TBitmap;Src: TRect;I,N:integer;
Trans:integer=0;Tile:integer=0;Spliter:integer=0);
procedure DrawRect3(DC:HDC;Dst:Trect;Bmp:TBitmap;I,N:integer;Trans:integer=0);
//procedure DrawRectTile(DC:HDC;Dst:Trect;Bmp:TBitmap;Src: TRect;I,N:integer;
// Trans:integer=0;Spliter:integer=1);
procedure DrawRectTile(acanvas:Tcanvas;Dst:Trect;Bmp:TBitmap;Src: TRect;I,N:integer;
Trans:integer=0;Spliter:integer=1);
//procedure DrawTranmap(DC:HDC;Dst:Trect;temp:TBitmap);
procedure DrawTranmap(DC:HDC;Dst:Trect;temp:TBitmap;transcolor:Tcolor=clFuchsia);
{function TransparentStretchBlt(DstDC: HDC; DstX, DstY, DstW, DstH: Integer;
SrcDC: HDC; SrcX, SrcY, SrcW, SrcH: Integer; MaskDC: HDC; MaskX,
MaskY: Integer): Boolean;}
function GetHMap(Dst:Trect;Bmp:TBitmap;Src:TRect;I,N:integer;
Tile:integer=0;Spliter:integer=0):Tbitmap;
function GetThumbMap(Dst:Trect;Bmp:TBitmap;Src:TRect;I,N:integer;
Tile:integer=0;Spliter:integer=0):Tbitmap;
procedure DrawBorder(Dc:HDC;Dst:Trect;Bmp:TBitmap;Src:TRect;I,N:integer;
Tile:integer=0;Spliter:integer=0);
procedure DrawRectH(DC:HDC;Dst:Trect;Bmp:TBitmap;Src:TRect;I,N:integer;
Tile:integer=0;Spliter:integer=0);
procedure DrawRectV(DC:HDC;Dst:Trect;Bmp:TBitmap;Src:TRect;I,N:integer;
Tile:integer=0;Spliter:integer=0);
function Max(const A, B: Integer): Integer;
function Min(const A, B: Integer): Integer;
function MsgtoStr(aMsg: TMessage):string;
procedure SkinAddLog(msg:string);
function GetWindowClassname(ahwnd:Thandle):string;
function CopyHMenu(amenu:Hmenu):Hmenu;
procedure DeleteHMenu(amenu:Hmenu);
function EnumControl(ahwnd :HWND;lParam: LPARAM):boolean;stdcall;
procedure DrawParentImage( Control: TControl; DC: HDC; InvalidateParent: Boolean = False );
function GetFormCaptionA(ahwnd:Thandle):string;
function GetFormCaption(ahwnd:Thandle):widestring;
function GetFormText(ahwnd:Thandle):string;
//function SBCustomDraw(sb:Tskinscrollbar;PDraw:pNMCSBCUSTOMDRAW):integer;
//procedure SetProperty(control: TObject;aprop,value:string);
var WinVersion : Cardinal;
BG : TBitmap;
Logstring :Tstringlist;
SkinCanLog:boolean;
implementation
//uses winsubclass;
uses WinSkinDlg,winskinmenu;
{$R vclskin.res}
procedure TNCObject.MouseDown;
begin
if (sf.activebtn<>nil) and (sf.activebtn<>self) then
sf.activebtn.mouseleave;
if visible then begin
sf.activebtn:=self;
state:=2;
draw;
end;
end;
procedure TNCObject.MouseUp;
begin
if visible then begin
state:=3;
draw;
end;
end;
procedure TNCObject.MouseEnter;
var b:boolean;
begin
// if not sf.timer.enabled then sf.timer.enabled:=true;
b:=false;
if (sf.activebtn<>nil) then begin
if (sf.activebtn<>self) then begin
sf.activebtn.mouseleave;
b:=true;
end;
end else b:=true;
if b and visible then begin
sf.activebtn:=self;
state:=3;
draw;
end;
end;
procedure TNCObject.MouseLeave;
begin
if visible then begin
sf.activebtn:=nil;
state:=1;
draw;
sf.HintReset();
end;
end;
procedure TNCObject.Draw;
begin
end;
procedure TWinSysButton.Draw;
begin
sf.drawsysbtn(self,state);
end;
procedure TWinSkinMenu.UpdataBtn1;
var i,n:integer;
mi:TMenuItemInfo;
Buffer: array[0..79] of Char;
item:Tmenuitem;
newmenu:Thandle;
begin
newmenu := getmenu(sf.hwnd);
if newmenu<>0 then hmenu := newmenu;
if hmenu = 0 then exit;
if sf.FForm<>nil then begin
if sf.FForm.Menu=nil then exit;
menu:=sf.FForm.Menu;
end;
for i:= 0 to high(Buttons) do Buttons[i].free;
setlength(buttons,menu.Items.Count);
count:=menu.Items.count;
for i:= 0 to menu.Items.Count-1 do begin
item := menu.Items[i];
buttons[i]:=TMenuBtn.create;
buttons[i].fsd:=fsd;
buttons[i].sf:=sf;
buttons[i].index:= i;
buttons[i].visible:= item.visible;
buttons[i].enabled:= item.Enabled;
buttons[i].mid:= item.Command;
// buttons[i].caption:= item.Caption;
buttons[i].caption:=GetStringProp(item,'Caption');
buttons[i].menuitem:= item;
if item.count>0 then
buttons[i].hsubmenu:=item.Handle
else
buttons[i].hsubmenu:=0;
inc(n);
end;
SetMenu(sf.hwnd, 0);
end;
procedure TWinSkinMenu.UpdataBtn;
var i,n,j:integer;
mi:TMenuItemInfo;
Buffer: array[0..79] of Char;
item:Tmenuitem;
newmenu:Thandle;
b:boolean;
begin
b:= (Win32Platform = VER_PLATFORM_WIN32_NT) and (Win32MajorVersion <5);
// b:= b or (winversion >= $80000000);
b:=b or ((Win32MajorVersion=4) and (Win32MinorVersion=0));
if b then begin
updatabtn1;
exit;
end;
newmenu := getmenu(sf.hwnd);
if newmenu<>0 then hmenu := newmenu;
if hmenu = 0 then exit;
if sf.FForm<>nil then begin
if sf.FForm.Menu=nil then exit;
menu:=sf.FForm.Menu;
end;
// fsd.DoDebug('UpdataBtn');
for i:= 0 to high(Buttons) do Buttons[i].free;
count:= GetMenuItemCount(hmenu);
if count<=0 then exit;
setlength(buttons,count);
for i:= 0 to count-1 do begin
mi.cbSize:= sizeof(TMENUITEMINFO);
mi.fMask := MIIM_ID or MIIM_TYPE or MIIM_STATE or MIIM_SUBMENU;
fillchar(buffer,sizeof(buffer),#0);
mi.dwTypeData := Buffer;
Mi.cch := SizeOf(Buffer);
GetMenuItemInfo(hmenu, i, TRUE, mi);
buttons[i]:=TMenuBtn.create;
buttons[i].fsd:=fsd;
buttons[i].sf:=sf;
buttons[i].index:= i;
buttons[i].hsubmenu:=mi.hSubMenu;
buttons[i].enabled:= (mi.fState and MFS_DISABLED)=0;
buttons[i].visible:= true;
buttons[i].mid:=mi.wid;
buttons[i].caption:= buffer;
inc(n);
//fsd.DoDebug(inttostr(mi.wid));
//if (buttons[i].caption='') then begin
Item := menu.FindItem(mi.wID,fkCommand);
if item<>nil then begin
if Assigned(item.Action) then item.Action.Update;
buttons[i].caption:=GetStringProp(item,'Caption');
buttons[i].enabled:= item.Enabled;
buttons[i].menuitem:=item;
if item.count>0 then
buttons[i].hsubmenu:=item.Handle
else
buttons[i].hsubmenu:=0;
end;
//end;
end;
SetMenu(sf.hwnd, 0);
end;
{procedure TWinSkinMenu.UpdataBtn1;
var i,n:integer;
mi:TMenuItemInfo;
Buffer: array[0..79] of Char;
item:Tmenuitem;
newmenu:Thandle;
begin
newmenu := getmenu(sf.hwnd);
if newmenu<>0 then hmenu := newmenu;
if hmenu = 0 then exit;
for i:= 0 to high(Buttons) do Buttons[i].free;
count:= GetMenuItemCount(hmenu);
if count<=0 then exit;
setlength(buttons,count);
for i:= 0 to count-1 do begin
mi.cbSize:= sizeof(TMENUITEMINFO);
mi.fMask := MIIM_ID or MIIM_TYPE or MIIM_STATE or MIIM_SUBMENU;
fillchar(buffer,sizeof(buffer),#0);
mi.dwTypeData := Buffer;
Mi.cch := SizeOf(Buffer);
GetMenuItemInfo(hmenu, i, TRUE, mi);
buttons[i]:=TMenuBtn.create;
buttons[i].fsd:=fsd;
buttons[i].sf:=sf;
buttons[i].index:= i;
buttons[i].hsubmenu:=mi.hSubMenu;
buttons[i].enabled:= (mi.fState and MFS_DISABLED)=0;
buttons[i].visible:= true;
buttons[i].mid:=mi.wid;
buttons[i].caption:= buffer;
inc(n);
if (buttons[i].caption='') and (menu<>nil)
and (i<menu.items.Count) then begin
Item := menu.items[i];
if item<>nil then begin
if Assigned(item.Action) then item.Action.Update;
buttons[i].caption:= item.caption;
buttons[i].enabled:= item.Enabled;
buttons[i].mid:=GetMenuItemID(hmenu,i);
if item.count>0 then
buttons[i].hsubmenu:=item.Handle
else
buttons[i].hsubmenu:=0;
end;
end;
end;
SetMenu(sf.hwnd, 0);
end;}
procedure TWinSkinMenu.UpdataBtn3;
var i,n:integer;
item:Tmenuitem;
newmenu:Thandle;
begin
newmenu := getmenu(sf.hwnd);
if newmenu<>0 then hmenu := newmenu;
for i:= 0 to high(Buttons) do Buttons[i].free;
count:= menu.items.Count;
if count<=0 then exit;
setlength(buttons,count);
for i:= 0 to count-1 do begin
buttons[i]:=TMenuBtn.create;
inc(n);
Item := menu.items[i];
if Assigned(item.Action) then item.Action.Update;
buttons[i].caption:= item.caption;
buttons[i].enabled:= item.Enabled;
buttons[i].visible:= item.visible;
buttons[i].mid:=item.Command;
buttons[i].fsd:=fsd;
buttons[i].sf:=sf;
buttons[i].index:= i;
if item.count>0 then
buttons[i].hsubmenu:=item.Handle
else
buttons[i].hsubmenu:=0;
end;
SetMenu(sf.hwnd, 0);
sf.activebtn:=nil;
end;
procedure TWinSkinMenu.UpdataBtn2(newmenu:Thandle);
var i,n,j:integer;
mi:TMenuItemInfo;
Buffer: array[0..79] of Char;
item:Tmenuitem;
begin
newmenu := getmenu(sf.hwnd);
if newmenu<>0 then hmenu := newmenu;
if hmenu = 0 then exit;
if sf.FForm<>nil then begin
if sf.FForm.Menu=nil then exit;
menu:=sf.FForm.Menu;
end;
// fsd.DoDebug('UpdataBtn2');
for i:= 0 to high(Buttons) do Buttons[i].free;
count:= GetMenuItemCount(hmenu);
if count<=0 then exit;
setlength(buttons,count);
for i:= 0 to count-1 do begin
mi.cbSize:= sizeof(TMENUITEMINFO);
mi.fMask := MIIM_ID or MIIM_TYPE or MIIM_STATE or MIIM_SUBMENU;
fillchar(buffer,sizeof(buffer),#0);
mi.dwTypeData := Buffer;
Mi.cch := SizeOf(Buffer);
GetMenuItemInfo(hmenu, i, TRUE, mi);
buttons[i]:=TMenuBtn.create;
buttons[i].fsd:=fsd;
buttons[i].sf:=sf;
buttons[i].index:= i;
buttons[i].hsubmenu:=mi.hSubMenu;
buttons[i].enabled:= (mi.fState and MFS_DISABLED)=0;
buttons[i].visible:= true;
buttons[i].mid:=mi.wid;
buttons[i].caption:= buffer;
inc(n);
if (buttons[i].caption='') then begin
Item := menu.FindItem(mi.wID,fkCommand);
if item<>nil then begin
if Assigned(item.Action) then item.Action.Update;
buttons[i].caption:= item.caption;
buttons[i].enabled:= item.Enabled;
buttons[i].mid:=item.Command;
if item.count>0 then
buttons[i].hsubmenu:=item.Handle
else
buttons[i].hsubmenu:=0;
end;
end;
end;
SetMenu(sf.hwnd, 0);
SetMenuRect();
end;
{procedure TWinSkinMenu.UpdataBtn;
var i:integer;
mi:TMenuItemInfo;
Buffer: array[0..79] of Char;
begin
hmenu:= getmenu(sf.hwnd);
for i:= 0 to high(Buttons) do Buttons[i].free;
count:= GetMenuItemCount(hmenu);
if count=0 then exit;
setlength(buttons,count);
for i:= 0 to count-1 do begin
buttons[i]:=TMenuBtn.create;
buttons[i].fsd:=fsd;
buttons[i].sf:=sf;
buttons[i].index:= i;
GetMenuString(hmenu,i,buffer,sizeof(buffer),MF_BYPOSITION);
buttons[i].caption:= buffer;
mi.cbSize:= sizeof(TMENUITEMINFO);
// mi.fMask := MIIM_TYPE;
mi.fMask := MIIM_TYPE or MIIM_STATE or MIIM_SUBMENU;
mi.fType := MFT_STRING;
fillchar(buffer,sizeof(buffer),#0);
mi.dwTypeData := Buffer;
Mi.cch := SizeOf(Buffer);
GetMenuItemInfo(hmenu, i, TRUE, mi);
// if mi.ftype=MFT_STRING then begin
buttons[i].caption:= buffer;
buttons[i].hsubmenu:=mi.hSubMenu;
buttons[i].enabled:= (mi.fState and MFS_DISABLED)=0;
buttons[i].visible:= true;
// end;
end;
SetMenu(sf.hwnd, 0);
end;}
procedure TWinSkinMenu.Copymenu(source,dst:Hmenu);
var i,n,aid:integer;
begin
n:= GetMenuItemCount(source);
for i:=0 to n-1 do begin
aid:=GetMenuItemID(source, i);
end;
end;
constructor TWinSkinMenu.Create(AOwner: TComponent);
begin
inherited create(AOwner);
bkmap:=Tbitmap.create;
end;
destructor TWinSkinMenu.Destroy;
var i:integer;
begin
bkmap.free;
for i:= 0 to length(Buttons)-1 do Buttons[i].free;
setlength(Buttons,0);
inherited destroy;
end;
type
TMenuItemAccess = class(TMenuItem);
TACControl = class(TControl);
TACWinControl = class(TWinControl);
TACGrid = class(TCustomGrid);
TACBitmap = class(TBitmap);
procedure TWinSkinMenu.DrawMenu(dc:HDC;rc:TRect);
var i,w,h,x: integer;
r,r1:Trect;
item:Tmenuitem;
btn:Tmenubtn;
rightmargin:integer;
begin
// fsd.DoDebug('DrawMenu');
r1:=rc;
offsetrect(rc,-rc.left,-rc.top);
bg.width:=rc.right;
bg.height:=rc.bottom;
if fsd.menubar=nil then begin
bg.canvas.brush.color:=fsd.colors[csMenuBar];
bg.canvas.fillrect(rc);
x:=6;
end else begin
if sf.FWindowActive then i:=1
else i:=2;
// DrawRect2(acanvas.handle,rc,fsd.menubar.map,fsd.menubar.r,1,2,0,0,1);
if fsd.menubar.tile=1 then
DrawRect2(bg.canvas.handle,rc,fsd.menubar.map,fsd.menubar.r,i,2,0,0,1)
else
DrawRectTile(bg.canvas,rc,fsd.menubar.map,fsd.menubar.r,i,2);
if Menu.IsRightToLeft then
x:=8+fsd.menubar.r.right
else
x:=4+fsd.menubar.r.left;
if x>rc.right then x:=12;
end;
//save bar map;
bar:=r1;
bkmap.assign(bg);
bg.canvas.Font := Screen.MenuFont;
bg.canvas.Font.color:= fsd.colors[csMenuBarText];
bg.canvas.brush.style:= bsclear;
SetBkMode(bg.Canvas.Handle, TRANSPARENT);
topmenu:=true;
if Menu.IsRightToLeft then begin
//bidi righttoleft
x:= rc.Right-x;
if (sf.FormStyle=sfsMDIForm) and sf.MDIChildMax then begin
for i:= 0 to high(sf.sysbtn) do
if (sf.sysbtn[i].data.Visibility=100) and
(not sf.sysbtn[i].data.map.empty) then begin
r:= sf.sysbtn[i].bounds;
if x>(r.Left-5) then x:=(r.Left-5);
end;
end;
for i:= 0 to high(buttons) do begin
btn:=buttons[i];
if not btn.visible then begin
btn.bounds:=rect(0,0,0,0);
continue;
end;
r := r1;
Tnt_DrawTextW(bg.Canvas.Handle, btn.caption,r,DT_Left or DT_CALCRECT or DT_NOCLIP);
w:= r.Right-r.left;
// w:= bg.canvas.TextWidth(btn.caption);
if w>0 then w:=w+10;
r:= rect(x-w,0,x,rc.bottom-1);
if btn.enabled then
bg.canvas.Font.color:= fsd.colors[csMenuBarText]
else
bg.canvas.Font.color:= fsd.colors[csbuttonshadow];
MyDrawCaption(bg.canvas,r,btn.caption,btn.enabled,false);
r:= rect(r1.left+x-w,r1.top,r1.left+x,r1.bottom-1);
btn.bounds:=r;
x:=x-w;
end;
end else begin
//bidi lefttoright
for i:= 0 to high(buttons) do begin
btn:=buttons[i];
if not btn.visible then begin
btn.bounds:=rect(0,0,0,0);
continue;
end;
r := r1;
Tnt_DrawTextW(bg.Canvas.Handle, btn.caption,r,DT_Left or DT_CALCRECT or DT_NOCLIP);
w:= r.Right-r.left;
//w:= bg.canvas.TextWidth(btn.caption);
if w>0 then w:=w+10;
r:= rect(x,0,x+w,rc.bottom-1);
if btn.enabled then
bg.canvas.Font.color:= fsd.colors[csMenuBarText]
else
bg.canvas.Font.color:= fsd.colors[csbuttonshadow];
{ if (item.imageindex<>-1) and (menu.images<>nil) then
MyDrawImgCaption(bg.canvas,r,menu.images,item.imageindex,
item.caption,item.enabled,false)
else}
MyDrawCaption(bg.canvas,r,btn.caption,btn.enabled,false);
r:= rect(r1.left+x,r1.top,r1.left+x+w,r1.bottom-1);
btn.bounds:=r;
x:=x+w;
end;
end;
topmenu:=false;
if (sf.FormStyle=sfsMDIForm) and sf.MDIChildMax then begin
for i:= 0 to high(sf.sysbtn) do
if (sf.sysbtn[i].data.Visibility=100) and
(not sf.sysbtn[i].data.map.empty) then begin
r:= sf.sysbtn[i].bounds;
offsetrect(r,-sf.bw.left,-sf.bw.top);
DrawRect1(bg.canvas.handle,r,
sf.sysbtn[i].data.map,1,sf.sysbtn[i].data.frame,1);
end;
if not skinmanager.mdimax then skinmanager.setmdimax(true);
end;
BitBlt(dc,r1.left,r1.top,rc.right,rc.bottom,
bg.Canvas.Handle ,0 ,0 ,SrcCopy);
end;
procedure TWinSkinMenu.SetMenuRect;
var i,w,h,x: integer;
r,r1:Trect;
item:Tmenuitem;
btn:Tmenubtn;
rc:Trect;
begin
rc:=rect(sf.bw.left,sf.bw.top,
sf.fwidth-sf.bw.right,sf.bw.top+sf.menuheight) ;
r1:=rc;
offsetrect(rc,-rc.left,-rc.top);
if (rc.Right<=0) or (rc.Bottom<=0) then exit;
bg.width:=rc.right;
bg.height:=rc.bottom;
if fsd.menubar=nil then begin
x:=6;
end else begin
if Menu.IsRightToLeft then
x:=8+fsd.menubar.r.right
else
x:=4+fsd.menubar.r.left;
if x>rc.right then x:=12;
end;
bg.canvas.Font := Screen.MenuFont;
if Menu.IsRightToLeft then begin
//bidi righttoleft
x:= rc.Right-x;
for i:= 0 to high(buttons) do begin
btn:=buttons[i];
if not btn.visible then begin
btn.bounds:=rect(0,0,0,0);
continue;
end;
r := r1;
Tnt_DrawTextW(bg.Canvas.Handle, btn.caption,r,DT_Left or DT_CALCRECT or DT_NOCLIP);
w:= r.Right-r.Left;
if w>0 then w:=w+10;
r:= rect(r1.left+x-w,r1.top,r1.left+x,r1.bottom-1);
btn.bounds:=r;
x:=x-w;
end;
end else begin
//bidi lefttoright
for i:= 0 to high(buttons) do begin
btn:=buttons[i];
if not btn.visible then begin
btn.bounds:=rect(0,0,0,0);
continue;
end;
r := r1;
Tnt_DrawTextW(bg.Canvas.Handle, btn.caption,r,DT_Left or DT_CALCRECT or DT_NOCLIP);
w:= r.Right-r.Left;
//w:= bg.canvas.TextWidth(btn.caption);
if w>0 then w:=w+10;
r:= rect(r1.left+x,r1.top,r1.left+x+w,r1.bottom-1);
btn.bounds:=r;
x:=x+w;
end;
end;
end;
procedure TMenuBtn.Draw;
var DC: HDC;
r,r2:Trect;
begin
DC := GetWindowDC(sf.hwnd);
sf.fcanvas.handle:=DC;
// menuitem.OnDrawItem:=nil;
r:=rect(bounds.left,sf.menu.bar.top,bounds.right,sf.menu.bar.bottom);
r2:=r;
offsetrect(r2,-sf.menu.bar.left,-sf.menu.bar.top);
sf.fcanvas.copyrect(r,sf.menu.bkmap.canvas,r2);
if (state=3) or (state=2) then begin
sf.fcanvas.brush.color:=fsd.colors[csButtonHilight];
sf.fcanvas.FrameRect(bounds);
end;
sf.fcanvas.Font := Screen.MenuFont;
sf.fcanvas.Font.style := [];
if enabled then
sf.fcanvas.Font.color:= fsd.colors[csMenuBarText]
else
sf.fcanvas.Font.color:= fsd.colors[csbuttonshadow];
// sf.fcanvas.brush.style:= bsclear;
// SetBkMode(sf.fCanvas.Handle, TRANSPARENT);
r:=bounds;
{ if (menuitem.imageindex<>-1) and (sf.menu.menu.images<>nil) then
MyDrawImgCaption(sf.fcanvas,r,sf.menu.menu.images,menuitem.imageindex,
menuitem.caption,menuitem.enabled,false)
else }
MyDrawCaption(sf.fcanvas,r,caption,enabled,false);
sf.fCanvas.Handle:=0;
ReleaseDC(sf.hwnd, DC);
end;
function TWinSkinMenu.FindBtn(p:Tpoint):TNcobject;
var i:integer;
begin
result:=nil;
for i:=0 to high(Buttons) do begin
if PtInRect(buttons[i].bounds, p) and (buttons[i].caption<>'') then begin
Result := buttons[i];
break;
end;
end;
end;
procedure TWinSkinMenu.MouseMove(p:Tpoint);
var i: integer;
begin
{ i := findbtn(p);
if i<>-1 then begin
buttons[i].mouseenter;
sf.done:=true;
end else
if sf.activebtn<>nil then begin
sf.activebtn.mouseleave;
end;}
end;
//menu hook
var
MenuHook: HHOOK;
InitDone: Boolean = False;
MenuBar : TWinSkinMenu;
Skinform : TWinSkinForm;
MenuButtonIndex: Integer;
LastMenuItem: TMenuItem;
LastMenuItemID: integer;
LastMousePos: TPoint;
StillModal: Boolean;
lastselect:boolean = false;
function ToolMenuGetMsgHook(Code: Integer; WParam: Longint; var Msg: TMsg): Longint; stdcall;
const
RightArrowKey: array[Boolean] of Word = (VK_LEFT, VK_RIGHT);
LeftArrowKey: array[Boolean] of Word = (VK_RIGHT, VK_LEFT);
var
P: TPoint;
Target: TMenuBtn;
Item: Integer;
FindKind: TFindItemKind;
ParentMenu: TMenu;
function FindButton(Forward: Boolean): TMenuBtn;
var
Bar: TWinSkinMenu;
I, J, Count: Integer;
begin
Bar := Skinform.menu; //MenuToolBar;
if Bar <> nil then begin
J := MenuButtonIndex;
I := J;
// Count := Bar.Count;
Count := high(Bar.buttons)+1;
if Forward then begin
if I = Count - 1 then
I := 0
else
Inc(I);
Result := Bar.Buttons[I];
end else begin
if I = 0 then
I := Count - 1
else
Dec(I);
Result := Bar.Buttons[I];
end;
end else Result := nil;
end;
begin
if LastMenuItem <> nil then begin
ParentMenu := LastMenuItem.GetParentMenu;
if ParentMenu <> nil then begin
if ParentMenu.IsRightToLeft then
if Msg.WParam = VK_LEFT then
Msg.WParam := VK_RIGHT
else if Msg.WParam = VK_RIGHT then
Msg.WParam := VK_LEFT;
end;
end;
Result := CallNextHookEx(MenuHook, Code, WParam, Longint(@Msg));
if Result <> 0 then Exit;
if (Code = MSGF_MENU) then begin
Target := nil;
if not InitDone then begin
InitDone := True;
PostMessage(Msg.Hwnd, WM_KEYDOWN, VK_DOWN, 0);
end;
case Msg.Message of
WM_MENUSELECT:
begin
if (HiWord(Msg.WParam) = $FFFF) and (Msg.LParam = 0) then begin
if not StillModal then Skinform.CancelMenu;
Exit;
end else StillModal := False;
FindKind := fkCommand;
if HiWord(Msg.WParam) and MF_POPUP <> 0 then FindKind := fkHandle;
if FindKind = fkHandle then
Item := GetSubMenu(Msg.LParam, LoWord(Msg.WParam))
else
Item := LoWord(Msg.WParam);
if skinform.menu.menu<>nil then
LastMenuItem := Skinform.menu.menu.FindItem(Item, FindKind);
end;
WM_SYSKEYDOWN:
if Msg.WParam = VK_MENU then begin
SkinForm.CancelMenu;
Exit;
end;
WM_KEYDOWN:begin
if Msg.WParam = VK_RETURN then
// Skinform.FMenuResult := True
StillModal := false
else if Msg.WParam = VK_ESCAPE then
StillModal := false
else if (Msg.WParam = VK_RIGHT) then begin
if (LastMenuItem = nil) or (LastMenuItem.Count = 0) then
Target := FindButton(True);
end else if (Msg.WParam = VK_LEFT) then begin
if (LastMenuItem = nil) then
Target := FindButton(False)
else if ((LastMenuItem.Parent.handle=skinform.activemenu)
or (LastMenuItem.handle=skinform.activemenu)) then
Target := FindButton(False);
end else Target := nil;
if Target <> nil then
P := Point(Target.Bounds.left+1,Target.Bounds.top+1);
end;
WM_MOUSEMOVE:
begin
P := Msg.pt;
if (P.X <> LastMousePos.X) or (P.Y <> LastMousePos.Y) then begin
p:= SkinForm.GetWinxy(p.x,p.y);
Target := Tmenubtn(SKinForm.Menu.findbtn(P));
LastMousePos := P;
end;
end;
end;
if (Target <> nil) and (Target is TMenuBtn) and
(Target.Index <> MenuButtonIndex) then begin
StillModal := True;
// SkinForm.FCaptureChangeCancels := False;
// SkinForm.ClickButton(Target);
SkinForm.ClickButton(Target);
lastselect:=true;
// skinform.fsd.DoDebug('do click true '+TMenuBtn(Target).caption)
end;
end;
end;
procedure InitMenuHooks;
begin
StillModal := False;
InitDone := False;
GetCursorPos(LastMousePos);
if MenuHook = 0 then
MenuHook := SetWindowsHookEx(WH_MSGFILTER, @ToolMenuGetMsgHook, 0,
GetCurrentThreadID);
end;
procedure ReleaseMenuHooks;
begin
if MenuHook <> 0 then UnhookWindowsHookEx(MenuHook);
MenuHook := 0;
LastMenuItem := nil;
MenuBar := nil;
MenuButtonIndex := -1;
InitDone := False;
end;
{procedure TWinSkinForm.ClearTempMenu;
var
I: Integer;
Item: TMenuItem;
begin
if (FTempMenu <> nil) and (FButtonMenu<>nil) then begin
for I := FTempMenu.Items.Count - 1 downto 0 do
begin
Item := FTempMenu.Items[I];
FTempMenu.Items.Delete(I);
if item.tag<>c_windowid then
FButtonMenu.Insert(0, Item);
end;
FTempMenu.Free;
FTempMenu := nil;
FButtonMenu := nil;
end;
end;}
procedure TWinSkinForm.ClickButton(Button: TMenuBtn);
var
P: TPoint;
begin
// FCaptureChangeCancels := False;
GetWindowRect(hwnd, WTR);
P := Point(Button.bounds.left+1+wtr.left,
Button.bounds.top+1+wtr.top);
// timer.enabled:=true;
PostMessage(hwnd, WM_NCLBUTTONDOWN, MK_LBUTTON, Longint(PointToSmallPoint(P)));
// PostMessage(hwnd, CN_MenuSelect, 0, Longint(PointToSmallPoint(P)));
end;
procedure TWinSkinForm.MenuSelect(var Msg:TMessage);
var P: TPoint;
btn:TNCobject;
b:boolean;
begin
// if not fwindowactive then exit;
P := GetWinXY(msg.LParamLo,msg.LParamhi);
btn := findbtn(p);
if (btn=nil) and (menu<>nil) then btn := menu.findbtn(p);
b:=false;
if (btn<>nil) and (btn is TMenuBtn) then begin
CheckMenu(TMenuBtn(Btn));
end;
Msg.Result := 0;
Msg.Msg := WM_NULL;
end;
function TWinSkinForm.FindButtonFromAccel(Accel: Word): TMenuBtn;
var
I: Integer;
begin
result:=nil;
if menu=nil then exit;
for I := 0 to high(menu.buttons) do begin
Result :=Menu.Buttons[I];
if Result.Enabled and Result.visible and
IsAccel(Accel, Result.Caption) then
Exit;
end;
Result := nil;
end;
procedure TWinSkinForm.CancelMenu;
begin
if FInMenu then begin
// ReleaseMenuKeyHooks;
// MouseCapture := False;
end;
FInMenu := False;
// FCaptureChangeCancels := False;
end;
procedure TWinSkinForm.SelectMDIform(Sender: TObject);
var s:string;
j:integer;
b:boolean;
WS: TWindowState;
begin
if not Assigned(Application.MainForm) then exit;
s:= Tmenuitem(sender).caption;
s:= StringReplace(s,'&','',[]);
with Application.MainForm do
if (FormStyle = fsMDIForm) and (MDIChildCount>0) then begin
for j:= 0 to MDIChildCount-1 do begin
if MDIChildren[j].caption=s then begin
WS:=Application.MainForm.ActiveMDIChild.WindowState;
// b:=MDIChildren[j].windowstate=wsmaximized;
// MDIChildren[j].show;
SendMessage(ClientHandle,WM_MDIACTIVATE ,MDIChildren[j].handle,0);
MDIChildren[j].windowstate:=ws;
break;
end;
end;
end;
end;
function CopyHMenu(amenu:Hmenu):Hmenu;
var hMenuOurs:Hmenu;
nID: UINT; // The ID of the menu.
uMenuState :UINT ; // The menu state.
hSubMenu: HMENU ; // A submenu.
s:string;
nmenu:integer;
szBuf:array[0..127] of char;
begin
hMenuOurs := CreatePopupMenu;
nmenu :=0;
uMenuState :=GetMenuState(aMenu,nMenu,MF_BYPOSITION);
while uMenustate<>$FFFFFFFF do begin
GetMenuString(aMenu,nMenu, szBuf,sizeof(szBuf),MF_BYPOSITION);
if (LOBYTE(uMenuState) and MF_POPUP)>0 then begin
hSubMenu := GetSubMenu(aMenu,nMenu);
AppendMenu(hMenuOurs,uMenuState,hSubMenu,szBuf);
end else begin
nID := GetMenuItemID(aMenu,nMenu);
AppendMenu(hMenuOurs,uMenuState,nID,szBuf);
end;
inc(nmenu);
uMenuState :=GetMenuState(aMenu,nMenu,MF_BYPOSITION);
end;
result:=hmenuours;
end;
procedure DeleteHMenu(amenu:Hmenu);
var b:boolean;
begin
b:=RemoveMenu(amenu,0,MF_BYPOSITION);
while b do
b:=RemoveMenu(amenu,0,MF_BYPOSITION);
DestroyMenu(amenu);
end;
procedure RethinkLines(aitem:Tmenuitem);
var
I, LLastAt: Integer;
LLastBar: TMenuItem;
begin
// for i:= 0 to aitem.Count-1 do
// aitem.Items[i].AutoHotkeys := maAutomatic;
LLastAt := 0;
LLastBar := nil;
with aitem do begin
for I := LLastAt to Count - 1 do
if Items[I].Visible then
if Items[I].IsLine then
begin
Items[I].Visible := False;
end else begin
LLastAt := I;
System.Break;
end;
for I := LLastAt to Count - 1 do
if Items[I].IsLine then
begin
if (LLastBar <> nil) and (LLastBar.Visible) then
begin
LLastBar.Visible := False;
end;
LLastBar := Items[I];
end
else if Items[I].Visible then
begin
if (LLastBar <> nil) and (not LLastBar.Visible) then
begin
LLastBar.Visible := True;
end;
LLastBar := nil;
LLastAt := I;
end;
for I := Count - 1 downto LLastAt do
if Items[I].Visible then
if Items[I].IsLine then
begin
Items[I].Visible := False;
end
else
System.Break;
end;
end;
procedure ActionUpdate(item:Tmenuitem);
var
i: Integer;
a: TMenuItem;
begin
{ for i:= 0 to item.Count-1 do begin
a:=item.Items[i];
if a.Action<>nil then a.Action.Update;
end;}
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;
function GetFormCaptionA(ahwnd:Thandle):string;
var buf:array[0..1000] of char;
begin
sendmessage(ahwnd,WM_GETTEXT,1000,integer(@buf));
result:=strpas(buf);
end;
function GetFormText(ahwnd:Thandle):string;
var s:widestring;
begin
s:= GetFormCaption(ahwnd);
result:=WideStringToStringEx(s);
end;
function TWinSkinForm.CheckMenu(Button: TMenuBtn): Boolean;
var
Hook: Boolean;
I: Integer;
APoint: TPoint;
aflags:integer;
mp:tagTPMPARAMS;
begin
Result := False;
lastselect:=false;
mp.cbSize:=sizeof(mp);
if (button=nil) then Exit;
postmessage(hwnd,wm_command,button.mid,0);
if (Button.hsubmenu=0) then Exit;
if button.menuitem<>nil then begin
// error happen 2006.5.04
// RethinkLines(button.menuitem);
ActionUpdate(button.menuitem);
end;
MenuButtonIndex := Button.Index;
SkinForm := Self;
GetWindowRect(hwnd, WTR);
mp.rcExclude := rect(wtr.Right-5,wtr.Top,GetSystemMetrics(SM_CXMAXIMIZED),wtr.Bottom);
if not ((Win32Platform = VER_PLATFORM_WIN32_NT) and (Win32MajorVersion = 4)) then
wminitmenu(button.hsubmenu);
// skincanlog:=true;
finmenu:=true;
APoint := Point(Button.bounds.left+wtr.left,Button.bounds.bottom+wtr.top);
if bidileft then begin
APoint := Point(Button.bounds.right+wtr.left,Button.bounds.bottom+wtr.top);
Aflags:= TPM_RightALIGN or TPM_RIGHTBUTTON or TPM_NONOTIFY;
end else begin
APoint := Point(Button.bounds.left+wtr.left,Button.bounds.bottom+wtr.top);
Aflags:= TPM_LEFTALIGN or TPM_RIGHTBUTTON or TPM_NONOTIFY;
end;
// SendMessage(hwnd,WM_INITMENUPOPUP,button.hsubmenu,0);
skinmanager.menutype:=m_menuitem;
skinmanager.menuactive:=true;
activemenu:=button.hsubmenu;
InitMenuHooks;
if Button.enabled then begin
// if bidileft then
// TrackPopupMenuex(button.hsubmenu, aflags,APoint.X, APoint.Y,hwnd,@mp)
// else
TrackPopupMenu(button.hsubmenu, aflags,APoint.X, APoint.Y,0,hwnd,nil );
end;
ReleaseMenuHooks;
finmenu:=false;
Result := True;
end;
//fixed by Brian Lowe
procedure TWinSkinForm.CMDialogChar(var Message: TMessage); //TCMDialogChar
var
Button: TMenubtn;
ShiftState: TShiftState;
KeyState: TKeyboardState;
begin
OldWndProc(message);
if message.result<>0 then exit;
GetKeyboardState(KeyState);
ShiftState := KeyboardStateToShiftState(KeyState);
Button := FindButtonFromAccel(TWMKey(Message).CharCode);
if (Button <> nil) and (ShiftState = [ssAlt]) then begin
clickbutton(button);
Message.Result := 1;
done2:=true;
end else begin
//mdiform mainmenu shortcut
if (formstyle=sfsmdichild) then begin
if skinmanager.MDIForm.Perform(CM_DIALOGCHAR,
TWMKey(Message).CharCode,TWMKey(Message).KeyData)<>0 then exit;
end else if (fform<>application.MainForm) and (not (fsModal in fform.FormState)) then begin //has problem
application.MainForm.Perform(CM_DIALOGCHAR,TWMKey(Message).CharCode,TWMKey(Message).KeyData);
end;
message.Result:=0;
// OldWndProc(message);
end;
end;
procedure SetAnimation(Value: Boolean);
var
Info: TAnimationInfo;
begin
Info.cbSize := SizeOf(TAnimationInfo);
BOOL(Info.iMinAnimate) := Value;
SystemParametersInfo(SPI_SETANIMATION, SizeOf(Info), @Info, 0);
end;
constructor TWinSkinForm.Create(AOwner: TComponent);
var i,l:integer;
begin
inherited create(aowner);
bstr:=' ';
SkinCanLog:=true;
poptime := 0;
charwidth := 0;
winrgn := 0;
DoubleTime := GetDoubleClickTime;
// SkinCanLog:=false;
CreateCaptionFont;
fCanvas:= TCanvas.create;
fCanvas2:= TCanvas.create;
// bg:=Tbitmap.create;
controllist:=Tlist.create;
IconBmp:=Tbitmap.create;
CaptionBuf:=Tbitmap.create;
MenuHeight := 0;
msglock:=0;
mode:=0;
activebtn:=nil;
creating:=false;
bidileft:=false;
NewChildHwnd:=0;
fwindowactive:=true;
ActiveBtn:= nil;
skinstate:=skin_Creating;
fform:=nil;
astr:=' ';
{$IFnDEF demo}
astr:=' ';
{$else}
astr:=' Vclskin Demo';
{$ENDIF}
end;
destructor TWinSkinForm.Destroy;
begin
DeleteControls;
DeleteSysbtn;
if not IsBadReadPtr(CaptionBuf, InstanceSize) then CaptionBuf.free;
if timer<>nil then timer.free;
if menu<>nil then begin
menu.free;
menu:=nil;
end;
if sysmenu<>nil then begin
sysmenu.free;
sysmenu:=nil;
end;
CaptionFont.free;
controllist.free;
controllist:=nil;
Iconbmp.free;
if skinmanager<>nil then skinmanager.DeleteForm2(hwnd);
fCanvas.free;
fCanvas2.free;
// skinaddlog('Skinform DESTROY '+caption);
inherited destroy;
end;
// TabSheet := TTabSheet.Create(PageControl1);
// this event happen when owern is form, it is problem
procedure TWinSkinForm.Notification(AComponent: TComponent;Operation: TOperation);
var j:integer;
sc:Tskincontrol;
begin
inherited Notification(AComponent, Operation);
{ if (Operation = opInsert) and (AComponent <> nil) then begin
skinaddlog(format('Notification Insert :%s,%s',[acomponent.classname,acomponent.name]));
end; }
{ if (skinstate<>Skin_Active) or (acomponent.tag=c_skintag) then exit;
if (Operation = opRemove) and (AComponent <> nil) then begin
skinaddlog(format('Notification Remove :%s',[acomponent.classname]));
if (AComponent is TGraphicControl) then begin
for j:= 0 to controllist.count-1 do begin
sc:= Tskincontrol(controllist.items[j]);
if sc.GControl = AComponent then begin
controllist.Delete(j);
sc.free;
break;
end;
end;
end;//Tgraphiccontrol
end else if (Operation = opInsert) and (AComponent <> nil) then begin
// skinaddlog(format('Notification Insert :%s',[acomponent.classname]));
end;}
end;
procedure TWinSkinForm.DeleteSysbtn;
var i:integer;
begin
if high(sysbtn)=0 then exit;
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
// if (Skinstate=skin_Destory) then exit;
while controllist.count>0 do begin
c:=TSkinControl(Controllist.items[0]);
if (c.control<>nil) and (c.control is TToolbar) then begin
Ttoolbar(c.control).OnCustomDrawButton:=nil;
Ttoolbar(c.control).OnCustomDraw:=nil;
end;
if (Skinstate<>skin_Destory) and (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;
if assigned(afsd.OnBeforeSkinForm) then
afsd.OnBeforeSkinForm(fform,hwnd,formclass);
// fform.autoscroll:=false;
if (xcMenuitem in afsd.SkinControls) then
setproperty(fform,'AutoScroll','False');
InitSkin(afsd);
// if (xcMainMenu in afsd.SkinControls) then begin
if sMainMenu then begin //for midchild border
OldWndProc:= fform.WindowProc;
fform.WindowProc := NewWndProc;
end;
formcolor:=aform.color;
aform.color:= afsd.colors[csButtonFace];
// if (xcPopupMenu in afsd.SkinControls) then
// InitPopMenu(aForm,true,false);
if (xcMenuitem in afsd.SkinControls) then begin
InitMainMenu(aForm,true,false);
end;
end;
procedure TWinSkinForm.GetBorderSize;
var r1,r2:Trect;
begin
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));
end;
procedure TWinSkinForm.InitSkin(afsd:Tskindata);
var Exdwstyle:Dword;
r1,r2:Trect;
cw:integer;
begin
if (FObjectInst=nil) Then begin
skinmanager.state:=skin_Active;
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;
ischildform := (dwstyle and ws_child)>0;
// hsysmenu:=GetSystemMenu(hWnd, FALSE);
// geticon(iconbmp);
classname:=getwindowclassname(hwnd);
parenthwnd:=GetWindow(hWnd, GW_OWNER);
// GetBorderSize;
{ 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];
if (ExdwStyle and WS_EX_CONTEXTHELP)>0 then
formicons:=formicons+[sbihelp];
// createsysmenu2;
getwindowstate;
fsizeable := (dwstyle and WS_SIZEBOX)>0;
GetFormstyle;
if (Exdwstyle and ws_ex_mdichild)>0 then begin
formstyle:=sfsMDIChild;
if (xoMDIChildBorder in fsd.Options) then
sMainMenu := false;
end ;//{ else ShowWindow(hwnd,SW_HIDE)};
//MDIchild window menu has problem
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 (ExdwStyle and ws_EX_dlgmodalframe)>0 then
formborder := sbsDialog ;
if ((ExdwStyle and WS_EX_APPWINDOW)>0)
and (Win32Platform = VER_PLATFORM_WIN32_NT)
and (Win32MajorVersion>=5) and (Win32MinorVersion =0) then
formicons := formicons + [sbicaption];
if ((parenthwnd=0) and (formstyle<>sfsmdichild))
and (Win32MajorVersion>=5) and (Win32MinorVersion =0) then
formicons := formicons + [sbicaption];
isunicode:=IsWindowUnicode(hwnd);
ismessagebox:=false;
if (classname='#32770') or (classname='TMessageForm') then begin
formborder := sbsDialog;
ismessagebox:=true;
end;
// lockwindowupdate(hwnd);
StopUpdate;
{$IFDEF demo}
// setproperty(fform,'Caption',' ');
{$endif}
if (winversion >= $80000000) then
fsd.skincontrols:=fsd.skincontrols-[xcSystemMenu];
if formstyle=sfsmdiform then begin
menuauto:=fsd.menuUpdate;
subclassMDI;
end;
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 sMainMenu 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;
cw:= GetSystemMetrics(SM_CYCAPTION)+GetSystemMetrics(SM_CXFRAME);
// if (menuheight=0) and (cw>bw.top) then
if (formstyle=sfsMDIChild) and (cw>bw.top) then
menuheight := cw-bw.Top;
// setmdimax if mainmenu is nil
if (formstyle=sfsmdichild) and (windowstate=swsmax) and (not skinmanager.mdimax) then
skinmanager.setmdimax(true);
{ if fform<>nil then
InitControls(fform)
else InitHwndControls(hwnd);}
{$IFDEF test}
SkinAddLog(format('%s skin active %1x',[caption,hwnd]));
{$ENDIF}
// InvalidateRect(hwnd, 0,true);
end;
end;
{procedure TWinSkinForm.EnableSysbtn(b:boolean);
var exstyle:Dword;
b2:boolean;
begin
if sbicaption in formicons then begin
dwstyle := GetWindowLong( hwnd, GWL_STYLE );
if b then dwstyle := dwstyle or WS_CAPTION
else dwstyle := dwstyle and (not WS_CAPTION);
SetWindowLong( hwnd, GWL_STYLE, dwstyle );
end;
exit;
//mdichildmax has all sysbtn
if (formstyle=sfsmdichild) and (skinmanager.mdimax)
and (not b) then exit;
//embed form unskin, exit
if b and (formstyle<>sfsmdichild) and (ischildform) then exit;
hassysbtn:=b;
dwstyle := GetWindowLong( hwnd, GWL_STYLE );
ExStyle := GetWindowLong(hwnd, GWL_EXSTYLE);
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;
b2:=false;
if ((parenthwnd=0) and (formstyle<>sfsmdichild)) then b2:=true
else if (exstyle and WS_EX_APPWINDOW>0) then b2:=true;
if b2 and (Win32Platform = VER_PLATFORM_WIN32_NT)
and (Win32MajorVersion>=5) and (Win32MinorVersion >= 1) then b2:=false;
if b2 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;
end;
SetWindowLong( hwnd, GWL_STYLE, dwstyle );
end;}
procedure TWinSkinForm.EnableSysbtn(b:boolean);
var exstyle:Dword;
b2:boolean;
begin
exit;
if (formstyle<>sfsmdichild) then exit;
//mdichildmax has all sysbtn
if (skinmanager.mdimax) and (not b) then exit;
hassysbtn:=b;
dwstyle := GetWindowLong( hwnd, GWL_STYLE );
ExStyle := GetWindowLong(hwnd, GWL_EXSTYLE);
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;
end else begin
dwstyle := dwstyle and (not WS_MINIMIZEBOX);
dwstyle := dwstyle and (not WS_MAXIMIZEBOX);
dwstyle := dwstyle and ( not WS_SYSMENU);
end;
SetWindowLong( hwnd, GWL_STYLE, dwstyle );
end;
procedure TWinSkinForm.SubclassMDI;
var MDIunicode:boolean;
begin
MDIunicode:=false;
FMDIObjectInst := MakeObjectInstance(WinMDIProc);
if MDIunicode then begin
FMDIWndProc := Pointer(GetWindowLongw(Clienthwnd,GWL_WNDPROC));
SetWindowLongw(Clienthwnd, GWL_WNDPROC,LongInt(FMDIObjectInst));
end else begin
FMDIWndProc := Pointer(GetWindowLong(Clienthwnd,GWL_WNDPROC));
SetWindowLong(Clienthwnd, GWL_WNDPROC,LongInt(FMDIObjectInst));
end;
end;
procedure TWinSkinForm.UnSubclassMDI;
var MDIunicode:boolean;
begin
if FMDIObjectInst<>nil then begin
MDIunicode:=false;
if MDIunicode then begin
SetWindowLongw(Clienthwnd, GWL_WNDPROC,LongInt(FMDIWndProc));
end else begin
SetWindowLong(Clienthwnd, GWL_WNDPROC,LongInt(FMDIWndProc));
end;
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('ALT+F4');
Sysmenu.Items.Add(item);
end;
procedure TWinSkinForm.CreateSysmenu2;
var i,n,j:integer;
mi:TMenuItemInfo;
Buffer: array[0..79] of Char;
item:Tmenuitem;
s:string;
begin
if sysmenu<>nil then begin
sysmenu.free;
sysmenu:=nil;
end;
if (Win32Platform = VER_PLATFORM_WIN32_NT) and (Win32MajorVersion <5) then begin
CreateSysmenu;
exit;
end;
if hsysmenu = 0 then exit;
n:= GetMenuItemCount(hsysmenu);
sysmenu:=Tpopupmenu.create(self);
sysmenu.Tag:=c_skintag;
sysmenu.OwnerDraw := true;
sysmenu.Images:=fsd.bmpmenu;
for i:= 0 to n-1 do begin
fillchar(mi,sizeof(mi),#0);
mi.cbSize:= sizeof(TMENUITEMINFO);
mi.fMask := MIIM_ID or MIIM_STATE or MIIM_STRING;
mi.fType := 0;
mi.dwTypeData := Buffer;
Mi.cch := SizeOf(Buffer);
GetMenuItemInfo(hsysmenu, i, TRUE, mi);
s:= buffer;
Item := TMenuItem.Create(sysmenu);
if s='' then item.Caption:= '-'
else item.Caption := s;
item.Tag:= mi.wID;
case mi.wID of
SC_MAXIMIZE: begin
item.ImageIndex :=1;
item.enabled:= (windowstate<>swsmax) and (sbimax in formicons);
end;
SC_MINIMIZE: begin
item.ImageIndex :=2;
item.enabled:= (windowstate<>swsmin) and (sbimin in formicons);
end;
Sc_Restore : begin
item.ImageIndex :=0;
item.enabled:= (windowstate<>swsnormal) ;
end;
SC_MOVE,SC_SIZE: begin
item.enabled:= (windowstate<>swsmax) ;
end;
SC_CLOSE : item.ImageIndex :=3;
else item.ImageIndex :=-1;
end;
item.onclick:=dosysmenu2;
if mi.fState=3 then item.Enabled:=false;
if (mi.fState and MFS_CHECKED)>0 then item.Checked:=true;
//item.Enabled := not ((mi.fState and $0ff) = MFS_DISABLED);
item.OnDrawItem := DrawMenuItem;
item.OnMeasureItem := MeasureItempop;
Sysmenu.Items.Add(item);
end;
end;
function TWinSkinForm.CheckSysmenu:boolean;
var i,n,j:integer;
mi:TMenuItemInfo;
Buffer: array[0..79] of Char;
begin
result:=true;
if (Win32Platform = VER_PLATFORM_WIN32_NT) and (Win32MajorVersion <5) then begin
exit;
end;
if winversion >= $80000000 then
exit;
fillchar(mi,sizeof(mi),#0);
mi.cbSize:= sizeof(TMENUITEMINFO);
mi.fMask := MIIM_STATE ;
mi.fType := 0;
mi.dwTypeData := Buffer;
Mi.cch := SizeOf(Buffer);
result:=GetMenuItemInfo(hsysmenu, SC_CLOSE, false, mi);
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;
dw:dword;
begin
dw := SWP_NOMOVE or SWP_DRAWFRAME or SWP_NOZORDER ;
{if SkinState=skin_change then} dw := dw or SWP_NOACTIVATE ;
if windowstate<>swsmax then begin
GetWindowRect(hwnd,r2);
if (ismessagebox) or (SkinState=skin_change) then GetClientRect(hwnd,fClientRect);
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-menuheight;
//GetClientRect(hwnd,fClientRect);
//fClientRect.bottom:=fform.ClientHeight;
//fClientRect.right:=fform.ClientWidth;
if formstyle=sfsMDIChild then fclientrect.Bottom := fclientrect.Bottom+menuheight
end;
h:=fClientRect.bottom+bw.top+bw.bottom+menuheight;
end else begin
GetClientRect(hwnd,fClientRect);
h:=fClientRect.bottom+bw.top+bw.bottom + menuheight;
end;
{$IFDEF VER170} // Delphi 9
//GetClientRect(hwnd,fClientRect);
//h:=fClientRect.bottom+bw.top+bw.bottom+menuheight;
//w:=fClientRect.right+bw.left+bw.right;
{$endif}
if (ismessagebox) 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,dw);
end else begin
SetWindowPos(hwnd, 0, 0, 0, 0, 0, dw or SWP_NOSIZE );
//Refresh;
end;
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);
// getwindowrect(ahwnd,r);
// offsetrect(r,-r.left,-r.top);
// if phwnd<>0 then begin
InvalidateRect(ahwnd, 0,true);
UpdateWindow(ahwnd);
end;
function TWinSkinForm.IsScrollControl(acontrol:TComponent):boolean;
var hwnd:Thandle;
Style:longword;
begin
result:=false;
if not (acontrol is Twincontrol) then exit;
hwnd:=Twincontrol(acontrol).handle;
Style := GetWindowLong( hWnd, GWL_STYLE );
if ((Style and WS_HSCROLL)=0) and
((Style and WS_VSCROLL)=0) then begin
if (acontrol is Tlistbox)
or (acontrol is Tmemo)
// or (acontrol.tag = 55)
// or (acontrol is Tlistview)
or (acontrol is TCustomListBox)
or (acontrol is TCustomTreeView)
// or (acontrol is TCustomGrid)
or (acontrol is Tscrollbox) then
result:=true;
end else result:=true;
end;
procedure TWinSkinForm.InitToolbarMenu(Item: TMenuItem;enable:boolean);
var
a: integer;
procedure Activate(MenuItem: TMenuItem);
begin
if Enable then begin
MenuItem.OnDrawItem := DrawMenuItem;
MenuItem.OnMeasureItem := MeasureItem;
end else MenuItem.OnDrawItem := nil;
end;
begin
Activate(Item);
for a := 0 to Item.Count - 1 do
InitToolbarMenu(Item.Items[a],enable);
end;
procedure TWinSkinForm.InitPopMenu(wForm: TWinControl; Enable, Update: boolean );
var
i, x: integer;
Comp: TComponent;
s:string;
procedure Activate(MenuItem: TMenuItem);
begin
if Enable then begin
if (not assigned(MenuItem.OnDrawItem)) or (FOverrideOwnerDraw) then begin
if sMainMenu then
MenuItem.OnDrawItem := DrawMenuItem;
end;
if not assigned(MenuItem.OnMeasureItem) then
MenuItem.OnMeasureItem := MeasureItem;
end else MenuItem.OnDrawItem := nil;
end;
procedure Activatepop(MenuItem: TMenuItem);
begin
if Enable then begin
// if (not assigned(MenuItem.OnDrawItem)) then begin//or (FOverrideOwnerDraw) then begin
MenuItem.OnDrawItem := DrawMenuItem;
if not assigned(MenuItem.OnMeasureItem) then
MenuItem.OnMeasureItem := MeasureItempop;
// end ;
end else begin
MenuItem.OnDrawItem := nil;
// if MenuItem.OnMeasureItem = MeasureItempop then
MenuItem.OnMeasureItem := nil;
end;
end;
procedure ItrateMenu(MenuItem: TMenuItem);
var
a: integer;
begin
Activate(MenuItem);
for a := 0 to MenuItem.Count - 1 do
ItrateMenu(MenuItem.Items[a]);
end;
procedure ItrateMenupop(MenuItem: TMenuItem);
var
a: integer;
begin
Activatepop(MenuItem);
for a := 0 to MenuItem.Count - 1 do
ItrateMenupop(MenuItem.Items[a]);
end;
begin
s:=fform.ClassName;
if s='TwwRichEditForm' then exit;
for i := 0 to wForm.ComponentCount - 1 do begin
Comp := wForm.Components[i];
if (Comp is TCustomFrame) then InitPopMenu(Twincontrol(comp),Enable, Update);
if (Comp is TCustomForm) then InitPopMenu(Twincontrol(comp),Enable, Update);
if (Comp is TPopupMenu) and
(xcPopupmenu in fsd.SkinControls) and (comp.Tag <> fsd.disabletag)then
begin
TPopupMenu(Comp).OwnerDraw := Enable;
for x := 0 to TPopupMenu(Comp).Items.Count - 1 do
begin
Activatepop(TPopupMenu(Comp).Items[x]);
ItrateMenupop(TPopupMenu(Comp).Items[x]);
end;
end;
end;
end;
procedure TWinSkinForm.InitMainMenu(wForm: TWinControl; Enable, Update: boolean );
var
i, x,j: integer;
Comp: TComponent;
procedure Activate(MenuItem: TMenuItem);
begin
if Enable then begin
if (j>1) and (not assigned(MenuItem.OnDrawItem)) then begin
MenuItem.OnDrawItem := DrawMenuItem;
MenuItem.OnMeasureItem := MeasureItem;
end;
end else begin
MenuItem.OnDrawItem := nil;
MenuItem.OnMeasureItem := nil;
end;
end;
procedure ItrateMenu(MenuItem: TMenuItem);
var
a: integer;
begin
inc(j);
Activate(MenuItem);
for a := 0 to MenuItem.Count - 1 do
ItrateMenu(MenuItem.Items[a]);
dec(j);
end;
begin
for i := 0 to wForm.ComponentCount - 1 do begin
Comp := wForm.Components[i];
if (Comp is TMainMenu) then //and (xcmainmenu in FSkinControls)
// and ((Comp.Tag mod 100)<> fdisabletag)then
begin
TMainMenu(Comp).OwnerDraw := Enable;
for x := 0 to TMainMenu(Comp).Items.Count - 1 do begin
j:=0;
// Activate(TMainMenu(Comp).Items[x]);
ItrateMenu(TMainMenu(Comp).Items[x]);
end;
end;
end;
end;
function TWinSkinForm.FindSkinComp(acomp:Tcontrol):boolean;
var isskin:integer;
aname,name2:string;
i:integer;
sc:Tskincontrol;
begin
if acomp=nil then exit;
result:=true;
{ if acomp is Twincontrol then
isskin:=sendmessage(Twincontrol(acomp).Handle,CN_IsSkined,0,0)
else }
isskin:=acomp.Perform(CN_IsSkined,0,0);
if isskin=1 then exit;
for i:= 0 to controllist.count-1 do begin
sc:= Tskincontrol(controllist.items[i]);
if sc.control=acomp then begin
exit;
end;
end;
result:=false;
end;
{function TWinSkinForm.FindSkinComp(acomp:Tcomponent):boolean;
var i:integer;
sc:Tskincontrol;
aname,name2:string;
begin
result:=false;
aname := fform.Name;
name2 := lowercase(aname);
for i:= 0 to controllist.count-1 do begin
sc:= Tskincontrol(controllist.items[i]);
if sc.GControl <> nil then begin
if sc.gcontrol=acomp then begin
result:=true;
break;
end;
end else if acomp is Twincontrol then begin
if Twincontrol(acomp).HandleAllocated then begin
if sc.hwnd=Twincontrol(acomp).handle then begin
result:=true;
break;
end;
end else begin
if (pos('preview',name2)>0) or
(aname='TQRStandardPreview') or
(aname='TppPrintPreview') or
(aname='TdxfmStdPreview') then begin
result:=true;
end;
break;
end;
end;
end;
end;}
procedure TWinSkinForm.DisableControl(Comp: TControl);
var s:string;
ctrl:Twincontrol;
i:integer;
begin
if not(comp is Twincontrol) then exit;
ctrl:=Twincontrol(comp);
if ctrl.ControlCount=0 then exit;
s:=lowercase(comp.ClassName);
if (pos('radiogroup',s)=0) and (pos('checkgroup',s)=0) then exit;
for i:= 0 to ctrl.controlcount-1 do
ctrl.Controls[i].Tag:=fsd.DisableTag;
end;
procedure TWinSkinForm.AddComp(Comp: TControl;wForm: TWinControl);
var
i, x,j,tag: integer;
subcomp:Twincontrol;
subcontrol:Tcontrol;
skin:TSkinControl;
buf:array[0..100] of char;
s,cname:string;
b:boolean;
chwnd:Thandle;
skincomp: TComponent;
tag2:integer;
// spy:TWinSkinspy;
begin
//tag2:= comp.tag mod 100;
if comp.tag=fsd.disabletag then begin
DisableControl(comp);
exit;
end;
if comp.Parent=nil then exit;
if FindSkinComp(comp) then exit;
cname:=Uppercase(comp.ClassName);
// skinaddlog(format('Add control %s:%s:%1x',[comp.ClassName,comp.name,integer(comp)]));
if (comp is Twincontrol) then begin
chwnd:= TACWinControl(comp).WindowHandle;
if chwnd=0 then
try
chwnd:=TACWinControl(comp).handle;
except
exit;
end;
end;
if Assigned(fsd.OnSkinControl) then begin
skincomp:= NIL;
fsd.OnSkinControl(self, fsd, wForm, comp, cname, skincomp);
if Assigned(skincomp) then begin
if (skincomp is TSkinControl) then begin
skin:= skincomp as TSkinControl;
if skin.newcolor then b:=true
else b:=false;
if not addcontrollist(skin) then begin
skin.init(self,self.fsd,self.fcanvas2,b);
if (Comp is TCustomPanel) then
InitChildCtrl(Comp as TWinControl);
//self.InitControlA(Comp as TWinControl);
end;
///skin.Inithwnd(TWinControl(Comp).Handle, Self.fsd, self.fcanvas2);
end;
exit;
end;
end;
if (Find3rdControl(cname,TWinControl(comp))) then exit;
if (cname='TDBCOMBOBOXEH') then exit;
// if (cname='TQRPREVIEW') then exit;
if (cname='TFRDESIGNERPAGE') then exit;
if (cname='TFRPBOX') then exit;
// not success
if (Comp is TCustomTabControl) and (xcTab in Fsd.SkinControls)
and (fsd.tab<>nil) then begin
if (Comp is TPageControl) then begin
// s:=GetStringProp(comp,'Style');
if Tpagecontrol(comp).style=tsTabs then begin
skin:=TSkinTab.create(comp);
skin.Init(self,self.fsd,self.fcanvas2,false);
end else begin
skin:=TSkinTabBtn.create(comp);
skin.Init(self,self.fsd,self.fcanvas2,false);
end;
end else begin
skin:=TSkinTab.create(comp);
skin.kind:=2;
skin.Init(self,self.fsd,self.fcanvas2,false);
end;
end
else if (Comp is TToolbutton) and sMainMenu then begin
if TToolbutton(comp).MenuItem<>nil then
inittoolbarmenu(TToolbutton(comp).MenuItem,true);
end
else if (Comp is TCoolBar) and (xcToolbar in Fsd.SkinControls) then begin
for i:= 0 to Tcoolbar(comp).Bands.Count-1 do begin
Tcoolbar(comp).Bands[i].Color:=fsd.colors[csButtonFace];
end;
end
else if (cname='TTABSET') and (xcTab in Fsd.SkinControls)
and (fsd.tab<>nil) then begin
// with TSkinTab31.create(comp) do
// init(self,self.fsd,self.fcanvas2);
skin:=TSkinTab31.create(comp);
skin.init(self,self.fsd,self.fcanvas2);
end
else if (Comp is TTabSheet) and (xcTab in Fsd.SkinControls)
and (fsd.tab<>nil) then begin
// with TSkinBox.create(comp) do
// init(self,self.fsd,self.fcanvas2,true);
skin:=TSkinTabSheet.create(comp);
skin.init(self,self.fsd,self.fcanvas2,false);
end
else if (cname='TTABBEDNOTEBOOK') and (xcTab in Fsd.SkinControls)
and (fsd.tab<>nil) then begin
skin:=TSkinTab.create(comp);
skin.Init(self,self.fsd,self.fcanvas2,false);
// TSkinTab(skin).inithwnd(TWinControl(Comp).handle,self.fsd,self.fcanvas2,self);
end
else if (cname='TMVCPANEL') then
InitChildCtrl(Comp as TWinControl)
else if ((Comp is TPageControl) and (xcTab in Fsd.SkinControls))
and (fsd.tab<>nil) then begin
s:=GetStringProp(comp,'Style');
if s='tsTabs' then begin
skin:=TSkinTab.create(self);
skin.Init(self,self.fsd,self.fcanvas2,false);
// TSkinTab(skin).inithwnd(TWinControl(Comp).handle,self.fsd,self.fcanvas2,self);
end else begin
skin:=TSkinTabBtn.create(self);
skin.Init(self,self.fsd,self.fcanvas2,false);
end;
end
else if (comp is THeaderControl) and (xcPanel in Fsd.SkinControls) then begin
with TSkinHeader.create(comp) do
init(self,self.fsd,self.fcanvas2,false);
end
else if ((Comp is TCustomCheckBox) and
(xcCheckBox in Fsd.SkinControls)) then begin
with TSkinCheckBox.create(comp) do
init(self,self.fsd,self.fcanvas2,false);
end
else if ((comp is Ttrackbar) and
(xctrackbar in Fsd.SkinControls)) then begin
with TSkinTrackBar.create(comp) do
init(self,self.fsd,self.fcanvas2);
end
else if (((cname='TUPDOWN') or (cname='TSPINBUTTON')) and
(xcSpin in Fsd.SkinControls)) then begin
with TSkinUpDown.create(comp) do
init(self,self.fsd,self.fcanvas2);
end
else if ((cname='TMEDIAPLAYER') and (xcButton in Fsd.SkinControls)) then begin
with TSkinMP.create(comp) do begin
init(self,self.fsd,self.fcanvas2);
end;
end
else if ((Comp is TCustomRadiogroup))
and (xcRadioButton in Fsd.SkinControls) then begin
for j:= 0 to TWincontrol(comp).ControlCount-1 do begin
subcomp:=Twincontrol(Twincontrol(comp).Controls[j]);
//TAccontrol(subcomp).ParentColor := false;
with TSkinRadioButton.create(subcomp) do
init(self,self.fsd,self.fcanvas2,false);
end;
with TSkinGroupBox.create(comp) do
// with TSkinBox.create(comp) do
init(self,self.fsd,self.fcanvas2,true);
end
else if (cname='TDBNAVIGATOR') and (xcPanel in Fsd.SkinControls) then begin
//setproperty(Comp,'Flat','True');
with TSkinBox.create(comp) do
init(self,self.fsd,self.fcanvas2,true);
for i := 0 to Twincontrol(comp).ControlCount-1 do begin
subcontrol:= Twincontrol(comp).Controls[i];
if subcontrol is Tcontrol then
addcomp(subcontrol,nil);
end;
end
else if ((cname='TRZDBCHECKBOX') or (cname='TRZCHECKBOX')) and
(xccheckbox in Fsd.SkinControls) then begin
with TSkinObjimage.create(comp) do begin
kind:=1;
init(self,self.fsd,self.fcanvas2,true);
end;
end
else if ((cname='TRZRADIOBUTTON') or (cname='TRZDBRADIOBUTTON')) and
(xcradiobutton in Fsd.SkinControls) then begin
with TSkinObjimage.create(comp) do begin
kind:=2;
init(self,self.fsd,self.fcanvas2,true);
end;
end
else if ((cname='TCXDBCHECKBOX') or (cname='TCXCHECKBOX')) and
(xccheckbox in Fsd.SkinControls) then begin
with TSkinObjimage.create(comp) do begin
kind:=3;
init(self,self.fsd,self.fcanvas2,true);
end;
end
else if ((Comp is TcustomGroupbox))
and (xcPanel in Fsd.SkinControls) then begin
self.InitChildCtrl(Comp as TWinControl);
with TSkinGroupbox.create(comp) do
// with TSkinbox.create(comp) do
init(self,self.fsd,self.fcanvas2,false);
end
else if ((Comp is TRadioButton))
and (xcRadioButton in Fsd.SkinControls) then begin
with TSkinRadioButton.create(comp) do begin
init(self,self.fsd,self.fcanvas2,false);
end;
end
{else if (comp is TLabel) then begin
setproperty(Comp,'Transparent','True');
end}
else if (Comp is TToolbar) and (xcToolbar in Fsd.SkinControls) then begin
setproperty(Comp,'Flat','True');
// setproperty(Comp,'Transparent','True');
if (xcToolbar in Fsd.SkinControls) then begin
if not assigned(Ttoolbar(comp).OnCustomDrawButton) then
Ttoolbar(comp).OnCustomDrawButton:=ToolBarDrawButton;
if not assigned(Ttoolbar(comp).OnCustomDraw) then
Ttoolbar(comp).OnCustomDraw:=ToolBarDrawBackground;
with TSkinbox.create(comp) do
// with TSkinToolbar.create(comp) do
init(self,self.fsd,self.fcanvas2,false);
{$ifndef COMPILER_5}
if Ttoolbar(comp).Menu<>nil then
for j:=0 to Ttoolbar(comp).Menu.Items.count-1 do
inittoolbarmenu(TToolbar(comp).Menu.items[j],true);
{$endif}
end;
end
{$ifndef COMPILER_5}
else if ((Comp is TCustomStatusBar) and
(xcStatusBar in Fsd.SkinControls)) then begin
{$else}
else if ((Comp is TStatusBar) and
(xcStatusBar in Fsd.SkinControls)) then begin
{$endif}
//Tstatusbar(comp).sizegrip:=false;
with TSkinStatusBar.create(comp) do begin
init(self,self.fsd,self.fcanvas2,false);
end;
end
else if ((Comp is TProgressBar) and
(xcProgress in Fsd.SkinControls)) then begin
with TSkinProgress.create(comp) do
init(self,self.fsd,self.fcanvas2);
end
else if ((Comp is TScrollbar) and (xcScrollbar in Fsd.SkinControls)) then begin
with TSkinScControl.create(comp) do
initScrollbar(TWinControl(Comp),self.fsd,self.fcanvas2,self);
end
else if (cname='TTNTCOMBOBOX') and (xcCombo in Fsd.SkinControls) then begin
with TSkinCombox.create(comp) do
init(self,self.fsd,self.fcanvas2);
// skin:=TSkinCombox.create(comp);
// skin.inithwnd(TWinControl(Comp).handle,self.fsd,fcanvas2,self);
end
else if (comp is TCustomComboBox) and (xcCombo in Fsd.SkinControls) then begin
with TSkinCombox.create(comp) do
init(self,self.fsd,self.fcanvas2);
end
else if (comp is TDateTimePicker) and
(xcedit in Fsd.SkinControls) then begin
if (TDateTimePicker(comp).DateMode = dmUpDown) or
(TDateTimePicker(comp).kind = dtkTime) then begin
with TSkinEdit.create(comp) do
init(self,self.fsd,self.fcanvas2);
end else begin
// with TSkinCombox.create(comp) do
with TSkinDateTime.create(comp) do
init(self,self.fsd,self.fcanvas2);
end;
end
else if (xcScrollBar in Fsd.SkinControls) AND
((cname='TRICHEDIT')) then begin
with TSkinScrollBar.create(comp) do
initScrollbar(TWinControl(Comp),self.fsd,self.fcanvas2,self);
end
else if (xcScrollBar in Fsd.SkinControls) AND
((cname='TWWDBRICHEDIT') or (cname='TDXDBMEMO')) then begin
with TSkinScrollBar.create(comp) do
initScrollbar(TWinControl(Comp),self.fsd,self.fcanvas2,self);
end
else if (Comp is Tbitbtn) then begin
if (xcbitbtn in Fsd.SkinControls) then begin
with TSkinBitButton.create(comp) do
init(self,self.fsd,self.fcanvas2);
end else exit;
end
else if ((Comp is Tspeedbutton) and
(xcSpeedButton in Fsd.SkinControls)) then begin
with TSkinSpeedButton.create(comp) do
InitGraphicControl(self,self.fsd,self.fcanvas2);
end
else if ((Comp is TCustomPanel))
and (xcPanel in Fsd.SkinControls) then begin
InitChildCtrl(Comp as TWinControl);
with TSkinBox.create(comp) do
init(self,self.fsd,self.fcanvas2,true);
end
else if ((cname='TDXTREELIST') or (cname='TDXDBTREELIST') or
(cname='TDXDBGRID')) and (xcScrollBar in Fsd.SkinControls) then begin
with TSkinScrollBar.create(comp) do
initScrollbar(TWinControl(Comp),self.fsd,self.fcanvas2,self);
end
else if (Comp is TCustomListView)
and (xcScrollBar in Fsd.SkinControls) then begin
with TSkinlistview.create(comp) do
initScrollbar(TWinControl(Comp),self.fsd,self.fcanvas2,self);
end
else if (xcScrollBar in Fsd.SkinControls)
and (Comp is TCustomMemo) then begin
with TSkinScrollBar.create(comp) do
initScrollbar(TWinControl(Comp),self.fsd,self.fcanvas2,self);
end
else if (xcScrollBar in Fsd.SkinControls)
and (Comp is TCustomgrid) then begin
with TSkinScrollBar.create(comp) do
initScrollbar(TWinControl(Comp),self.fsd,self.fcanvas2,self);
end
else if (xcScrollBar in Fsd.SkinControls)
and ( isscrollcontrol(Comp)) then begin
with TSkinScrollBar.create(comp) do
initScrollbar(TWinControl(Comp),self.fsd,self.fcanvas2,self);
end
else if ((Comp is TButton) and (xcButton in Fsd.SkinControls)) then begin
with TSkinButton.create(comp) do
init(self,self.fsd,self.fcanvas2);
end
else if ((Comp is TCustomEdit)) and
(xcedit in Fsd.SkinControls) then begin
skin:=TSkinEdit.create(comp);
skin.init(self,self.fsd,self.fcanvas2,false);
end
else if (cname='TDCEDIT') or (cname='TDCDBEDIT') then begin
i:= GetIntProperty(comp,'NumButtons');
if i=1 then begin
if (xcCombo in Fsd.SkinControls) then begin
with TSkinCombox.create(comp) do
init(self,self.fsd,self.fcanvas2);
end
end else if i=0 then begin
if (xcedit in Fsd.SkinControls) then begin
skin:=TSkinEdit.create(comp);
skin.inithwnd(TWinControl(Comp).handle,self.fsd,fcanvas2,self);
end;
end;
end
else if (Comp is TCustomFrame) then
self.InitControlA(Comp as TWinControl)
// InitChildCtrl(Comp as TWinControl)
else if (Comp is TCustomform) then begin
with TSkinBox.create(comp) do
init(self,self.fsd,self.fcanvas2,true);
self.InitControlA(Comp as TWinControl);
end;
end;
{procedure TWinSkinForm.InitControls(wForm: TWinControl);
var
i, x,j,tag: integer;
Comp: TComponent;
begin
DeleteSkinDeleted;
for i := 0 to wForm.ComponentCount - 1 do begin
Comp := wForm.Components[i];
if comp is Tcontrol then
addcomp(Tcontrol(comp),wform);
end;
end;}
procedure TWinSkinForm.InitControlA(wForm: TWinControl);
var
i: integer;
Comp: TComponent;
begin
for i := 0 to wForm.ComponentCount - 1 do begin
Comp := wForm.Components[i];
if comp is Tcontrol then
addcomp(Tcontrol(comp),wform);
end;
if (xcPopupmenu in fsd.SkinControls) then
InitPopMenu(wform,true,true);
end;
procedure TWinSkinForm.InitChildCtrl(wForm: TWinControl);
var
i: integer;
Ctrl: TControl;
begin
for i := 0 to wForm.controlCount - 1 do begin
Ctrl := wForm.controls[i];
addcomp(ctrl,wform);
end;
end;
procedure TWinSkinForm.InitControls(wForm: TWinControl);
var
i,n: integer;
Ctrl: TWinControl;
Comp: TComponent;
list:Tlist;
s:string;
begin
DeleteSkinDeleted;
{ if xoNoPreview in fsd.Options then begin
s := lowercase(fform.Name);
if (pos('preview',s)>0) then exit;
end; }
InitControlA(wform);
list:=Tlist.create;
wform.GetTabOrderList(list);
for i := 0 to list.Count - 1 do begin
ctrl := list[i];
if not FindSkinComp2(ctrl) then
addcomp(ctrl,wform);
end;
list.Free;
end;
function TWinSkinForm.FindSkinComp2(ctrl:Twincontrol):boolean;
var isskin:integer;
i:integer;
sc:Tskincontrol;
begin
result:=true;
{$ifdef CPPB_5}
exit;
{$endif}
{$ifdef CPPB_6}
exit;
{$endif}
// if ctrl=nil then exit;
// ctrl.HandleNeeded;
if not ctrl.HandleAllocated then exit;
if ctrl.Tag=fsd.DisableTag then exit;
isskin:= sendmessage(ctrl.Handle,CN_IsSkined,0,0);
if isskin=1 then exit;
for i:= 0 to controllist.count-1 do begin
sc:= Tskincontrol(controllist.items[i]);
if sc.hwnd=ctrl.handle then begin
result:=true;
break;
end;
end;
result:=false;
end;
procedure TWinSkinForm.InitNestform(wForm: Twincontrol);
var
i, x,j,tag: integer;
Comp: TComponent;
begin
DeleteSkinDeleted;
with TSkinBox.create(wform) do
init(self,self.fsd,self.fcanvas2,true);
for i := 0 to wForm.ComponentCount - 1 do begin
Comp := wForm.Components[i];
if comp is Tcontrol then
addcomp(Tcontrol(comp),wform);
end;
InitPopMenu(wForm,true,true);
end;
procedure TWinSkinForm.DoSkinEdit(aEdit: Twincontrol);
var r1,r2:Trect;
skin:TSkinControl;
begin
getwindowrect(aedit.handle,r1);
offsetrect(r1,-r1.left,-r1.Top);
getClientrect(aedit.handle,r2);
offsetrect(r2,-r2.left,-r2.Top);
if (r1.Right=r2.Right) and (r1.bottom=r2.Bottom) then exit;
skin:=TSkinEdit.create(aEdit);
skin.init(self,self.fsd,self.fcanvas2);
end;
function TWinSkinForm.Find3rdControl(aname:string;comp:Twincontrol):boolean;
var i,p:integer;
s,s1,s2,s3:string;
subcomp:Twincontrol;
subcontrol:Tcontrol;
skin:TSkinControl;
begin
s1:=lowercase(aname)+'=';
s2:='';
for i:= 0 to fsd.skin3rd.count-1 do begin
s:=lowercase(fsd.Skin3rd[i]);
if (pos(s1,s)=1) then begin
p:=pos('=',s);
s2:=copy(s,p+1,50);
break;
end;
end;
result:=false;
if s2='' then exit;
result:=true;
if (s2='nil') then begin
result:=true;
end
else if (s2='combobox') and (xcCombo in Fsd.SkinControls) then begin
with TSkinCombox.create(comp) do
init(self,self.fsd,self.fcanvas2);
end
else if (s2='comboboxex') and (xcCombo in Fsd.SkinControls) then begin
with TSkinCombox.create(comp) do begin
init(self,self.fsd,self.fcanvas2);
hasbutton:=true;
end;
end
else if (s2='edit') and (xcedit in Fsd.SkinControls) then begin
DoSkinEdit(comp);
// skin:=TSkinEdit.create(comp);
// skin.init(self,self.fsd,self.fcanvas2);
// skin.inithwnd(TWinControl(Comp).handle,self.fsd,fcanvas2,self);
end
else if (s2='radiobutton') and (xcRadioButton in Fsd.SkinControls) then begin
with TSkinRadioButton.create(comp) do begin
init(self,self.fsd,self.fcanvas2,false);
end;
end
else if (s2='panel') and (xcpanel in Fsd.SkinControls) then begin
setproperty(Comp,'Transparent','True');
with TSkinBox.create(comp) do
init(self,self.fsd,self.fcanvas2,true);
end
else if ((s2='trackbar') and (xcbutton in Fsd.SkinControls)) then begin
setproperty(Comp,'Transparent','True');
with TSkinTrackBar.create(comp) do
init(self,self.fsd,self.fcanvas2);
end
else if ((s2='button') and (xcButton in Fsd.SkinControls)) then begin
with TSkinButton.create(comp) do begin
init(self,self.fsd,self.fcanvas2);
end;
end
else if ((s2='datetimepicker') and (xcCombo in Fsd.SkinControls)) then begin
with TSkinDateTime.create(comp) do begin
init(self,self.fsd,self.fcanvas2);
end;
end
else if ((s2='mediaplayer') and (xcButton in Fsd.SkinControls)) then begin
with TSkinMP.create(comp) do begin
init(self,self.fsd,self.fcanvas2);
end;
end
else if ((s2='bitbtn') and (xcButton in Fsd.SkinControls)) then begin
if s1='tcxbutton=' then begin
s3:= GetEnumProperty(comp,'Kind');
if s3='cxbkDropDownButton' then begin
with TSkinMenuButton.create(comp) do begin
init(self,self.fsd,self.fcanvas2);
end;
result:=true;
exit;
end;
end;
with TSkinbitButton.create(comp) do begin
init(self,self.fsd,self.fcanvas2);
end;
end
else if ((s2='pngbitbtn') and (xcButton in Fsd.SkinControls)) then begin
with TSkinbitButton.create(comp) do begin
PicField:='PngImage';
init(self,self.fsd,self.fcanvas2);
end;
end
else if ((s2='pngspeedbutton') and (xcButton in Fsd.SkinControls)) then begin
with TSkinSpeedButton.create(comp) do begin
PicField:='PngImage';
InitGraphicControl(self,self.fsd,self.fcanvas2);
end;
end
else if ((s2='menubtn') and (xcButton in Fsd.SkinControls)) then begin
with TSkinMenuButton.create(comp) do begin
init(self,self.fsd,self.fcanvas2);
end;
end
else if ((s2='speedbutton') and (xcSpeedButton in Fsd.SkinControls)) then begin
with TSkinSpeedButton.create(comp) do
InitGraphicControl(self,self.fsd,self.fcanvas2);
end
else if (s2='tab') and (xcTab in Fsd.SkinControls)
and (fsd.tab<>nil) then begin
skin:=TSkinTab.create(comp);
skin.init(self,self.fsd,self.fcanvas2,false);
// TSkinTab(skin).inithwnd(TWinControl(Comp).handle,self.fsd,self.fcanvas2,self);
end
else if (s2='progress') and (xcprogress in Fsd.SkinControls) then begin
with TSkinProgress.create(comp) do
init(self,self.fsd,self.fcanvas2);
end
else if (s2='scrollbar') and (xcScrollBar in Fsd.SkinControls) then begin
with TSkinScrollBar.create(comp) do
initScrollbar(TWinControl(Comp),self.fsd,self.fcanvas2,self);
InitChildCtrl(Comp as TWinControl);
//InitControlA(Comp as TWinControl);
end
else if (s2='singlescrollbar') and (xcScrollBar in Fsd.SkinControls) then begin
with TSkinScrollBar.create(comp) do begin
kind:=1;
initScrollbar(TWinControl(Comp),self.fsd,self.fcanvas2,self);
end;
end
else if (s2='embedscrollbar') and (xcScrollBar in Fsd.SkinControls) then begin
for i := 0 to TWincontrol(comp).ControlCount-1 do begin
subcomp:=Twincontrol(Twincontrol(comp).Controls[i]);
if subcomp is TScrollbar then begin
with TSkinScControl.create(subcomp) do
initScrollbar(TWinControl(subComp),self.fsd,self.fcanvas2,self);
end else if isscrollcontrol(subComp) then begin
with TSkinScrollBar.create(subcomp) do
initScrollbar(TWinControl(subComp),self.fsd,self.fcanvas2,self);
end;
end;
end
else if (s2='container') then begin
InitChildCtrl(Comp as TWinControl);
{ for i := 0 to TWincontrol(comp).ControlCount-1 do begin
subcontrol:=Twincontrol(comp).Controls[i];
if subcontrol is Tcontrol then
addcomp(subcontrol,nil);
//if subcomp is Twincontrol then
// Find3rdControl(subcomp.classname,subcomp);
end; }
end
else if (s2='groupbox') and (xcgroupbox in Fsd.SkinControls) then begin
with TSkinGroupBox.create(comp) do
init(self,self.fsd,self.fcanvas2,true);
end
else if ((s2='advpagecontrol') ) and (xctab in Fsd.SkinControls) then begin
with TSkinAdvPage.create(comp) do begin
kind:=4;
init(self,self.fsd,self.fcanvas2,true);
end;
end
else if (s2='radiogroup') and (xcgroupbox in Fsd.SkinControls) then begin
if (xcradiobutton in Fsd.SkinControls) then begin
for i:= 0 to TWincontrol(comp).ControlCount-1 do begin
subcomp:=Twincontrol(Twincontrol(comp).Controls[i]);
if pos('TRZ',aname)=0 then begin
with TSkinRadioButton.create(subcomp) do
init(self,self.fsd,self.fcanvas2,false);
end else begin
with TSkinObjimage.create(subcomp) do begin
kind:=2;
init(self,self.fsd,self.fcanvas2,true);
end;
end;
end;
end;
if (xcgroupbox in Fsd.SkinControls) then
with TSkinGroupBox.create(comp) do
init(self,self.fsd,self.fcanvas2,true);
end
else if (s2='checkgroup') and (xcpanel in Fsd.SkinControls) then begin
if (xcradiobutton in Fsd.SkinControls) then begin
for i:= 0 to TWincontrol(comp).ControlCount-1 do begin
subcomp:=Twincontrol(Twincontrol(comp).Controls[i]);
// addcomp(subcomp,fform);
//TAccontrol(subcomp).ParentColor := false;
if pos('TRZ',aname)=0 then begin
with TSkinCheckbox.create(subcomp) do
init(self,self.fsd,self.fcanvas2,false);
end else begin
with TSkinObjimage.create(subcomp) do begin
kind:=1;
init(self,self.fsd,self.fcanvas2,true);
end;
end;
end;
end;
if (xcgroupbox in Fsd.SkinControls) then
with TSkinGroupBox.create(comp) do
// with TSkinBox.create(comp) do
init(self,self.fsd,self.fcanvas2,true);
end
else if (s2='checkbox') AND (xcCheckBox in Fsd.SkinControls) then begin
with TSkinCheckBox.create(comp) do
init(self,self.fsd,self.fcanvas2,false);
end
else exit;
result:=true;
end;
procedure TWinSkinForm.InitHwndControls(ahwnd:Thandle);
var hctrl : Thandle;
begin
hCtrl := GetTopWindow( ahWnd );
while ( hCtrl<>0 ) do begin
if (GetWindowLong(hCtrl, GWL_STYLE ) and WS_CHILD)>0 then begin
AddControlh( hCtrl);
//if (aname='#32770') then InitHwndControls(hctrl);
end;
hCtrl := GetNextWindow( hCtrl, GW_HWNDNEXT );
end;
// EnumChildWindows(hwnd, @enumcontrol, integer(self));
end;
function TWinSkinForm.Lookupcontrol(ahwnd:Thandle):Tskincontrol;
var c:Tskincontrol;
i: integer;
begin
result:=nil;
for i:= 0 to controllist.count-1 do begin
c:=Tskincontrol(controllist[i]);
if c.hwnd=ahwnd then begin
result:=c;
break;
end;
end;
end;
function EnumControl(ahwnd :HWND;lParam: LPARAM):boolean;stdcall;
var s:string;
sf:Twinskinform;
begin
result:=false;
sf:= TWinskinform(lparam);
// if (GetParent(ahwnd)= lparam) then begin
sf.AddControlh( ahwnd);
s:=getwindowclassname(ahwnd);
// skinaddlog(format('***enumchild %1x,%s',[ahwnd,s]));
result:=true;
// end;
end;
procedure TWinSkinForm.AddControlh(ahwnd :HWND);
var Style,dwExStyle:dword;
c:Tskincontrol;
szBuf: array [0..MAX_CLASSNAME] of char;
aname:string;
control:TACwincontrol;
begin
c:= Lookupcontrol( ahWnd );
if ( ahWnd=0 ) or (c<>nil) then exit;
GetClassName( ahwnd, szBuf, MAX_CLASSNAME );
aname:=szbuf;
// skinaddlog(aname);
aname:=lowercase(aname);
Style := GetWindowLong( ahWnd, GWL_STYLE );
dwExStyle := GetWindowLong( ahWnd, GWL_EXSTYLE );
if (aname='button') and ((style and bs_ownerdraw)<>bs_ownerdraw) then begin
if ((style and bs_groupbox)=bs_groupbox)
or ((style and bs_bitmap)=bs_bitmap) then
c:=nil
else
if ((Style and BS_AUTOCHECKBOX )=BS_AUTOCHECKBOX)
or ((Style and BS_CHECKBOX )=BS_CHECKBOX)
or ((Style and BS_3STATE )=BS_3STATE) then begin
// c:=nil
if (xcCheckbox in Fsd.SkinControls) then
c := Tskincheckbox.create(Self)
end else if ((Style and BS_AUTORADIOBUTTON)=BS_AUTORADIOBUTTON)
or ((Style and BS_RADIOBUTTON)=BS_RADIOBUTTON) then begin
if (xcRadioButton in Fsd.SkinControls) then
c := Tskinradiobutton.create(Self);
end else if (xcButton in Fsd.SkinControls) then
c := Tskinbutton.create(Self);
end
else if (aname='combobox') and (xcCombo in Fsd.SkinControls) then begin
if ((Style and $03)<>CBS_SIMPLE) then
c := TSkinCombox.create(Self) ;
end
else if (aname='comboboxex32') and (xcCombo in Fsd.SkinControls) then begin
ahwnd := GetTopWindow( ahWnd );
if ahwnd<>0 then
c := TSkinCombox.create(Self) ;
end
else if (aname='scrollbar') and ((Style and WS_TabStop) =0) then begin
// c := TSkinboxh.create(Self) ;
c := TSkinSizer.create(Self) ;
end
else if (aname='systreeview32') then begin
//syslistview32
// c := TSkinScrollbarH.create(Self) ;
end
else if (aname='#32770') and ((Style and WS_TabStop) =0) then begin
inithwndcontrols(ahwnd);
c := TSkinboxh.create(Self) ;
end
else if (aname='tpanel') or ( aname='ttntpanel.unicodeclass')
or (aname='ttntsilentpaintpanel.unicodeclass') then begin
inithwndcontrols(ahwnd);
control := TACWincontrol(FindControlx(ahwnd));
if control<>nil then
control.color := fsd.colors[csButtonFace];
end
else if (aname='tcheckbox') and (xcCheckbox in Fsd.SkinControls) then begin
c := Tskincheckbox.create(Self);
end
else if (aname='tcombobox') and (xcCombo in Fsd.SkinControls) then begin
c := TSkinCombox.create(Self);
end
else if (aname='tbutton') and (xcButton in Fsd.SkinControls) then begin
c := Tskinbutton.create(Self);
end
else if (aname='tprogressbar') then begin
c := TSkinProgress.create(Self);
end
else if (aname='tsilentpaintpanel') then begin
control := TACWincontrol(FindControlx(ahwnd));
if control<>nil then
control.color := fsd.colors[csButtonFace];
end
else if (aname='systabcontrol32') and (xcTab in Fsd.SkinControls)
and ((Style and TCS_OWNERDRAWFIXED)<>TCS_OWNERDRAWFIXED) then begin
c := TSkinTab.create(Self) ;
end
else if (aname='toolbarwindow32') then begin
c := TSkinboxh.create(Self) ;
end
else if (aname='edit') and (xcEdit in Fsd.SkinControls) then begin
c := TSkinedit.create(Self) ;
end;
if c<>nil then begin
c.inithwnd(ahwnd,fsd,fcanvas2,self);
// controllist.add(c);
// skinaddlog(format('***add control %1x,%s',[ahwnd,aname]));
end;
end;
procedure TWinSkinForm.Refresh;
begin
SetWindowPos(hwnd, 0, 0, 0, 0, 0,
SWP_DRAWFRAME or SWP_NOACTIVATE or SWP_NOMOVE or SWP_NOSIZE or SWP_NOZORDER);
end;
procedure TWinSkinForm.InitSkinData;
var i,cw:integer;
begin
if fsd.empty then exit;
// GetClientRect(hwnd,fClientRect);
if (formborder <> sbsnone) then begin
bw.top:=fsd.border[3].map.height div fsd.border[3].frame;
bw.left:=fsd.border[1].map.width div fsd.border[1].frame;
bw.right:=fsd.border[2].map.width div fsd.border[2].frame;
bw.bottom:=fsd.border[4].map.height div fsd.border[4].frame;
end else begin
bw:= rect(0,0,0,0);
// bw:= rect(2,2,2,2);
MenuHeight := 0;
end;
{ if (menu=nil) then begin
cw:= GetSystemMetrics(SM_CYCAPTION)+GetSystemMetrics(SM_CXFRAME);
if (cw>bw.top) then
menuheight := cw-bw.Top
else menuheight:=0;
end ; }
deletesysbtn;
BtnCount:= length(fsd.sysbtn);
setlength(sysbtn,BtnCount);
for i:= 0 to BtnCount-1 do begin
sysbtn[i]:=TWinsysbutton.create;
sysbtn[i].data:=fsd.sysbtn[i];
sysbtn[i].sf:=self;
sysbtn[i].enabled:=true;
if fsd.sysbtn[i].action in [3,11] then begin
GetIcon(iconbmp);
//copybmp(iconbmp,fsd.sysbtn[i].map);//fsd.sysicon);
if sysbtn[i].data.map.empty then
copybmp(iconbmp,fsd.sysbtn[i].map);//fsd.sysicon);
// copybmp(fsd.sysicon,fsd.sysbtn[i].map);
// copybmp(Iconbmp,fsd.sysbtn[i].map);
// fsd.sysbtn[i].map.assign(Iconbmp);
if fsd.sysicon.empty then
copybmp(Iconbmp,fsd.sysicon);
fsd.sysbtn[i].frame:=1;
end;
end;
end;
procedure TWinSkinForm.KeepClient;
var r1:Trect;
begin
r1:=fform.ClientRect;
// Form Change Height
fform.height:=r1.bottom+bw.top+bw.bottom+menuheight;
// Form Change Width
fform.width:=r1.right+bw.left+bw.right;
end;
procedure TWinSkinForm.DrawIcon(dc:HDC;rc:TRect);
var SmallIcon: HIcon;
begin
DefIcon := SendMessage(application.handle, WM_GETICON, ICON_SMALL, 0);
if DefIcon = 0 then
DefIcon := SendMessage(application.handle, WM_GETICON, ICON_BIG, 0);
if deficon<>0 then begin
SmallIcon := CopyImage(DefIcon, IMAGE_ICON, iconx, iconx,LR_COPYFROMRESOURCE);//LR_CREATEDIBSECTION);// LR_COPYFROMRESOURCE);
DrawIconEx(dc,rc.Left,rc.Top, SmallIcon,iconx, iconx, 0, 0,DI_NORMAL);
DestroyIcon(SmallIcon);
end else begin
DrawTranmap(DC,rc,iconbmp);
// DrawRect1(dc,rc,iconbmp,1,1,1) ;
end;
end;
{procedure TWinSkinForm.DrawIcon(dc:HDC;rc:TRect);
var SmallIcon: HIcon;
begin
if deficon<>0 then begin
SmallIcon := CopyImage(DefIcon, IMAGE_ICON, iconx, iconx,LR_CREATEDIBSECTION);// LR_COPYFROMRESOURCE);
DrawIconEx(dc,rc.Left,rc.Top, defIcon ,iconx, iconx, 0, 0,DI_NORMAL);
DestroyIcon(SmallIcon);
end;
end;}
procedure TWinSkinForm.GetIcon(var bmp:Tbitmap);
var
SmallIcon: HIcon;
cx, cy,i: Integer;
sd:Tskindata;
begin
cx := GetSystemMetrics(SM_CXSMICON);
cy := GetSystemMetrics(SM_CYSMICON);
// bmp.Assign(nil);
// bmp.canvas.brush.color:=clFuchsia;
bmp.width:=cx;bmp.height:=cy;
bmp.PixelFormat := pf16bit;
bmp.Canvas.Brush.color:=clFuchsia;
bmp.canvas.fillrect(rect(0,0,cx,cy));
iconx:=cx;
// First try a small icon, then a big icon
DefIcon := SendMessage(hwnd, WM_GETICON, ICON_SMALL, 0);
if DefIcon = 0 then
DefIcon := SendMessage(hwnd, WM_GETICON, ICON_BIG, 0);
if DefIcon <> 0 then begin
SmallIcon := CopyImage(DefIcon, IMAGE_ICON, cx, cy, LR_COPYFROMRESOURCE);
DrawIconEx(bmp.Canvas.Handle, 0, 0, SmallIcon,
cx, cy, 0, 0, DI_MASK or DI_IMAGE );//DI_NORMAL);
DestroyIcon(SmallIcon);
end else if not fsd.sysicon.empty then begin //otherwise no icon found
//cause DLL exception
//bmp.assign(fsd.sysicon) ;
//bmp.PixelFormat := pf24bit;
//copybmp(sd.SysIcon,bmp);
end else begin
for i:= 0 to skinmanager.dlist.count-1 do begin
sd:= Tskindata(skinmanager.dlist.items[i]);
if sd.skinformtype=sfMainform then begin
if not sd.sysicon.empty then
//copybmp(sd.SysIcon,bmp);
//bmp.assign(sd.sysicon) ;
end;
end;
end;
end;
function GetWindowClassname(ahwnd:Thandle):string;
var buf:array[0..MAX_CLASSNAME] of char;
begin
GetClassName(ahwnd, buf, MAX_CLASSNAME);
result:=strpas(buf);
end;
procedure TWinSkinForm.doLog(msg:string);
var r:Trect;
begin
{$IFDEF test}
exit;
if msg='' then exit;
// if not skinmanager.menuactive then exit;
if formstyle=sfsmdichild then exit;
// if fform<>nil then
// exit;
msg:=format('%s-%4x :%s WS:%1d',[caption,hwnd,msg,Ord(windowstate)]);
// getwindowrect(hwnd,r);
// msg:=msg+format(' W(W:%1d H:%1d)',[r.right-r.left,r.bottom-r.top]);
// getclientrect(hwnd,r);
// msg:=msg+format(' C(w:%1d h:%1d)',[r.right-r.left,r.bottom-r.top]);
// msg:=msg+format(' (l:%1d r:%1d w:%1d h:%1d)',[r.left,r.top,r.right,r.bottom]);
// if crop then msg:=msg+' Crop:True'
// else msg:=msg+' Crop:False';
// if hassysbtn then msg:=msg+' SysBtn:True'
// else msg:=msg+' SysBtn:False';
if SkinCanLog then Logstring.add(msg);
{$ENDIF}
end;
procedure TWinSkinForm.NewWndProc(var aMsg: TMessage);
const s=' ';
var b:boolean;
begin
{$IFDEF test}
// dolog(MsgtoStr(aMsg));
{$ENDIF}
done2:=false;
with aMsg do begin
case Msg of
CM_BEWAIT: begin
// If message comes from Billenium Effects
if aMsg.LParam = BE_ID then aMsg.Result := BE_ID
else aMsg.Result :=1 ;
end;
CM_BENCPAINT: begin
if amsg.LParam = BE_ID then begin
// If a device context is provided then render the non client area in it
if amsg.WParam <> 0 then
updatenc(amsg.WParam);
amsg.Result := BE_ID;
end
end;
CM_DialogChar:
CMDialogChar(amsg);
// CM_RELEASE: postmessage(hwnd,wm_close,0,0);
{CM_MENUCHANGED: begin
OldWndProc(amsg);
refresh;
done2:=true;
end;}
CN_SkinChanged:begin
SkinChange;
done:=true;
end;
WM_SETTEXT : begin
if IsWindowVisible(hwnd) then begin
// mdiform has problem, change caption when created
{if isunicode or (formstyle=sfsmdichild) then
OldWndProc(amsg)
else begin
sendmessage(hwnd,WM_SETREDRAW,0,0);
OldWndProc(amsg);
sendmessage(hwnd,WM_SETREDRAW,1,0);
Application.ProcessMessages;
end; }
OldWndProc(amsg);
if (windowstate=swsmax) then
postmessage(skinmanager.clienthwnd,CN_NewMDIChild,hwnd,0);
if windowstate=swsmin then
updatenc(0)
else refresh;
end else begin //visible=false
OldWndProc(amsg);
end;
done2:=true;
end;
else OldWndProc(amsg);
end;
end;
// if not Done2 then OldWndProc(amsg);
end;
// RedrawWindow(hwnd,0,0,RDW_FRAME or RDW_INVALIDATE or RDW_UPDATENOW);
procedure TWinSkinForm.SkinChange;
var i:integer;
c,fc:Twincontrol;
sc:Tskincontrol;
b:boolean;
begin
fc:=nil;
b:=false;
if fform<>nil then begin
fform.color:=fsd.colors[csButtonFace];
for i := 0 to fForm.ComponentCount - 1 do begin
if fForm.Components[i] is Tcustomform then
Tcustomform(fForm.Components[i]).color:=fsd.colors[csButtonFace]
else if fForm.Components[i] is TCustomGrid then
TacGrid(fForm.Components[i]).fixedcolor:=fsd.colors[csButtonFace];
end;
// fc:=fform.ActiveControl;
// if fc<>nil then b:=fc.Focused;
end;
for i:= 0 to controllist.count-1 do begin
sc:=Tskincontrol(controllist.items[i]);
sc.skinchange;
end;
SkinState:=skin_change;
if (sMainMenu) and (fform<>nil) then begin
if fform<>nil then
InitPopmenu(fform,true,true);
ResizeForm(1);
// SkinState:=skin_Active;
// cropwindow;}
fform.Height:=fform.height+1;
fform.Height:=fform.height-1;
end;
AfterSkin;
// if b and (fc<>Nil) then fc.SetFocus;
SkinState:=skin_Active;
// skinaddlog('**********************skin change************');
end;
procedure TWinSkinForm.UnSubclass;
var w,h:integer;
p:Tpoint;
r2:Trect;
style:dword;
begin
if not sMainMenu then begin
Unsubclass2;
exit;
end;
if sysmenu<>nil then begin
sysmenu.free;
sysmenu:=nil;
end;
timer.enabled:=false;
if fobjectinst=nil then exit;
if (fform<>nil) and assigned(oldwndproc) then begin
fform.WindowProc := OldWndProc;
oldwndproc:=nil;
end;
if isunicode then
SetWindowLongW(hwnd, GWL_WNDPROC,LongInt(FPrevWndProc))
else
SetWindowLong(hwnd, GWL_WNDPROC,LongInt(FPrevWndProc));
FreeObjectInstance(FObjectInst);
fobjectinst:=nil;
DeleteControls;
if fform<>nil then begin
InitPopMenu(fform,false,false);
if (xcMenuitem in fsd.SkinControls) then
InitMainMenu(fForm,false,false);
if Skinstate<>skin_Destory then
fform.color:=formcolor;
end;
UpdateStyle(false);
EnableSysbtn(true);
if menu<>nil then begin
if hmenu<>menu.hmenu then
SetMenu(Hwnd, menu.hmenu)
else
SetMenu(Hwnd, hmenu);
menu.free;
menu:=nil;