winsubclass.pas

一个仓库管理软件系统

unit WinSubClass;

{.$define combobox}
{.$define buttontest}

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

{$define progress}

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);
  TAcGraphicControl = class(TGraphicControl);
  TSkinAcListView = class(TCustomListView);
  TSkinScrollbar = class;

  TSkinControl = class(TComponent)
  Protected
     state : set of TSkinControlState;
     fCanvas : TCanvas;
     done:boolean;
     isdraw : boolean;
     enabled : boolean;
     focused : boolean;
     caption : wideString;
     FObjectInst,FPrevWndProc :pointer;
     skinned:boolean;
     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;
     isunicode:boolean;
     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;
     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:widestring;
             enabled,defaulted:boolean;Alignment:word=DT_CENTER);
     procedure DrawImgCaption(acanvas: TCanvas; rc:TRect;
           ImgList:hImageList;imgIndex:integer;text:widestring;talign:integer=DT_CENTER);
     function TextHeight(dc:HDC;const s: string):integer;
  end;

  TSkinButton = class(TSkinControl)
  Protected
     btemp:Tbitmap;
     procedure DrawBtnText(acanvas: TCanvas; rc:TRect;
               text:String; Alignment:word=DT_CENTER);
  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;
     hlist:Thandle;
     box :Tskinscrollbar;
     procedure DrawSkinMap3( dc:HDC; rc:TRect;
        bmp:Tbitmap;I,N:integer);
     procedure DrawControl1( dc:HDC; rc:TRect);
  public
     constructor Create(AOwner: TComponent); override;
     destructor Destroy; override;
     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:widestring='';Align:TAlignment=taLeftJustify);
     procedure drawitem(dc:HDC; rc:TRect;I:integer;
             text:widestring='';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;

  TSkinGroupBox = class(TSkinControl)
  Protected
     procedure DefaultDraw( dc:HDC; rc:TRect);
  public
     border:integer;
     function BeforeProc(var Message: TMessage):boolean;override;
     procedure DrawControl( dc:HDC; rc:TRect);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
     procedure skinchange;override;
     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;
     procedure Inithwnd(ahwnd:Thandle;sd:TSkinData;acanvas:TCanvas;sf:Tcomponent);override;
  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;

function  GetProperty(control: TObject ;aprop:string):string;
function  GetIntProperty(control: TObject ;aprop:string):integer;
function  GetEnumProperty(control: TObject;aprop:string):string;
function  GetStringProp(control: TObject;aprop:string):widestring;
function GetObjProp(control: TObject;aprop:string; MinClass: TClass):Tobject;
function  GetObjMethod(control: TObject;aprop:string): TMethod;

procedure DrawArrow(ACanvas: TCanvas; X, Y, Orientation: integer);
procedure MyDrawCaption(acanvas: TCanvas; rc:TRect;
 text:widestring; 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;

const _maxcaption = 80;
{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;
   skinform:=nil;
   isunicode:=false;
   skinned:=true;
end;

//in Tfrom : skincontrol will destory when owner (control) is destory
//in Hwnd window : skincontrol will destory when capture wm_ncdestory message