winskinform.pas

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

//   if (xcMainMenu in afsd.SkinControls) then begin
   if sMainMenu then begin   //for midchild border 
      OldWndProc:= fform.WindowProc;
      fform.WindowProc := NewWndProc;
   end;
   formcolor:=aform.color;
   aform.color:= afsd.colors[csButtonFace];
//   if (xcPopupMenu in afsd.SkinControls) then
//     InitPopMenu(aForm,true,false);
   if (xcMenuitem in afsd.SkinControls) then
     InitMainMenu(aForm,true,false);
end;

procedure TWinSkinForm.GetBorderSize;
var r1,r2:Trect;
begin
    GetClientRect(hwnd,fClientRect);
    getwindowrect(hwnd,r1);
    GetClientRect(hwnd,r2);
    oldsize:=rect(0,0,r1.right-r1.left-(r2.right-r2.left),
                     r1.bottom-r1.top-(r2.bottom-r2.top));
end;

procedure TWinSkinForm.InitSkin(afsd:Tskindata);
var Exdwstyle:Dword;
    r1,r2:Trect;
    cw:integer;
begin
  if (FObjectInst=nil) Then begin
    skinmanager.state:=skin_Active;
    fsd:=afsd;
    timer:=TTimer.create(self);
    timer.Interval:=250;
    timer.Ontimer:=Ontimer;
    timer.enabled:=false;
//    CreateCaptionFont;
    sMainMenu := xcMainMenu in fsd.SkinControls;
    dwstyle := GetWindowLong( hwnd, GWL_STYLE );
    ExdwStyle := GetWindowLong(hwnd, GWL_EXSTYLE);
    bidileft := (exdwstyle and WS_EX_LEFTSCROLLBAR)>0;
    ischildform :=   (dwstyle and ws_child)>0;
//    hsysmenu:=GetSystemMenu(hWnd, FALSE);
//    geticon(iconbmp);
    classname:=getwindowclassname(hwnd);
    parenthwnd:=GetWindow(hWnd, GW_OWNER);

//    GetBorderSize;
{    GetClientRect(hwnd,fClientRect);
    getwindowrect(hwnd,r1);
    GetClientRect(hwnd,r2);
    oldsize:=rect(0,0,r1.right-r1.left-(r2.right-r2.left),
                     r1.bottom-r1.top-(r2.bottom-r2.top));}

    formicons:=[];
    if ((dwstyle and WS_SYSMENU)>0) or (hsysmenu>0) then
      formicons:=formicons+[sbisystem];
    if (dwstyle and WS_MINIMIZEBOX)>0 then
      formicons:=formicons+[sbimin];
    if (dwstyle and WS_MAXIMIZEBOX)>0 then
      formicons:=formicons+[sbimax];

//    createsysmenu2;
    getwindowstate;
    fsizeable := (dwstyle and WS_SIZEBOX)>0;
    GetFormstyle;
    if (Exdwstyle and ws_ex_mdichild)>0 then begin
      formstyle:=sfsMDIChild;
      if (xoMDIChildBorder in fsd.Options) then
         sMainMenu := false;
    end ;//{ else ShowWindow(hwnd,SW_HIDE)};
//MDIchild window menu has problem

    formborder := sbsSingle;
    if {((dwstyle and WS_popup)>0) and}
       ((dwstyle and WS_Caption)<>WS_Caption) then
       formborder:=sbsnone
    else if ((dwstyle and WS_THICKFRAME)>0) or
//       ((ExdwStyle and WS_EX_WINDOWEDGE)>0) or
       //( formstyle=sfsMDIChild ) or
       ((dwstyle and WS_SIZEBOX)>0) then
       formborder:=sbsSizeable
    else if ((dwstyle and DS_MODALFRAME)>0) then
       formborder := sbsDialog;

    if (ExdwStyle and ws_EX_dlgmodalframe)>0 then
       formborder := sbsDialog ;

    if ((ExdwStyle and WS_EX_APPWINDOW)>0)
       and (Win32Platform = VER_PLATFORM_WIN32_NT)
       and (Win32MajorVersion>=5) and (Win32MinorVersion =0) then
          formicons := formicons + [sbicaption];
    if ((parenthwnd=0) and (formstyle<>sfsmdichild))
       and (Win32MajorVersion>=5) and (Win32MinorVersion =0) then
          formicons := formicons + [sbicaption];

    isunicode:=IsWindowUnicode(hwnd);

    ismessagebox:=false;
    if (classname='#32770') or (classname='TMessageForm') then begin
       formborder := sbsDialog;
       ismessagebox:=true;
    end;

    //    lockwindowupdate(hwnd);
    StopUpdate;

 {$IFDEF demo}
