winsubclass.pas

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

  public
     tabbmp,borderbmp : Tbitmap;
     Drawtemp: Tbitmap;
     updown:TskinUpdown;
     showclose:boolean;
     constructor Create(AOwner: TComponent); override;
     destructor Destroy; override;
     procedure DrawControl( dc:HDC; rc:TRect);override;
//     function  BeforeProc(var Message: TMessage):boolean;override;
     Procedure Init(sf:Tcomponent;sd:TSkinData;acanvas:TCanvas;acolor:boolean=false);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;
     Procedure SkinChange;override;
  end;

  TSkinTabBtn = class(TSkinControl)
  protected
  public
     function BeforeProc(var Message: TMessage):boolean;override;
     procedure DrawControl( dc:HDC; rc:TRect);override;
  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;
     procedure DrawTrack(PDraw:PNMCustomDraw);
  public
     procedure Init(sf:Tcomponent;sd:TSkinData;acanvas:TCanvas;acolor:boolean=false);override;
     procedure skinchange;override;
     procedure Unsubclass;override;
     function BeforeProc(var Message: TMessage):boolean;override;
  end;

  TSkinToolbar = class(TSkinControl)
  Protected
    gradCol1,gradCol2:integer;
//     procedure Drawthumb(PDraw:PNMCustomDraw);
//     function CustomDraw(PDraw:PNMCustomDraw):integer;
     procedure ERASEBKGND(msg:Tmessage);
  public
     function BeforeProc(var Message: TMessage):boolean;override;
     Procedure Init(sf:Tcomponent;sd:TSkinData;acanvas:TCanvas;acolor:boolean=false);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
//      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;

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

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

  TSkinObjImage = class(TSkinControl)
  Protected
     procedure ChangeImage;
     procedure SetRzImage;
     procedure SetRzRadio;
     procedure SetDevCheck;
  public
     kind:integer;
     procedure Init(sf:Tcomponent;sd:TSkinData;acanvas:TCanvas;acolor:boolean=false);override;
     procedure SkinChange; override;
     procedure Unsubclass; override;
  end;

  TSkinAdvPage = class(TSkinControl)
  Protected
     updown:TskinUpdown;
     procedure ChangeImage;
     procedure SetAdvPage;
     function FindScroll:boolean;
  public
     kind:integer;
     procedure Init(sf:Tcomponent;sd:TSkinData;acanvas:TCanvas;acolor:boolean=false);override;
     procedure SkinChange; override;
     procedure Unsubclass; 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
    nobe:boolean;
    procedure AfterProc(var Message: TMessage);override;
    function BeforeProc(var Message: TMessage):boolean;override;
    procedure SetScrollbarPos(message:TMessage);
    procedure Unsubclass;override;
    procedure DrawBorder( dc:HDC; rc:TRect);
    procedure BENCPAINT(adc:HDC);
  public
    hb,vb:TWscrollbar;
    postype:integer;
    painted:boolean;
    border:boolean;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure InitScrollbar(acontrol:Twincontrol;sd:TSkinData;acanvas:TCanvas;sf:Tcomponent);virtual;
    procedure DrawControl( dc:HDC; rc:TRect);override;
    procedure SkinChange; override;
  end;

  TComboxScrollBar = Class(TSkinControl)
  protected
    nobe:boolean;
    cw,len:integer;
    scrollpos:integer;
    thumbtop,thumbBottom:integer;
    OffsetSC,trackp:tpoint;
    trackthumb:integer;
    fdown:boolean;
    sbDir:integer;
    procedure AfterProc(var Message: TMessage);override;
    function BeforeProc(var Message: TMessage):boolean;override;
//    procedure SetScrollbarPos(message:TMessage);
    procedure PaintScrollbar( dc:HDC; rc:TRect; sbtype:integer );
    procedure Unsubclass;override;
    procedure GetThumb(rc:TRect);
    function WMNCPaint(var message:TMessage):boolean;
    function NCLButtonDown(var Message: TMessage):boolean;
  public
    postype:integer;
    painted:boolean;
    border:boolean;
