winsubclass.pas

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

end;

Procedure TSkinControl.Inithwnd(ahwnd:Thandle;sd:TSkinData;acanvas:TCanvas;sf:Tcomponent);
begin
   fsd:=sd;
   fCanvas:=acanvas;
   skinform:=sf;
   hwnd := ahwnd;
   enabled:=true;
   Twinskinform(skinform).addcontrollist(self);
   caption:=getformcaption(hwnd);
   FObjectInst := MakeObjectInstance(NewWndProc);
   FPrevWndProc := Pointer(GetWindowLong(hwnd,GWL_WNDPROC));
   SetWindowLong(hwnd, GWL_WNDPROC,LongInt(FObjectInst));
   inited := true;
   skinstate:=skin_active;
end;

Procedure TSkinControl.Unsubclass;
begin
   if newcolor then begin
         Taccontrol(control).color:=oldcolor;
   end;
end;

Procedure TSkinControl.SkinChange;
begin
   if newcolor and (control<>nil) then
     Taccontrol(control).color:=fsd.colors[csButtonFace];
   if hwnd<>0 then
     InvalidateRect(hwnd, 0,true)
   else if GControl<>nil then
      gcontrol.Invalidate;
end;

destructor TSkinControl.Destroy;
var s:string;
begin
{     s:=caption;
     if control<>nil then s:=s+' '+control.ClassName;
     if gcontrol<>nil then s:=s+' '+gcontrol.ClassName;
     skinaddlog('skincontrol destory '+s); }

   if assigned(oldwndproc) then begin
         if control<>nil then Control.WindowProc := OldWndProc;
         oldwndproc:=nil;
   end;
   if fobjectinst<>nil then begin
         SetWindowLong(hwnd, GWL_WNDPROC,LongInt(FPrevWndProc));
         FreeObjectInstance(FObjectInst);
         fobjectinst:=nil;
   end;

   Twinskinform(skinform).DeleteControl(self);
   inherited destroy;
end;

{procedure TSkinControl.NewWndProc(var Message: TMessage);
begin
  done:=false;
  BeforeProc(message);
  if done then exit;
  OldWndProc(Message);
  AfterProc(message);
end;}

procedure TSkinControl.NewWndProc(var Message: TMessage);
var s:string;
begin
  done:=false;
  if BeforeProc(message) then begin
     default(Message);
     AfterProc(message);
  end;
end;

procedure TSkinControl.Default(Var Msg: TMessage);
begin
  if assigned(oldwndproc) then
         OldWndProc(Msg)
  else
     msg.result:=CallWindowProc(FPrevWndProc,hwnd,Msg.msg,msg.WParam,msg.LParam);
end;

procedure TSkinControl.MouseLeave;
begin
  if hwnd>0 then sendmessage(hwnd,CM_MOUSELEAVE,0,0);
//  Twinskinform(owner).activeskincontrol:=nil;
end;

procedure TSkinControl.Invalidate;
var phwnd:Thandle;
    r:Trect;
begin
//  PaintControl;
  phwnd:= getparent(hwnd);
  if getwindowrect(hwnd,r) then begin
    offsetrect(r,-r.left,-r.top);
    if phwnd<>0 then begin
       InvalidateRect(hwnd, @R,false);
       UpdateWindow(hwnd);
    end;
  end;
end;

procedure TSkinControl.PaintControl(adc:HDC=0);
var dc:HDC ;
    rc:TRect;
begin
  if GetWindowRect( hWnd, rc ) then begin;
    try
      boundsrect:=rc;
      OffsetRect( rc, -rc.left, -rc.top );
      if adc=0 then  DC := GetWindowDC( hWnd )
      else dc:=adc;
      try
         Drawcontrol(dc,rc);
      finally
         if adc=0 then ReleaseDC( hwnd, DC );
      end;
    except
    end;
  end;
end;

procedure TSkinControl.FillBG( dc:HDC; rc:TRect);
var  OldBrush,Brush: HBrush;
begin
    Brush := CreateSolidBrush(fsd.colors[csButtonFace]);
    try
      fillrect(dc,rc,brush);
    finally
      DeleteObject(Brush);
    end;
end;

procedure TSkinControl.doLogMsg(aid:string;msg:TMessage);
var s:string;
begin
  {$IFDEF test}
    s:=MsgtoStr(msg);
    if s='' then exit;
    if SkinCanLog then Logstring.add(aid+s);
  {$ENDIF}
