winskindlg.pas

超级报表系统软件VclSkin.v2.60.4.29.完整源代码版.rar

unit WinSkinDlg;

{$WARNINGS OFF}
{$HINTS OFF}
{$RANGECHECKS OFF}

interface

uses windows,Messages,SysUtils,Classes,Graphics,WinSkinMenu,
  forms,ExtCtrls;

const
   skin_Creating=0;
   skin_Active=1;
   skin_uninstall=2;
   skin_change=3;
   skin_Destory=4;
   skin_Updating=5;
   skin_Deleted=6;

Type
  TSkinThread = class(TObject)
  public
    hook:HHook;
    ThreadID:integer;
  end;

  TSBAPI1=function(ahwnd:hwnd): HResult; stdcall;
  TSBAPI2= function() :HResult; stdcall;

  TSkinManage = class(Tobject)
  protected
    Timer : TTimer;
    SBLib :Thandle;
    pinitApp,pUninitApp:TSBAPI2;
    pinitSB,pUninitSb:TSBAPI1;
    HookCallback,WndCallBack,WndCallRet : HHOOK;
    //function  FindSkinForm(aHwnd:THandle):boolean;
    function  FindSkinForm(aHwnd:THandle):dword;
    procedure DeleteAllForms;
    function AddMenu(aHwnd:THandle):boolean;
    function  FindSkinMenu(aHwnd:THandle):boolean;
    function  DeleteMenu(aHwnd:THandle):boolean;
    procedure DeleteAllMenus;
    function  FindTForm(ahwnd:Thandle):Tform;
    procedure OnTimer(Sender: TObject);
    function NestedForm(ahwnd:Thandle):boolean;
    procedure FindSkindata(var adata:pointer;ahwnd:Thandle);
    function OnBeforeSkin(aname:string):boolean;
    procedure DeleteAllThreads;
    procedure ActiveForm(aform:Tform);
    procedure DeleteDeleted;
  public
    Flist:Tlist;
    Mlist:Tlist;
    Dlist:Tlist;
    Threadlist:Tlist;
    active:boolean;
    skinchildform:boolean;
    state:integer;
    menuactive:boolean;
    MDIMax:boolean;
    clienthwnd:Thandle;
    action:integer;
    UpdateData:pointer;
    SBinstall :boolean;
    constructor Create;
    destructor Destroy; override;
    procedure InstallHook;
    function AddForm(aHwnd:THandle):boolean;
    function DeleteForm(aHwnd:THandle):boolean;
    function  GetMenuBg(amenu:Hmenu):Tbitmap;
    procedure UpdateSkinMenu(amenu:Hmenu);
    procedure  FindPopupMenu(amenu:Hmenu);
    procedure  SetMDIMax(b:boolean);
    procedure  SetCaption(b:boolean);
    function  GetMDIChildNum:integer;
    procedure SetAction(acode:integer;Interval:integer=250);
    procedure AddSkinData(adata: Pointer);
    procedure RemoveSkinData(adata: Pointer);
    procedure DeleteSysbtn;
    procedure InstallThread(aThreadID:integer);
    procedure UnInstallThread(aThreadID:integer);
    function initsb(ahwnd:Thandle):boolean;
    function Uninitsb(ahwnd:Thandle):boolean;
    procedure SetMenu;
    procedure DeleteForm2(aHwnd:THandle);
    procedure DeleteForm3;
  end;

//var HookCallback,WndCallBack,WndCallRet : HHOOK;
var  SkinManager:TSkinManage;

