winsubclass.pas

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

unit WinSubClass;

{.$define buttontest}
{$WARNINGS OFF}
{$HINTS OFF}
{$RANGECHECKS OFF}

interface

uses
  Windows, SysUtils, Classes, Graphics, Controls, ComCtrls,  Forms,
  Menus, Messages, ExtCtrls, StdCtrls, Buttons, CommCtrl,imglist,
  winskindata,tabs,TypInfo;

type
  TSkinControlState = ( scMouseIn,scDown);
  TAcControl = class(TControl);
//  TACCustomCheckBox = Class(TCustomCheckBox);
  TAcGraphicControl = class(TGraphicControl);
  TSkinAcListView = class(TCustomListView);

  TSkinControl = class(TComponent)
  Protected
     state : set of TSkinControlState;
     fCanvas : TCanvas;
     done:boolean;
     isdraw : boolean;
     enabled : boolean;
     focused : boolean;
     caption : string;
     FObjectInst,FPrevWndProc :pointer;
     procedure FillBG( dc:HDC; rc:TRect);
     procedure doLogMsg(aid:string;msg:TMessage);
     procedure Default(Var Msg: TMessage);
     procedure Invalidate;
     procedure WMPaint(message:TMessage);
  public
     fsd: TSkinData;
     hwnd : HWND;
     OldWndProc: TWndMethod;
     control:Twincontrol;
     boundsrect:Trect;
     GControl : TGraphicControl;
     newColor:boolean;
     oldcolor:Tcolor;
     Inited:boolean;
     skinstate : integer;
     skinform: Tcomponent;
     constructor Create(AOwner: TComponent); override;
     destructor Destroy; override;
     Procedure Init(sf:Tcomponent;sd:TSkinData;acanvas:TCanvas;acolor:boolean=false);virtual;
     Procedure Inithwnd(ahwnd:Thandle;sd:TSkinData;acanvas:TCanvas;sf:Tcomponent);virtual;
     procedure MouseLeave;
     Procedure Unsubclass; virtual;
     procedure NewWndProc(var Message: TMessage);
     function BeforeProc(var Message: TMessage):boolean;virtual;
     procedure AfterProc(var Message: TMessage);virtual;
     procedure PaintControl(adc:HDC=0);virtual;
     procedure DrawControl( dc:HDC; rc:TRect);Virtual;
     Procedure SkinChange; Virtual;
     function  GetState:integer;Virtual;
     function  GetProperty(aprop:string):string;
     function  GetIntProperty(aprop:string;var i:Longword):boolean;
     Procedure SetColor;
     Procedure RestoreColor;
     procedure DrawBMPSkin( abmp:Tbitmap;rc:TRect;aObject:TdataSkinObject;
              I,N:integer;trans:integer);
     procedure DrawSkinMap( dc:HDC; rc:TRect;
        aObject:TdataSkinObject;I,N:integer);
     procedure DrawSkinMap1( dc:HDC; rc:TRect;
       bmp:Tbitmap;I,N:integer);
     procedure DrawSkinMap2( dc:HDC; rc:TRect;
       bmp:Tbitmap;I,N:integer);
     procedure DrawSkin( rc:TRect;aObject:TdataSkinObject;
                   I,N:integer;trans:integer);
     procedure DrawSkinMap3( acanvas:Tcanvas; rc:TRect;
        bmp:Tbitmap;I,N:integer);
     procedure DrawBuf( dc:HDC; rc:TRect);
     procedure DrawCaption(acanvas: TCanvas; rc:TRect;text:string;
             enabled,defaulted:boolean;Alignment:word=DT_CENTER);
     procedure DrawImgCaption(acanvas: TCanvas; rc:TRect;
           ImgList:hImageList;imgIndex:integer;text:string;talign:integer=DT_CENTER);
  end;

  TSkinButton = class(TSkinControl)
  Protected
     btemp:Tbitmap;
  public
     constructor Create(AOwner: TComponent); override;
     destructor Destroy; override;
     function BeforeProc(var Message: TMessage):boolean;override;
     procedure AfterProc(var Message: TMessage);override;
     procedure DrawControl( dc:HDC; rc:TRect);override;
  end;

  TSkinBitButton = class(TSkinButton)
  Protected
     procedure DrawGlyph( acanvas:Tcanvas; rc:TRect;
       bmp:Tbitmap;I,N:integer);
  public
     procedure DrawControl( dc:HDC; rc:TRect);override;
  end;

  TSkinSpeedButton = class(TSkinBitButton)
  protected
  public