//    setproperty(fform,'Caption',' ');
 {$endif}
 
   if (winversion >= $80000000) then
        fsd.skincontrols:=fsd.skincontrols-[xcSystemMenu];

    if formstyle=sfsmdiform then begin
       menuauto:=fsd.menuUpdate;
       subclassMDI;
    end;

    FObjectInst := MakeObjectInstance(WinWndProc);
    if isunicode then begin
       FPrevWndProc := Pointer(GetWindowLongw(hwnd,GWL_WNDPROC));
       SetWindowLongw(hwnd, GWL_WNDPROC,LongInt(FObjectInst));
    end else begin
       FPrevWndProc := Pointer(GetWindowLong(hwnd,GWL_WNDPROC));
       SetWindowLong(hwnd, GWL_WNDPROC,LongInt(FObjectInst));
    end;

  if sMainMenu then begin
    hmenu:=GetMenu(hWnd);
    if (hmenu<>0) and (formstyle<>sfsMDIChild) then begin
       menu:=TWinSkinMenu.create(self);
       menu.fsd:=fsd;
       Menu.sf := self;
       MenuHeight := GetSystemMetrics(SM_CYMENU);
//***************
       if fform<>nil then menu.menu:= fform.menu;
       menu.UpdataBtn;
    end;
    if ((formstyle<>sfsmdichild) or (not skinmanager.mdimax)) and (windowstate<>swsmin) then
      EnableSysbtn(false);
    InitSkinData;
  end else skinstate := skin_active;

   cw:= GetSystemMetrics(SM_CYCAPTION)+GetSystemMetrics(SM_CXFRAME);
//   if (menuheight=0) and (cw>bw.top) then
   if (formstyle=sfsMDIChild) and (cw>bw.top) then
        menuheight := cw-bw.Top;


//  setmdimax if mainmenu is nil
    if (formstyle=sfsmdichild) and (windowstate=swsmax) and (not skinmanager.mdimax) then
       skinmanager.setmdimax(true);

{    if fform<>nil then
       InitControls(fform)
    else InitHwndControls(hwnd);}
    
  {$IFDEF test}
    SkinAddLog(format('%s skin active %1x',[caption,hwnd]));
  {$ENDIF}
//   InvalidateRect(hwnd, 0,true);
  end;
end;

procedure TWinSkinForm.EnableSysbtn(b:boolean);
var exstyle:Dword;
    b2:boolean;
begin
    if sbicaption in formicons then begin
          dwstyle := GetWindowLong( hwnd, GWL_STYLE );
          if b then dwstyle := dwstyle or WS_CAPTION
          else dwstyle := dwstyle and (not WS_CAPTION);
          SetWindowLong( hwnd, GWL_STYLE, dwstyle );
    end;
    exit;
    //mdichildmax has all sysbtn
    if (formstyle=sfsmdichild) and (skinmanager.mdimax)
       and (not b) then exit;

    //embed form unskin, exit
    if b and (formstyle<>sfsmdichild) and (ischildform) then exit;

    hassysbtn:=b;
    dwstyle := GetWindowLong( hwnd, GWL_STYLE );
    ExStyle := GetWindowLong(hwnd, GWL_EXSTYLE);
    if b then begin
      if sbisystem in formicons then
       dwstyle := dwstyle or WS_SYSMENU;
      if sbimin in formicons then
       dwstyle := dwstyle or WS_MINIMIZEBOX;
      if sbimax in formicons then
       dwstyle := dwstyle or WS_MAXIMIZEBOX;
      if sbicaption in formicons then
          dwstyle := dwstyle or WS_CAPTION;
    end else begin
{      if (parenthwnd=0) or (formstyle=sfsmdiform) then begin
          formicons := formicons + [sbicaption];
          dwstyle := dwstyle and ( not WS_CAPTION);
      end else begin
          dwstyle := dwstyle and (not WS_MINIMIZEBOX);
          dwstyle := dwstyle and (not WS_MAXIMIZEBOX);
          dwstyle := dwstyle and ( not WS_SYSMENU);
      end;   }

      b2:=false;
      if ((parenthwnd=0) and (formstyle<>sfsmdichild)) then b2:=true
      else if (exstyle and WS_EX_APPWINDOW>0) then b2:=true;

      if b2 and (Win32Platform = VER_PLATFORM_WIN32_NT)
         and (Win32MajorVersion>=5) and (Win32MinorVersion >= 1) then b2:=false;

      if b2 then begin
          formicons := formicons + [sbicaption];
          dwstyle := dwstyle and ( not WS_CAPTION);
      end else begin
          dwstyle := dwstyle and (not WS_MINIMIZEBOX);
          dwstyle := dwstyle and (not WS_MAXIMIZEBOX);
          dwstyle := dwstyle and ( not WS_SYSMENU);
      end;
    end;
    SetWindowLong( hwnd, GWL_STYLE, dwstyle );
