winskinform.pas

这是VCLSKIN v4.22 的所有的源代码

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;
    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);
  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;
  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 GetFormCaption(ahwnd: THandle): WideString;
function GetFormCaptionA(ahwnd: THandle): String;
function GetFormText(ahwnd: THandle): String;
function EnumControl(ahwnd :HWND;lParam: LPARAM):boolean;stdcall;
procedure DrawParentImage( Control: TControl; DC: HDC; InvalidateParent: Boolean = False );

//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