function SkinHookCallback(code: integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
function SkinHookCallRet(code: integer; wParam: WPARAM; lParam: LPARAM): LRESULT;stdcall;
function SkinHookCBT(code: integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
function SkinHookCBT2(code: integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;

implementation

uses winskinform ,WinSkinData,menus;


function SkinHookCallRet(code: integer; wParam: WPARAM; lParam: LPARAM): LRESULT;
var pwp:PCWPRETSTRUCT;
   s:string;
begin
   if code= HC_ACTION then begin
     pwp:=PCWPRETSTRUCT (lparam);
     case pwp.message of
        WM_DRAWITEM: begin
//              SkinManager.WMDRAWITEM(PDrawItemStruct(pwp.lparam));
           end;
     end;
   end;
   result:=CallNextHookEx( SkinManager.WndCallRet, Code, wParam, lParam );
end;

function SkinHookCallback(code: integer; wParam: WPARAM; lParam: LPARAM): LRESULT;
var pwp:PCWPSTRUCT;
   s:string;
   msg:Tmessage;
begin
   if code= HC_ACTION then begin
     pwp:=PCWPSTRUCT(lparam);
{     if skincanlog then begin
        msg.msg:=pwp.message;
        msg.wparam:=pwp.wparam;
        msg.lparam:=pwp.lparam;
        skinaddlog('Hook:'+msgtostr(msg));
     end; }
     case pwp.message of
        WM_CREATE:SkinManager.AddMenu(pwp.hwnd);
        WM_DESTROY,WM_NCDESTROY:SkinManager.DeleteMenu(pwp.hwnd);
        WM_INITMENU: begin
              skinaddlog('WH_CALLWNDPROC : WM_INITMENU');
              skinmanager.FindPopupMenu(pwp^.wparam);
           end;
{        WM_DRAWITEM: begin
              skinaddlog('WH_CALLWNDPROC : WM_DRAWITEM');
           end;}
     end;
   end;
   result:=CallNextHookEx( SkinManager.WndCallback, Code, wParam, lParam );
end;

function SkinHookCBT(code: integer; wParam: WPARAM; lParam: LPARAM): LRESULT;
var s:string;
   hwnd:Thandle;
   ptr:^CBT_CREATEWND;
   sf: dword;
begin
//message box WM_ACTIVATE TMessageForm
//Dlg ****WM_ACTIVATE #32770 WA_ACTIVE
   if code>=0 then begin
      case code of
        HCBT_ACTIVATE :begin
           if skinmanager.state=skin_creating then
              inc(skinmanager.state);
           hwnd := Thandle(wParam);
             if  SkinManager.addform(hwnd) then begin
             end;
         end;
         HCBT_DESTROYWND : begin
           hwnd := Thandle(wParam);
           SkinManager.DeleteMenu(hwnd);
           //if SkinManager.deleteform(hwnd) then begin
           //end;
         end;
         HCBT_CREATEWND : begin
           hwnd := Thandle(wParam);
           ptr:=pointer(lparam);
           s:= getwindowclassname(hwnd);
//           skinAddlog(format('***HCBT_CREATEWND %s %1x,%1x',[s,hwnd,ptr^.lpcs^.hwndParent]));
           if (s='ScrollBar') and ((ptr^.lpcs^.style and sbs_sizegrip)>0) then begin
              sf:= SkinManager.findskinform(ptr^.lpcs^.hwndParent);
              if sf>0 then begin
                  result:=10;
                  exit;
//                Twinskinform(ptr).addcontrol(hwnd);
//                skinAddlog(format('***Scrollbar %s %1x,%1x',[s,hwnd,ptr^.lpcs^.hwndParent]));
              end;
           end ;
           if s='#32768' then
              SkinManager.AddMenu(hwnd); //don't create scrollbar
         end;
      end;//endcase
   end;    
   result:=CallNextHookEx( SkinManager.HookCallback, Code, wParam, lParam );
end;

function SkinHookCBT2(code: integer; wParam: WPARAM; lParam: LPARAM): LRESULT;
var s:string;
   hwnd:Thandle;
   ptr:^CBT_CREATEWND;
begin
//message box WM_ACTIVATE TMessageForm
//Dlg ****WM_ACTIVATE #32770 WA_ACTIVE
   if code>=0 then begin
      case code of
        HCBT_ACTIVATE :begin
           if skinmanager.state=skin_creating then
              inc(skinmanager.state);
           hwnd := Thandle(wParam);
             if  SkinManager.addform(hwnd) then begin
//               s:='****HCBT_ACTIVATE '+s;
//               skinAddlog(s);
             end;
         end;
         HCBT_DESTROYWND : begin
           hwnd := Thandle(wParam);
           SkinManager.DeleteMenu(hwnd);
           if SkinManager.deleteform(hwnd) then begin
           end;
         end;
         HCBT_CREATEWND : begin
           hwnd := Thandle(wParam);
           ptr:=pointer(lparam);
           s:= getwindowclassname(hwnd);
//           skinAddlog(format('***HCBT_CREATEWND %s %1x,%1x',[s,hwnd,ptr^.lpcs^.hwndParent]));
           if (s='ScrollBar') and (SkinManager.findskinform(ptr^.lpcs^.hwndParent)>0) then begin
//              skinAddlog(format('***Scrollbar %s %1x,%1x',[s,hwnd,ptr^.lpcs^.hwndParent]));
              result:=10;
              exit;
           end ;
           if s='#32768' then
              SkinManager.AddMenu(hwnd); //don't create scrollbar
         end;
      end;//endcase
   end;
   result:=CallNextHookEx( SkinManager.HookCallback, Code, wParam, lParam );
end;

constructor TSkinManage.Create;
begin
   inherited;
   flist:=Tlist.create;
   Mlist:=Tlist.create;
   dlist:=Tlist.create;
   threadlist:=Tlist.create;
   active:=false;
   menuactive:=false;
   MDIMax:=false;
   Timer := TTimer.create(nil);
   timer.Interval:=250;
   timer.Ontimer:=Ontimer;
   timer.enabled:=false;
   SBinstall :=false;
   skinchildform:=false;

   state:=skin_creating;
   SBLib:=0;
//   SBLib := LoadLibrary('C:\MyFile\MySkin\ARTICLE\coolsb_src\coolsb2\Release\coolsb2.dll');
//   SBLib := LoadLibrary('coolsb2.dll');
   pinitapp:=nil;
   sbinstall:=false;
   if SBLib<>0 then begin
    pinitApp:=GetProcAddress(SBLib,'CoolSB_InitializeApp');
    pUninitApp:= GetProcAddress(SBLib,'CoolSB_UninitializeApp');
    pinitSB:=GetProcAddress(SBLib,'InitializeCoolSB');
    pUninitSb:=GetProcAddress(SBLib,'UninitializeCoolSB');
   end;
   if @pinitapp<>nil then
       SBinstall := boolean(pinitapp);
//   installhook;
end;

destructor TSkinManage.Destroy;
begin
   state:=skin_destory;
   Timer.free;
   if HookCallback<>0 then
     UnhookWindowsHookEx( HookCallback );
   if @pUninitapp<>nil then  pUninitapp;
//   UnhookWindowsHookEx( WndCallback );
//   UnhookWindowsHookEx( WndCallRet );
   DeleteAllThreads;
   deleteallforms;
   deleteallmenus;
   dlist.free;
   if (sblib<>0) then 
       FreeLibrary(sblib);
   inherited destroy;
end;

procedure TSkinManage.InstallHook;
var dwThreadID:DWORD;
begin
   winversion:=GetVersion();
   skinaddlog(format('Windows Version %1x',[winversion]));
   skinaddlog(format('Windows Version %1d %1d',[Win32MajorVersion,Win32MinorVersion]));
//   skinaddlog(format('winversion %1x',[winversion]));
   dwThreadID := GetCurrentThreadId;
//   WndCallback :=SetWindowsHookEx( WH_CALLWNDPROC,SkinHookCallback,0,dwThreadID);
//   WndCallRet :=SetWindowsHookEx( WH_CALLWNDPROCRET,SkinHookCallRet,0,dwThreadID);
   HookCallback :=SetWindowsHookEx( WH_CBT,SkinHookCBT,0,dwThreadID);
   skinaddlog(format('ThreadId %1x',[dwThreadId]));
   skinaddlog(format('HookCallback %1x',[HookCallback]));
end;

procedure TSkinManage.InstallThread(aThreadID:integer);
var obj:TSkinThread;
     b: boolean;
     i:integer;
begin
   b:=false;
   for i:= 0 to threadlist.count-1 do begin
      obj:= TSkinThread(threadlist[i]);
      if obj.threadID=aThreadID then begin
        b:=true;
        break;
      end;
   end;
   if b then exit;
   obj:=TSkinThread.create;
   obj.threadID:=aThreadID;
   obj.hook :=SetWindowsHookEx( WH_CBT,SkinHookCBT2,0,aThreadID);
   threadlist.add(obj);
end;

procedure TSkinManage.UnInstallThread(aThreadID:integer);
var obj:TSkinThread;
    i:integer;
begin
   for i:= 0 to threadlist.count-1 do begin
      obj:= TSkinThread(threadlist[i]);
      if obj.threadID=aThreadID then begin
        UnhookWindowsHookEx( obj.hook);
        threadlist.delete(i);
        break;
      end;
   end;
end;

procedure TSkinManage.DeleteAllThreads;
var obj:TSkinThread;
    i:integer;
begin
   for i:= 0 to threadlist.count-1 do begin
      obj:= TSkinThread(threadlist[i]);
      UnhookWindowsHookEx( obj.Hook );
      obj.free;
   end;
   threadlist.clear;
   threadlist.free;
end;


function Tskinmanage.nestedform(ahwnd:Thandle):boolean;
var  style:longword;
     s:string;
     phwnd:Thandle;
begin
   result:=false;
   Style := GetWindowLong( ahwnd, GWL_STYLE );
   if (style and ws_child)=0 then exit;
   phwnd:=getparent(ahwnd);
   s:=lowercase(getwindowclassname(phwnd));
   if s='mdiclient' then exit;
   result:=true;
end;

procedure Tskinmanage.FindSkindata(var adata:pointer;ahwnd:Thandle);
var s:string;

  function FindOnlyThisForm:boolean;
  var i:integer;
      sd:Tskindata;
      sf:Tform;
  begin
     result:=false;
     for i:= 0 to dlist.count-1 do begin
         sd:=Tskindata(dlist.items[i]);
         sf:=Tform(sd.owner);
         if (sd.skinformtype=sfOnlyThisForm) and (sf.handle=ahwnd) then begin
             adata:=sd;
             result:=true;
         end;
     end;
  end;

  function FindData(atype:TSkinFormType):boolean;
  var i:integer;
      sd:Tskindata;
  begin
     result:=false;
     for i:= 0 to dlist.count-1 do begin
         sd:=Tskindata(dlist.items[i]);
         if (sd.skinformtype=atype) then begin
             adata:=sd;
             result:=true;
         end;
     end;
  end;

begin
   if FindOnlyThisForm then exit;
   s:=lowercase(getwindowclassname(ahwnd));
   if ((s='tmessageform') or (s='#32770')) and finddata(sfDialog) then exit;
   if finddata(sfMainform) then exit;
   if dlist.count>0 then adata:=dlist.items[0]
   else adata:=nil;
end;

function TSkinManage.OnBeforeSkin(aname:string):boolean;
var b:boolean;
    i:integer;
    sd:Tskindata;
begin
   b:=true;
   for i:= 0 to dlist.count-1 do begin
       sd:=Tskindata(dlist.items[i]);
       if (sd.skinformtype=sfMainform) then begin
            sd.DoFormSkin(aname,b);
            break;
       end;
   end;
   result:=b;
end;

procedure TSkinManage.ActiveForm(aform:Tform);
var dwstyle:dword;
    b:boolean;
begin
    dwstyle := GetWindowLong( aform.handle, GWL_STYLE );
    b:= (dwstyle and ws_child)>0;
    if aform.formstyle=fsmdichild then b:=false;
    if not aform.Visible then b:=true;
    if not b then addform(aform.handle);
end;

function TSkinManage.AddForm(aHwnd:THandle):boolean;
var aform:TWinskinform;
    atform:TForm;
    r:Trect;
    s:string;
    aptr:pointer;
    adata:Tskindata;
    isskin:integer;
begin
   result:=false;
   if not active then exit;
   isskin:=sendmessage(ahwnd,CN_IsSkined,0,0);
   if isskin=1 then exit;
   DeleteDeleted;
   if findskinform(ahwnd)<>0 then exit;

   atform:=findtform(ahwnd);
   if (not skinchildform) and nestedform(ahwnd) then exit;
   getwindowrect(ahwnd,r);
   offsetrect(r,-r.left,-r.top);
   if r.right*r.bottom=0 then exit;
   if (atform<>nil) and (atform.tag=99) then exit;
   s:=getwindowclassname(ahwnd);
   if s='TApplication' then exit;
   if not OnBeforeSkin(s) then exit;

   FindSkindata(aptr,ahwnd);
   if aptr=nil then exit;

   adata:=Tskindata(aptr);
   if adata.empty then exit;