end;

procedure TWinSkinForm.SubclassMDI;
var  MDIunicode:boolean;
begin
    MDIunicode:=false;
    FMDIObjectInst := MakeObjectInstance(WinMDIProc);
    if MDIunicode then begin
       FMDIWndProc := Pointer(GetWindowLongw(Clienthwnd,GWL_WNDPROC));
       SetWindowLongw(Clienthwnd, GWL_WNDPROC,LongInt(FMDIObjectInst));
    end else begin
       FMDIWndProc := Pointer(GetWindowLong(Clienthwnd,GWL_WNDPROC));
       SetWindowLong(Clienthwnd, GWL_WNDPROC,LongInt(FMDIObjectInst));
    end;
end;

procedure TWinSkinForm.UnSubclassMDI;
var  MDIunicode:boolean;
begin
    if FMDIObjectInst<>nil then begin
       MDIunicode:=false;
       if MDIunicode then begin
          SetWindowLongw(Clienthwnd, GWL_WNDPROC,LongInt(FMDIWndProc));
       end else begin
          SetWindowLong(Clienthwnd, GWL_WNDPROC,LongInt(FMDIWndProc));
       end;
       FreeObjectInstance(FMDIObjectInst);
       FMDIObjectInst:=nil;
    end;
end;

procedure TWinSkinForm.DefaultMDI(Var Msg: TMessage);
begin
  msg.result:=CallWindowProc(FMDIWndProc,Clienthwnd,Msg.msg,msg.WParam,msg.LParam);
end;

procedure TWinSkinForm.AddSysMenuitem(acaption:string;action:integer);
var item:Tmenuitem;
begin
   Item := TMenuItem.Create(sysmenu);
   item.Caption := acaption;
   item.Tag:=action;
   item.onclick:=dosysmenu;
   item.OnDrawItem := DrawMenuItem;
   item.OnMeasureItem := MeasureItempop;
   item.ImageIndex :=action;
   if action=3 then
   item.ShortCut := TextToShortCut('ALT+F4');
   Sysmenu.Items.Add(item);
end;

procedure TWinSkinForm.CreateSysmenu2;
var i,n,j:integer;
    mi:TMenuItemInfo;
    Buffer: array[0..79] of Char;
    item:Tmenuitem;
    s:string;