//    Info:array[HB..VB] of SCROLLINFO;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure DrawControl( dc:HDC; rc:TRect);override;
  end;

  TSkinScrollBarH = Class(TSkinControl)
  protected
    procedure AfterProc(var Message: TMessage);override;
    procedure SetScrollbarPos(message:TMessage);
    procedure Unsubclass;override;
  public
    hb,vb:TWscrollbar;
    postype:integer;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Inithwnd(ahwnd:Thandle;sd:TSkinData;acanvas:TCanvas;sf:Tcomponent);override;
    procedure DrawControl( dc:HDC; rc:TRect);override;
  end;

  TSkinScControl = class(TSkinControl)
  protected
     downBtn:integer;
     SP: TScrollBarPos;
     sb:TWscrollbar;
     procedure AfterProc(var Message: TMessage);override;
  public
     procedure DrawControl( dc:HDC; rc:TRect);override;
     procedure InitScrollbar(acontrol:Twincontrol;sd:TSkinData;acanvas:TCanvas;sf:Tcomponent);
     procedure Unsubclass;override;
     destructor Destroy;override;
  end;

{  TSkinSCeControl = class(TSkinControl)
  protected
     sb:TEscrollbar;
     sceControl:Tcontrol;
     procedure AfterProc(var Message: TMessage);override;
  public
     procedure DrawControl( dc:HDC; rc:TRect);override;
     procedure InitScrollbar(acontrol:Twincontrol;ascrollbar:Tcontrol;aType:integer;
                             sd:TSkinData;sf:Tcomponent);
     procedure Unsubclass;override;
  end;}

  TSkinHeader = class(TSkinControl)
  protected
     Items:array of TRect;
     indexitem:integer;
//     trackinfo : TTrackMouseEvent;
     procedure WMMouseMove(var Message: TMessage);
     procedure DrawItem(ImgList:hImageList;acanvas:Tcanvas;rc:Trect;index:Integer);
  public
     destructor Destroy;override;
     procedure Inithwnd(ahwnd:Thandle;sd:TSkinData;acanvas:TCanvas;sf:Tcomponent);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;

  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);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  SetProperty(control: TObject;aprop,value:string);
function StringReplaceW(s,s1,s2:widestring):widestring;
procedure CopyBMP(src:Tbitmap;var dst:Tbitmap);
procedure FillColor( dc:HDC; rc:TRect;acolor:Tcolor);

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);

 //{$R MPLAYER}

implementation
uses ImgUtil,WinSkinForm,winskindlg;

const _maxcaption = 80;

function IsPopupWindow(hwnd:Thandle):boolean;
var style:dword;
begin
   style:= GetWindowLong(hWnd,GWL_STYLE);
   result:=false;
   if (style and ws_popup)>0 then result:=true;
   if GetParent(hWnd)=65556 then result:=true;
end;

procedure CopyBMP(src:Tbitmap;var dst:Tbitmap);
begin
    dst.Width:=src.Width;
    dst.Height:=src.Height;
    dst.PixelFormat:=src.PixelFormat;
    dst.Canvas.Draw(0,0,src);
end;

function GetFormCaption(ahwnd:Thandle):widestring;
var  buf:array[0..1000] of char;
begin
  result:='';
  if Win32PlatformIsUnicode then begin
    SetLength(Result, GetWindowTextLengthW(ahwnd) + 1);
    GetWindowTextW(ahwnd, PWideChar(Result), Length(Result));
    SetLength(Result, Length(Result) - 1);
  end else begin
     sendmessage(ahwnd,WM_GETTEXT,1000,integer(@buf));
     result:=strpas(buf);
  end;
end;

{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;
   kind :=0;
   sizing:=false;
   parentbk:=false;
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;

   isunicode:=IsWindowUnicode(hwnd);
   
   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
      setparentbk(true);
      oldcolor:=Taccontrol(control).color;
      Taccontrol(control).color:=fsd.colors[csButtonFace];
   end;
   if parentbk then kind:=1;

   control.Invalidate;
   inited:=true;
   skinstate:=skin_active;
end;

Procedure TSkinControl.SetColor;
begin
end;

Procedure TSkinControl.SetParentBK(value:boolean);
var  PropInfo:PPropInfo;
     s:string;
begin
{$ifdef DELPHI_7}
     if xoParentBackGround in fsd.options then exit;
     if control=nil then exit;
     PropInfo:=GetPropInfo(control,'ParentBackground');
     if PropInfo<>nil then  begin