end;

procedure TSkinControl.AfterProc(var Message: TMessage);
begin
    case message.msg of
      WM_Paint:
         PaintControl(message.WParam);
{      WM_NCPaint:
         PaintControl(message.WParam);
      WM_Print:
         PaintControl(message.WParam);  }
      WM_KILLFOCUS,WM_SETFOCUS:Invalidate;
//          PaintControl;
      WM_SETTEXT: begin
           caption := strpas(pchar(message.lParam));
           Invalidate;
         end;
      wm_enable,CM_ENABLEDCHANGED:Invalidate;
      WM_NCDESTROY:begin
          //Unsubclass;
         end;
    end;
end;

function TSkinControl.BeforeProc(var Message: TMessage):boolean;
begin
   result:=false;
   case message.msg of
      WM_NCDESTROY:begin
          result:=false;
          default(message);
          skinstate:=skin_deleted;
          Unsubclass;
          //can't free,leave it,until skinform free;
          //         free;
         end;
      else result:=true;
   end;
end;

procedure TSkinControl.DrawControl( dc:HDC; rc:TRect);
begin
end;

function  TSkinControl.GetState:integer;
begin
   result:=1;
end;

function  TSkinControl.GetProperty(aprop:string):string;
var PropInfo:PPropInfo;
    s:string;
    i:integer;
begin
   s:='';
   i:=0;
   if  control<>nil then begin
      PropInfo:=GetPropInfo(control,aprop);
      if PropInfo<>nil then  begin
         if propinfo^.PropType^.Kind= tkEnumeration then
          s:=GetEnumProp(control,PropInfo)
         else if propinfo^.PropType^.Kind = tkInteger then begin
//           i:= GetInt64Prop(control,PropInfo);
           i:=GetOrdProp(control,PropInfo);
           s:=inttostr(i);
         end;
      end;
   end;
   result := s;
end;

function  TSkinControl.GetIntProperty(aprop:string;var i:Longword):boolean;
var PropInfo:PPropInfo;
begin
   result:=false;
   if  control<>nil then begin
      PropInfo:=GetPropInfo(control,aprop);
      if (PropInfo<>nil) and
         (propinfo^.PropType^.Kind = tkInteger) then begin
//           i:= GetInt64Prop(control,PropInfo);
           i:=GetOrdProp(control,PropInfo);
           result:=true;
      end;
   end;
end;

function TSkinButton.BeforeProc(var Message: TMessage):boolean;
 var s:string;
     sf: Twinskinform;
begin
  {$IFDEF buttontest}
    s:= MsgtoStr(message);
    if s<>''  then begin
      s:=format('Button %s %1x %s',[caption,hwnd,s]);
      skinaddlog(s);
    end;
  {$ENDIF}

    result:=true;
    case message.msg of
    WM_LBUTTONDOWN, WM_LBUTTONDBLCLK:
//    WM_LBUTTONDOWN:
      begin
       if not Focused then  begin
        SetFocus(hwnd);
//        if not Focused then Exit;
       end;
       state:=state+[scDown];
       PaintControl(0);
       result:=false;
      end;
    WM_ERASEBKGND:begin
         Message.Result := 1;
         result:=false;
      end;
    wm_paint: begin
        wmpaint(message);
        result:=false;
      end; 
    else result:=inherited beforeProc(message);
    end;
end;

procedure TSkinButton.AfterProc(var Message: TMessage);
var sf:Twinskinform;
begin
    case message.msg of
    CM_MOUSEENTER:
      if Enabled then begin
        state:=state+[scMouseIn];
        Invalidate;
        sf:=Twinskinform(skinform);
        if (sf.activeskincontrol<>self) then
           sf.activeskincontrol:=self;
      end;
    CM_MOUSELEAVE:
      if Enabled then begin
        state:=state-[scMouseIn];
        state:=state-[scDown];
        Invalidate;
        sf:=Twinskinform(skinform);
        if (sf.activeskincontrol=self) then
           sf.activeskincontrol:=nil;
      end;

    WM_MOUSEMove:
      if not (scmousein in state) then begin
        state:=state+[scMouseIn];
        sf:=Twinskinform(skinform);
        if (sf.activeskincontrol<>nil) and
           (sf.activeskincontrol<>self) then
            sf.activeskincontrol.mouseleave;
        if (sf.activeskincontrol<>self) then begin
           Invalidate;
           sf.activeskincontrol:=self;
        end;
      end;

    WM_LBUTTONUP:
      if scDown in state then begin
         state:=state-[scDown];
         Invalidate;
         if control<>nil then TACcontrol(control).Click
         else  postMessage(getparent(hwnd),WM_COMMAND,BN_CLICKED*$100+GetDlgCtrlID(hwnd),hWnd);
         skinaddlog('**Skin button click '+caption);
      end;

    WM_KEYDOWN:
      if Message.WParam = VK_SPACE then begin
       state:=state+[scDown];
       Invalidate;
      end;

    WM_KEYUP:
      if Message.WParam = VK_SPACE then begin
        state:=state-[scDown];
        Invalidate;
      end;
    else inherited AfterProc(message);
    end;