begin
   if  sysmenu<>nil then begin
      sysmenu.free;
      sysmenu:=nil;
   end;

  if (Win32Platform = VER_PLATFORM_WIN32_NT) and (Win32MajorVersion <5) then begin
     CreateSysmenu;
     exit;
  end;

  if hsysmenu = 0 then exit;

  n:= GetMenuItemCount(hsysmenu);
  sysmenu:=Tpopupmenu.create(self);
  sysmenu.Tag:=c_skintag;
  sysmenu.OwnerDraw := true;
  sysmenu.Images:=fsd.bmpmenu;

  for i:= 0 to n-1 do begin
       fillchar(mi,sizeof(mi),#0);
       mi.cbSize:= sizeof(TMENUITEMINFO);
       mi.fMask	:= MIIM_ID or  MIIM_STATE or MIIM_STRING;
       mi.fType := 0;
       mi.dwTypeData := Buffer;
       Mi.cch := SizeOf(Buffer);
       GetMenuItemInfo(hsysmenu, i, TRUE, mi);
       s:= buffer;

      Item := TMenuItem.Create(sysmenu);
      if s='' then item.Caption:= '-'
      else item.Caption := s;
      item.Tag:= mi.wID;
      case mi.wID of
        SC_MAXIMIZE: begin
            item.ImageIndex :=1;
            item.enabled:= (windowstate<>swsmax) and (sbimax in formicons);
          end;
        SC_MINIMIZE: begin
            item.ImageIndex :=2;
            item.enabled:= (windowstate<>swsmin) and (sbimin in formicons);
          end;
        Sc_Restore : begin
            item.ImageIndex :=0;
            item.enabled:= (windowstate<>swsnormal) ;
          end;
        SC_MOVE,SC_SIZE: begin
              item.enabled:= (windowstate<>swsmax) ;
          end;
        SC_CLOSE : item.ImageIndex :=3;
        else  item.ImageIndex :=-1;
      end;
      item.onclick:=dosysmenu2;

      if mi.fState=3 then item.Enabled:=false;
      if (mi.fState and MFS_CHECKED)>0 then item.Checked:=true;
      //item.Enabled :=  not ((mi.fState and $0ff) = MFS_DISABLED);
      item.OnDrawItem := DrawMenuItem;
      item.OnMeasureItem := MeasureItempop;
      Sysmenu.Items.Add(item);
  end;
end;

function  TWinSkinForm.CheckSysmenu:boolean;
var i,n,j:integer;
    mi:TMenuItemInfo;
    Buffer: array[0..79] of Char;
begin
  result:=true;
  if (Win32Platform = VER_PLATFORM_WIN32_NT) and (Win32MajorVersion <5) then begin
     exit;
  end;

  if winversion >= $80000000 then
     exit;
 
  fillchar(mi,sizeof(mi),#0);
  mi.cbSize:= sizeof(TMENUITEMINFO);
  mi.fMask	:= MIIM_STATE ;
  mi.fType := 0;
  mi.dwTypeData := Buffer;
  Mi.cch := SizeOf(Buffer);
  result:=GetMenuItemInfo(hsysmenu, SC_CLOSE, false, mi);
end;

procedure TWinSkinForm.CreateSysmenu;
begin
   if  sysmenu<>nil then begin
      sysmenu.free;
      sysmenu:=nil;
   end;
   sysmenu:=Tpopupmenu.create(self);
   sysmenu.Tag:=c_skintag;
   sysmenu.OwnerDraw := true;
   sysmenu.Images:=fsd.bmpmenu;
   AddSysMenuitem(' Restore ',0);
   if sbimax in formicons then AddSysMenuitem(' Maximize ',1);
   if sbimin in formicons then AddSysMenuitem(' Minimize ',2);
   AddSysMenuitem('-',100);
   AddSysMenuitem(' Close ',3);
end;

procedure TWinSkinForm.ResizeForm(i:integer);
var w,h,minwidth,w2:integer;
    r1,r2,r3:Trect;
    fdc:HDC;
    acanvas:TCanvas;
    hctrl,temp : Thandle;
    p:Tpoint;
    dw:dword;
begin
   dw := SWP_NOMOVE or SWP_DRAWFRAME or SWP_NOZORDER ;
   {if SkinState=skin_change then} dw := dw or SWP_NOACTIVATE ;

   if windowstate<>swsmax then begin
     GetWindowRect(hwnd,r2);
     if (ismessagebox) or (SkinState=skin_change) then GetClientRect(hwnd,fClientRect);

     w:=fClientRect.right+bw.left+bw.right;
     if i=0 then begin
         if fform<>nil then begin
           //fClientRect.bottom:=r2.bottom-r2.top-menuheight-GetSystemMetrics(SM_CYFRAME)*2-GetSystemMetrics(SM_CYCAPTION);
           W := fform.clientWidth + Bw.Left + bw.right;
           fclientrect.Bottom := fform.ClientHeight-menuheight;
           //GetClientRect(hwnd,fClientRect);
           //fClientRect.bottom:=fform.ClientHeight;
           //fClientRect.right:=fform.ClientWidth;
           if  formstyle=sfsMDIChild then fclientrect.Bottom := fclientrect.Bottom+menuheight
         end;
         h:=fClientRect.bottom+bw.top+bw.bottom+menuheight;
     end else begin
        GetClientRect(hwnd,fClientRect);
        h:=fClientRect.bottom+bw.top+bw.bottom + menuheight;
     end;

  {$IFDEF VER170}         // Delphi 9
     //GetClientRect(hwnd,fClientRect);
     //h:=fClientRect.bottom+bw.top+bw.bottom+menuheight;
     //w:=fClientRect.right+bw.left+bw.right;
  {$endif}

     if (ismessagebox) and (i=0) then begin
        caption := getformcaption(hwnd);
        FDC := GetWindowDC(hwnd);