//     GControl : TGraphicControl;
     gcanvas:Tcanvas;
     constructor Create(AOwner: TComponent); override;
     destructor Destroy; override;
     procedure DrawSpeedbtn( acanvas:Tcanvas; rc:TRect);
     procedure InitGraphicControl(sf:Tcomponent;sd:TSkinData;acanvas:TCanvas);
     procedure AfterProc(var Message: TMessage);override;
     function BeforeProc(var Message: TMessage):boolean;override;
     procedure PaintControl(adc:HDC=0);override;
  end;

  TSkinCheckBox = class(TSkinControl)
  Protected
  public
     function BeforeProc(var Message: TMessage):boolean;override;
     procedure AfterProc(var Message: TMessage);override;
     procedure DrawControl( dc:HDC; rc:TRect);override;
  end;

  TSkinComBox = class(TSkinControl)
  Protected
     dwStyle,ExStyle:longword;
     procedure DrawSkinMap3( dc:HDC; rc:TRect;
        bmp:Tbitmap;I,N:integer);
     procedure DrawControl1( dc:HDC; rc:TRect);
  public
     procedure AfterProc(var Message: TMessage);override;
     procedure DrawControl( dc:HDC; rc:TRect);override;
  end;

  TSkinRadioButton = class(TSkinControl)
  Protected
  public
     procedure AfterProc(var Message: TMessage);override;
     procedure DrawControl( dc:HDC; rc:TRect);override;
  end;

  TSkinStatusBar = class(TSkinControl)
  Protected
     procedure Defaultpaint(dc:HDC; rc:TRect;I:integer;
             text:string='';Align:TAlignment=taLeftJustify);
     procedure drawitem(dc:HDC; rc:TRect;I:integer;
             text:string='';Align:TAlignment=taLeftJustify);
  public
     SizeGrip:boolean;
     function BeforeProc(var Message: TMessage):boolean;override;
     procedure DrawControl( dc:HDC; rc:TRect);override;
  end;

  TSkinBox = class(TSkinControl)
  Protected
  public
     border:integer;
     procedure AfterProc(var Message: TMessage);override;
     Procedure Init(sf:Tcomponent;sd:TSkinData;acanvas:TCanvas;acolor:boolean=false);override;
     Procedure Unsubclass; override;
  end;

  TSkinUpDown = class(TSkinControl)
  Protected
     procedure DrawButton(acanvas:Tcanvas;rc:TRect;n,ar:integer);
     procedure DrawSkinButton(dc:HDC;rc:TRect;n,ar:integer);
  public
     inedit : boolean;
     dir : integer;
     function BeforeProc(var Message: TMessage):boolean;override;
     procedure DrawControl( dc:HDC; rc:TRect);override;
  end;


  TSkinTabPosition = (StTop,Stbottom,Stleft,Stright);
  TSkinTab = class(TSkinControl)
  Protected
     Position:TSkinTabPosition;
     procedure Drawitem( dc:HDC; rc:TRect;I:integer);
     procedure ERASEBKGND( dc:HDC);
     procedure GetPosition;
     procedure WMPaint(var msg:Tmessage);
     procedure ClipUpdown(dc:HDC;rc:Trect);
     function FindScroll:boolean;
     procedure DrawTabBorder(adc:HDC);
  public
     tabbmp,borderbmp : Tbitmap;
     Drawtemp: Tbitmap;
     updown:TskinUpdown;
     constructor Create(AOwner: TComponent); override;
     destructor Destroy; override;
     procedure DrawControl( dc:HDC; rc:TRect);override;
     function  BeforeProc(var Message: TMessage):boolean;override;
     Procedure Inithwnd(ahwnd:Thandle;sd:TSkinData;acanvas:TCanvas;sf:Tcomponent);override;
     Procedure inittab;
     Procedure SkinChange;override;
  end;

  TSkinTab31 = class(TSkinControl)
  Protected
     tabbmp:Tbitmap;
     updown:TskinUpdown;
     scroller : Twincontrol;
  public
     constructor Create(AOwner: TComponent); override;
     destructor Destroy; override;
     function BeforeProc(var Message: TMessage):boolean;override;
     procedure DrawControl( dc:HDC; rc:TRect);override;
     //Procedure Inithwnd(ahwnd:Thandle;sd:TSkinData;acanvas:TCanvas;sf:Tcomponent);override;
     Procedure Init(sf:Tcomponent;sd:TSkinData;acanvas:TCanvas;acolor:boolean=false);override;
     Procedure inittab;
  end;

  TSkinTransObj = class(TSkinControl)
  Protected
     procedure ERASEBKGND( dc:HDC);
  public
