winsubclass.pas

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

unit WinSubClass;

{$I Compilers.inc}

{.$define combobox}
{.$define buttontest}
{.$define resiztest}
{.$define scrollbartest}
{.$define combox}

{$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,Dialogs,Grids;

const
   CM_Scroll1= 161;
   CM_Scroll2= 513;
   CM_Scroll3= 162;
   CM_Scroll4= 514;
   C_Paramv = 7;
   C_Paramh = 6;
   c_paramB = 1;
   SBM_GETSCROLLBARINFO = 235;

type
  TSkinControlState = ( scMouseIn,scDown);
  TAcControl = class(TControl);
  TAcWinControl = class(TWinControl);
  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;
     isunicode:boolean;
     procedure FillBG( dc:HDC; rc:TRect);
     procedure FillParentBG( dc:HDC; rc:TRect);
     procedure doLogMsg(aid:string;msg:TMessage);
     procedure Default(Var Msg: TMessage);
     procedure Invalidate;
     procedure WMPaint(message:TMessage);
     procedure WMERASEBKGND(var Msg: TMessage);
     function GetWindowLongEx(ahWnd: HWND; nIndex: Integer): Longint;
     procedure SetParentBK(value:boolean);
     procedure DrawFocus(hDC: HDC; wString: WideString; rc: TRect; uFormat: UINT);
//     procedure Notification(AComponent: TComponent;Operation: TOperation);override;
  public
     fsd: TSkinData;
     hwnd : HWND;
     OldWndProc: TWndMethod;
     control:Twincontrol;
     boundsrect:Trect;
     GControl : TGraphicControl;
     newColor:boolean;
     oldcolor:Tcolor;
     Inited:boolean;
     skinstate : integer;
     skinform: Tcomponent;
     kind :integer;
     sizing:boolean;
     parentbk: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;
     function GetParentColor(acolor:Tcolor):Tcolor;
     function CheckBiDi(dw:dword):dword;
  end;

  TArrowButton = Class(TCustomControl)
  private
    procedure WMLButtonDown(Var aMsg: TMessage);message WM_LButtonDown;
    procedure WMLButtonUP(Var aMsg: TMessage);message WM_LButtonUP;
//    procedure WMERASEBKGND(var Msg: TMessage);message WM_ERASEBKGND;
    procedure CMMouseEnter(Var aMsg: TMessage);message CM_MOUSEENTER;
    procedure CMMouseLeave(Var aMsg: TMessage);message CM_MOUSELEAVE;
  protected
    procedure Paint; override;
  public
    cw:integer;
    control:TWincontrol;
    obj:TSkinControl;
    hwnd :Thandle;
    state : set of TSkinControlState;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Attach(aobj:Tskincontrol;acontrol:Twincontrol);
  end;

  TSkinDateTime = Class(TSkinControl)
  private
  protected
     arrow:TArrowButton;
     procedure DrawControl( dc:HDC; rc:TRect);override;
  public
     destructor Destroy; override;
     procedure Init(sf:Tcomponent;sd:TSkinData;acanvas:TCanvas;acolor:boolean=false);override;
  end;

  TWScrollbar = Class(TCustompanel)
  private
    procedure WMLButtonDown(Var aMsg: TMessage);message WM_LButtonDown;
    procedure WMMouseMove(Var aMsg: TMessage);message WM_MouseMove;
    procedure WMMouseLeave(Var aMsg: TMessage);message WM_MouseLeave;
    procedure WMLButtonDBClick(Var aMsg: TMessage);message WM_LBUTTONDBLCLK;
    procedure WMLButtonUp(Var aMsg: TMessage);message WM_LButtonUp;
    procedure WMERASEBKGND(var Msg: TMessage);message WM_ERASEBKGND;
  protected
    Len:Integer;
    thumbTop,thumbbottom:integer;
    OffsetSC,trackp:tpoint;
    trackthumb:integer;
    fdown:boolean;
    sbDir:integer;
    ERASEBKGND:boolean;
    scrollpos:integer;
    procedure Paint; override;
    procedure GetThumb(rc:TRect);
    function GetScrollPos(p:Tpoint):integer;
    function GetControlInfo(var info:tagScrollBarInfo):boolean;
    function GetControlInfo2(var info:tagScrollBarInfo):boolean;
    procedure CreateParams(var Params: TCreateParams);override;
  public
    CW:integer;
    hwnd:Thandle;
    control:TWincontrol;
    obj:TSkinControl;
    sbType:byte;
    sbRect:Trect;
//    scrollpos:integer;
    sbVisible:boolean;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Attach(aobj:TSkinControl;aControl:Twincontrol;aType:byte);
    procedure AttachHwnd(aobj:TSkinControl;ahwnd:Thandle;aType:byte);
    procedure SetPosition(ahwnd:Thandle);
    procedure ButtonUp;
    procedure HideScrollbar;
    procedure DoLog(Message: TMessage);
  end;

  TSkinButton = class(TSkinControl)
  Protected
     btemp:Tbitmap;
     MultiLine:boolean;
     trans:boolean;
     redraw:boolean;
     isdefault:boolean;
     procedure DrawBtnText(acanvas: TCanvas; rc:TRect;
               text:String; Alignment:word=DT_CENTER);
     procedure DoMouseDown(var Message: TWMMouse);
     procedure WMEnable(var Message: TMessage);
     procedure SetRedraw(b:boolean);
  public
     constructor Create(AOwner: TComponent); override;
     destructor Destroy; override;
     Procedure Init(sf:Tcomponent;sd:TSkinData;acanvas:TCanvas;acolor:boolean=false);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);
     procedure DrawPicControl( dc:HDC; rc:TRect);
  public
     isPicture:boolean;
     PicField:string;
     procedure DrawControl( dc:HDC; rc:TRect);override;
  end;

  TMPBtnType = (btPlay, btPause, btStop, btNext, btPrev, btStep, btBack,
    btRecord, btEject);
  TButtonSet = set of TMPBtnType;
  TMPGlyph = (mgEnabled, mgDisabled, mgColored);
  TMPButton = record
    Visible: Boolean;
    Enabled: Boolean;
    Colored: Boolean;
    Auto: Boolean;
    Bitmaps: array[TMPGlyph] of TBitmap;
  end;

  TWMediaPlayer = Class(TCustompanel)
  private
    procedure WMLButtonDown(Var aMsg: TMessage);message WM_LButtonDown;