end;

{procedure TSkinButton.DrawControl( dc:HDC; rc:TRect);
var i:integer;
    r1:Trect;
    acolor:Tcolor;
    bfont,cfont:Hfont;
    temp:Tbitmap;
begin
    if fsd.button=nil then exit;
    if fsd.Button.map.empty then exit;
    i:=1;

    temp:=Tbitmap.create;

    Focused := (GetFocus= hWnd);
    enabled := (GetWindowLong(hWnd,GWL_STYLE) and WS_DISABLED)=0;
    caption:=getformcaption(hwnd);
    if (caption='') and (control<>nil) then
      caption:=Taccontrol(control).caption;

    if focused then i:=4;
    if (scDown in state)  then i:=2
    else if (scMouseIn in state) then i:=4;
    if not enabled then i:=3;

    r1:=rc;
    offsetrect(r1,-r1.left,-r1.top);
    temp.width:=r1.right;
    temp.height:=r1.bottom;
    DrawBMPSkin(temp,r1,fsd.button,i,5,fsd.button.Trans);

    bfont:=sendmessage(hwnd,wm_getfont,0,0);
    cfont:=selectobject(temp.canvas.handle,bfont);

    SetTextColor(temp.canvas.handle,fsd.colors[csButtonText]);
    if (i=1) then
       SetTextColor(temp.canvas.handle,fsd.button.normalcolor2);
    if (i=4) then
       SetTextColor(temp.canvas.handle,fsd.button.overcolor2);
    if (i=2) then
       SetTextColor(temp.canvas.handle,fsd.button.downcolor2);
    if not enabled then
      SetTextColor(temp.canvas.handle,COLORREF(clBtnShadow));

    DrawCaption(temp.canvas,r1,caption,enabled,false);
//    DrawBuf( dc,rc);
    BitBlt(dc,rc.left ,rc.top,rc.right-rc.left,rc.bottom-rc.Top,
                 temp.Canvas.Handle ,0 ,0 ,Srccopy);
    selectobject(temp.canvas.handle,cfont);
    temp.Free;
end;}

constructor TSkinButton.Create(AOwner: TComponent);
begin
   inherited create(aowner);
   btemp:=Tbitmap.create;
end;

destructor TSkinButton.Destroy;
begin
   if btemp<>nil then btemp.free;
   btemp:=nil;
   inherited destroy;
end;

procedure TSkinButton.DrawControl( dc:HDC; rc:TRect);
var i:integer;
    r1:Trect;
    acolor:Tcolor;
    bfont,cfont:Hfont;
begin
    if fsd.button=nil then exit;
    if fsd.Button.map.empty then exit;
    i:=1;

    Focused := (GetFocus= hWnd);
    enabled := (GetWindowLong(hWnd,GWL_STYLE) and WS_DISABLED)=0;
    caption:=getformcaption(hwnd);
    if (caption='') and (control<>nil) then
      caption:=Taccontrol(control).caption;

    if focused then i:=4;
    if (scDown in state)  then i:=2
    else if (scMouseIn in state) then i:=4;
    if not enabled then i:=3;

    r1:=rc;
    offsetrect(r1,-r1.left,-r1.top);
    btemp.width:=r1.right;
    btemp.height:=r1.bottom;

    FillBG(btemp.canvas.handle,r1);
    DrawSkinMap( btemp.canvas.handle,r1,fsd.button,I,5);

    bfont:=sendmessage(hwnd,wm_getfont,0,0);
    cfont:=selectobject(btemp.canvas.handle,bfont);
    SetTextColor(btemp.canvas.handle,fsd.colors[csButtonText]);