//     Brush,Oldbrush: HBrush;
     function BeforeProc(var Message: TMessage):boolean;override;
     procedure AfterProc(var Message: TMessage);override;
  end;

  TSkinProgress = class(TSkinControl)
  Protected
  public
     function BeforeProc(var Message: TMessage):boolean;override;
     procedure DrawControl1( dc:HDC; rc:TRect);
     procedure DrawControl( dc:HDC; rc:TRect);override;
  end;

  TSkinTrackBar = class(TSkinControl)
  Protected
     procedure Drawthumb(PDraw:PNMCustomDraw);
     function CustomDraw(PDraw:PNMCustomDraw):integer;
  public
     function BeforeProc(var Message: TMessage):boolean;override;
  end;

  TSkinEdit = class(TSkinControl)
  Protected
     procedure FindUPDown(ahwnd:Thandle;sd:TSkinData;acanvas:TCanvas);
     procedure DrawControl1( dc:HDC; rc:TRect);
     procedure PaintControl1(adc:HDC=0);
  public
     updown:TSkinUpDown;
//     procedure Init(aControl:Twincontrol;sd:TSkinData;acanvas:TCanvas;acolor:boolean=false);override;
//     procedure Inithwnd(ahwnd:Thandle;sd:TSkinData;acanvas:TCanvas);override;
     procedure AfterProc(var Message: TMessage);override;
     procedure DrawControl( dc:HDC; rc:TRect);override;
  end;

  TSkinSizer = class(TSkinControl)
  Protected
  public
      function BeforeProc(var Message: TMessage):boolean;override;
      procedure DrawControl( dc:HDC; rc:TRect);override;
  end;

  TScrollBarPos = record
      Btn:integer;
      ScrollArea:integer;
      Thumb:integer;
      ThumbPos:integer;
      MsgID:integer;
  end;
  TSkinScroll=(HB,VB);

  TSkinScrollBar = class(TSkinControl)
  Protected
     downBtn:integer;
     dwStyle,ExStyle:longword;
     corner:Trect;
     trackpos,trackdrag:boolean;
     InVScroll,InHScroll:boolean;
     Info:array[HB..VB] of SCROLLINFO;
     SR:array[HB..VB] of TRect;
     SP:array[HB..VB] of TScrollBarPos;
     sbinstall:boolean;
     crect:Trect;
     lock:integer;
     function BeforeProc(var Message: TMessage):boolean;override;
     procedure AfterProc(var Message: TMessage);override;
     procedure DrawScrollBar( dc:HDC; rc:TRect;ntype:integer;bScrollbarCtrl:Boolean);
     procedure GetScrollBarRect(rc:TRect);
     procedure GetThumb(rc:TRect;ntype:integer);
     Function  GetPos(x:integer;bar:TSkinScroll):integer;
     function  NCLButtonDown(var Message: TMessage):boolean;
     procedure Scrollclient(wpara:integer);
     procedure WMNCCalcSize(Var Msg: TMessage);
     procedure WMVScrollbar(var Message: TMessage);
     Procedure DragThumb(bar:TSkinScroll;MsgID:longword);
     Function GetThumbPos(x:integer;bar:TSkinScroll):integer;
     procedure Dolog(bar:TSkinScroll);
     procedure SetScrollbar(b:boolean;sb:integer);
     procedure SBProc(var Message: TMessage);
     Procedure Unsubclass;override;
  public
     procedure DrawControl( dc:HDC; rc:TRect);override;
     Procedure InitScrollbar(acontrol:Twincontrol;sd:TSkinData;acanvas:TCanvas;sf:Tcomponent;adrag:boolean=true);virtual;
  end;

  TSkinScControl = class(TSkinControl)
  protected
     downBtn:integer;
     SP: TScrollBarPos;
     procedure GetThumb(rc:TRect;ntype:integer);
     procedure DrawScrollBar( dc:HDC; rc:TRect;ntype:integer;bScrollbarCtrl:Boolean);
     function BeforeProc(var Message: TMessage):boolean;override;
  public
     procedure DrawControl( dc:HDC; rc:TRect);override;
  end;

  TSkinHeader = class(TSkinControl)
  protected
     procedure DrawItem(ImgList:hImageList;acanvas:Tcanvas;rc:Trect;index:Integer);
  public
     Procedure Inithwnd(ahwnd:Thandle;sd:TSkinData;acanvas:TCanvas;sf:Tcomponent);override;
     function BeforeProc(var Message: TMessage):boolean;override;
     procedure DrawControl( dc:HDC; rc:TRect);override;
  end;

  TSkinListView = class(TSkinScrollBar)
  protected
     FHeaderInstance: Pointer;
     FDefHeaderProc: Pointer;
     hHwnd: THandle;
     header:Tskinheader;
     procedure SetHeaderOwnerDraw;
     procedure DrawHeaderItem(DrawItemStruct: TDrawItemStruct);
     procedure Drawheader;
     procedure drawitem(dc:HDC; rc:TRect;acolumn:TListColumn);
     procedure WMNotify(var Message:TWMNotify);
  public
     Procedure InitScrollbar(acontrol:Twincontrol;sd:TSkinData;acanvas:TCanvas;sf:Tcomponent;adrag:boolean=true);override;