//    procedure WMMouseMove(Var aMsg: TMessage);message WM_MouseMove;
//    procedure WMMouseLeave(Var aMsg: TMessage);message WM_MouseLeave;
//    procedure WMLButtonDBClick(Var aMsg: TMessage);message WM_LBUTTONDBLCLK;
    procedure WMLButtonUp(Var aMsg: TMessage);message WM_LButtonUp;
//    procedure WMERASEBKGND(var Msg: TMessage);message WM_ERASEBKGND;
     procedure LoadBitmaps;
     procedure DestroyBitmaps;
     procedure CheckButtons;
     procedure FindButton(XPos, YPos: Integer);
  protected
     Buttons: array[TMPBtnType] of TMPButton;
     count:integer;
     fsd:TSkinData;
     IsDown:boolean;
     BtnClick: TMPBtnType;
     BtnFocuse: TMPBtnType;
     BtnWidth: integer;
     procedure Paint;override;
     procedure DrawButton(acanvas:Tcanvas;Btn:TMPBtnType;R:TRect);
  public
     obj:TWincontrol;
     skincontrol:TSkincontrol;
     constructor Create(AOwner: TComponent); override;
     destructor Destroy; override;
     procedure Attach(askin:TSkinControl;aObj:Twincontrol);
     procedure SetPosition(aObj:Twincontrol);
  end;

  TSkinMP = class(TSkinControl)
  Protected
     mp:TWMediaPlayer;
//     Buttons: array[TMPBtnType] of TMPButton;
//     procedure LoadBitmaps;
//     procedure DestroyBitmaps;
//     procedure DrawGlyph( acanvas:Tcanvas; rc:TRect;
//       bmp:Tbitmap;I,N:integer);
    procedure Unsubclass;override;
    procedure AfterProc(var Message: TMessage);override;
  public
//     constructor Create(AOwner: TComponent); override;
//     destructor Destroy; override;
     Procedure Init(sf:Tcomponent;sd:TSkinData;acanvas:TCanvas;acolor:boolean=false);override;
//     procedure DrawControl( dc:HDC; rc:TRect);override;
  end;

  TSkinMenuButton = 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
     FReentr : Boolean;  // RF: flag for reentrancy
  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;
     procedure WMPaintSpeed(var Message:Tmessage);
  end;

  TSkinCheckBox = class(TSkinControl)
  Protected
     state:integer;
     trans:boolean;
  public
     function BeforeProc(var Message: TMessage):boolean;override;
     procedure AfterProc(var Message: TMessage);override;
     procedure DrawControl( dc:HDC; rc:TRect);override;
     Procedure Init(sf:Tcomponent;sd:TSkinData;acanvas:TCanvas;acolor:boolean=false);override;
  end;

  TComboxScrollBar=class;
  TSkinScrollbarH=class;
  TSkinComBox = class(TSkinControl)
  Protected
     dwStyle,ExStyle:longword;
     hlist,hbtn:Thandle;
     isDrop:boolean;
//     box :Tskinscrollbar;
     FBtnObjectInst,FBtnPrevWndProc :pointer;
     vb:TSkinScrollbarH;
     db:TComboxScrollBar;
     info:tagCOMBOBOXINFO;
     rBtn:TRect;
     procedure FindBtn;
     procedure DrawSkinMap3( dc:HDC; rc:TRect;
        bmp:Tbitmap;I,N:integer);
     procedure DrawControl1( dc:HDC; rc:TRect);
     procedure ButtonProc(var Message: TMessage);
     procedure CNCommand(var Message: TWMCommand);
//     procedure FindScrollbar;
     procedure Unsubclass;override;
     procedure DrawEdit( dc:HDC; rc:TRect);
     procedure SkinDropList;
     procedure DeleteDropList;
  public
     constructor Create(AOwner: TComponent); override;
     destructor Destroy; override;
     procedure AfterProc(var Message: TMessage);override;
     procedure DrawControl( dc:HDC; rc:TRect);override;
     Procedure Init(sf:Tcomponent;sd:TSkinData;acanvas:TCanvas;acolor:boolean=false);override;
     Procedure Inithwnd(ahwnd:Thandle;sd:TSkinData;acanvas:TCanvas;sf:Tcomponent);override;
  end;

  TSkinRadioButton = class(TSkinControl)
  Protected
     trans:boolean;
  public
     procedure Init(sf:Tcomponent;sd:TSkinData;acanvas:TCanvas;acolor:boolean=false);override;
     procedure AfterProc(var Message: TMessage);override;
     function BeforeProc(var Message: TMessage):boolean;override;
     procedure DrawControl( dc:HDC; rc:TRect);override;
  end;

  TSkinStatusBar = class(TSkinControl)
  Protected
     procedure Defaultpaint(acanvas:Tcanvas; 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;
     procedure Init(sf:Tcomponent;sd:TSkinData;acanvas:TCanvas;acolor:boolean=false);override;
     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);
     procedure DrawBackGround(msg:Tmessage);
  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
     CloseRect: array of TRect;
     Position:TSkinTabPosition;
     unicode:boolean;
     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);
     procedure drawCloseBtn(rc:TRect;i:integer);
     function BeforeProc(var Message: TMessage):boolean;override;
//     procedure AfterProc(var Message: TMessage);override;
     function ClickClose(var Message: TMessage):boolean;