//     function BeforeProc(var Message: TMessage):boolean;override;
     procedure HeaderProc(var Message: TMessage);
  end;

procedure DrawArrow(ACanvas: TCanvas; X, Y, Orientation: integer);
procedure MyDrawCaption(acanvas: TCanvas; rc:TRect;
 text:string; enabled,defaulted:boolean;Alignment: TAlignment=taCenter);
procedure MyDrawImgCaption(acanvas: TCanvas; rc:TRect;
 ImgList:TCustomImageList;imgIndex:integer;
 text:string; enabled,defaulted:boolean;Alignment: TAlignment=taCenter);

implementation
uses ImgUtil,WinSkinForm,winskindlg;

{procedure TControlSubClass.winpaint(var Message: TMessage);
var  DC: HDC;
  PS: TPaintStruct;
  hwnd : Thandle;
begin
     hwnd:=Twincontrol(control).handle;
     canvas.handle := BeginPaint(hwnd, ps);
     PaintControl;
     if not done then orgWindowProc(Message);
     EndPaint(hwnd, ps);
     Canvas.Handle := 0;
     message.result:=0;

  Canvas.Lock;
  try
    Canvas.Handle := message.wparam;
    try
     PaintControl;
    finally
    end;
  finally
    Canvas.Unlock;
  end;
  message.result:=0;
end;}

constructor TSkinControl.Create(AOwner: TComponent);
begin
   inherited create(aowner);
   hwnd:=0;
   Gcontrol := nil;
   control := nil;
   inited:=false;
   skinstate:=0;
end;

//in Tfrom : skincontrol will destory when owner (control) is destory
//in Hwnd window : skincontrol will destory when capture wm_ncdestory message
//Unsubclass : used for unskin, restore old color.

Procedure TSkinControl.Init(sf:Tcomponent;sd:TSkinData;acanvas:TCanvas;acolor:boolean=false);
begin
   if inited then exit;
   newcolor:=acolor;
   fsd:=sd;
   skinform:=sf;
   fCanvas:=acanvas;
   control:=Twincontrol(owner);
   hwnd := control.handle;
   OldWndProc:= Control.WindowProc;
   Control.WindowProc := NewWndProc;
   control.DoubleBuffered:=true;
   Twinskinform(skinform).addcontrollist(self);

   Focused := (GetFocus= hWnd);
   enabled := (GetWindowLong(hWnd,GWL_STYLE) and WS_DISABLED)=0;
   caption:=getformcaption(hwnd);
   if newcolor then begin
      oldcolor:=Taccontrol(control).color;
      Taccontrol(control).color:=fsd.colors[csButtonFace];
   end;
   control.Invalidate;
   inited:=true;
   skinstate:=skin_active;
end;

Procedure TSkinControl.SetColor;
begin
end;

Procedure TSkinControl.RestoreColor;
begin