⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 winskinform.pas

📁 一个仓库管理软件系统
💻 PAS
📖 第 1 页 / 共 5 页
字号:
end;

procedure TWinSkinForm.DeleteSysbtn;
var i:integer;
begin
  for i:= 0 to high(SysBtn) do SysBtn[i].free;
  setlength(sysbtn,0);
end;

procedure TWinSkinForm.DeleteControl(c:TSkinControl);
var i:integer;
begin
  if controllist=nil then exit;
  for i:= controllist.count-1 downto 0 do begin
     if Controllist.items[i]=c then begin
       controllist.delete(i);
       break;
     end;
  end;
end;

procedure TWinSkinForm.DeleteSkinDeleted;
var i:integer;
    c:TSkinControl;
begin
  for i:= controllist.count-1 downto 0 do begin
     c:=TSkinControl(Controllist.items[i]);
     if c.skinstate=skin_deleted then begin
        controllist.delete(i);
        c.free;
     end;
  end;
end;

procedure TWinSkinForm.DeleteControls;
var i:integer;
    c:TSkinControl;
    acontrol:Tcontrol;
begin
//  for i:= controllist.count-1 to 0 do begin
  while controllist.count>0 do begin
     c:=TSkinControl(Controllist.items[0]);
     if (c.control<>nil) and (c.control is TToolbar) then
        Ttoolbar(c.control).OnCustomDrawButton:=nil;
     if c.skinstate<>skin_deleted then c.unsubclass;
     controllist.delete(0);
     c.free;
  end;
  controllist.clear;
end;

function TWinSkinForm.AddControlList(acontrol:TSkinControl):boolean;
var i:integer;
    c:TSkinControl;
    b:boolean;
begin
  b:=false;
  for i:= 0 to controllist.count-1 do begin
     c:=TSkinControl(Controllist.items[i]);
     if c=acontrol then begin
        b:=true;
        break;
     end;
  end;
  if not b then controllist.add(acontrol);
  result:=b;
end;

procedure TWinSkinForm.CreateCaptionFont;
var
  NonClientMetrics: TNonClientMetrics;
begin
  If Assigned(CaptionFont) then FreeAndNIL(CaptionFont);
  CaptionFont := TFont.Create;
  NonClientMetrics.cbSize := SizeOf(NonClientMetrics);
  if SystemParametersInfo(SPI_GETNONCLIENTMETRICS, 0, @NonClientMetrics, 0) then
    CaptionFont.Handle := CreateFontIndirect(NonClientMetrics.lfCaptionFont);

end;

procedure TWinSkinForm.changemdistyle;
var Style: Longint;
begin
    if fform.clienthandle<>0 then begin
      Style := GetWindowLong(fform.ClientHandle, GWL_STYLE);
      Style := Style and not WS_VSCROLL and not WS_HSCROLL;
      SetWindowLong(fform.ClientHandle, GWL_STYLE, Style);

      Style := GetWindowLong(fform.ClientHandle, GWL_EXSTYLE);
      Style := Style and not WS_EX_CLIENTEDGE;
      SetWindowLong(fform.ClientHandle, GWL_EXSTYLE, Style);
      SetWindowPos(fform.ClientHandle, 0, 0,0,0,0, SWP_FRAMECHANGED or SWP_NOACTIVATE or
      SWP_NOMOVE or SWP_NOSIZE or SWP_NOZORDER);
    end;
end;

procedure TWinSkinForm.SetActive(const Value: boolean);
begin
end;

procedure TWinSkinForm.InitTform(afsd:Tskindata;aform:Tform);
begin
   fform:=aform;
   fform.autoscroll:=false;
   if (xcMainMenu in afsd.SkinControls) then begin
      OldWndProc:= fform.WindowProc;
      fform.WindowProc := NewWndProc;
   end;
   InitSkin(afsd);
   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.InitSkin(afsd:Tskindata);
var Exdwstyle:Dword;
    r1,r2:Trect;
begin
{  if not (xcMainMenu in afsd.SkinControls) then begin
     InitSkin2(afsd);
     exit;
  end;}
  if (FObjectInst=nil) Then begin
    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;
    hsysmenu:=GetSystemMenu(hWnd, FALSE);
    geticon(iconbmp);
//    caption := 'VCLSkin Demo';//getformcaption(hwnd);
    classname:=getwindowclassname(hwnd);

    parenthwnd:=GetWindow(hWnd, GW_OWNER);

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

    createsysmenu;
    getwindowstate;
    fsizeable := (dwstyle and WS_SIZEBOX)>0;
    GetFormstyle;
    if (Exdwstyle and ws_ex_mdichild)>0 then begin
      formstyle:=sfsMDIChild;
    end;

//    formborder := sbsDialog;
    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 pos('.UnicodeClass',classname)>0 then isunicode:=true
    else isunicode:=false;
       
    if classname='#32770' then formborder := sbsDialog;
    if classname='TMessageForm' then formborder := sbsDialog;

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

  if (xcMainMenu in afsd.SkinControls) 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;

    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 (formstyle=sfsmdichild) and (windowstate=swsmax) and (not skinmanager.mdimax) then
       skinmanager.setmdimax(true);
    if fform<>nil then
       InitControls(fform)
    else InitHwndControls;
  {$IFDEF test}
    SkinAddLog(format('%s skin active %1x',[caption,hwnd]));
  {$ENDIF}
   InvalidateRect(hwnd, 0,true);
  end;
end;

procedure TWinSkinForm.InitSkin2(afsd:Tskindata);
begin
    fsd:=afsd;
    timer:=TTimer.create(self);
    timer.Interval:=250;
    timer.Ontimer:=Ontimer;
    timer.enabled:=false;

    classname:=getwindowclassname(hwnd);
    GetFormstyle;
    if formstyle=sfsmdiform then
       subclassMDI;

    InitSkinData;
    if fform<>nil then
       InitControls(fform)
    else InitHwndControls;
//    InvalidateRect(hwnd, 0,true);
//    Refresh;
//  SetWindowPos(hwnd, 0, 0, 0, 0, 0,
//    SWP_NOCOPYBITS or SWP_NOACTIVATE or SWP_NOMOVE or SWP_NOSIZE or SWP_NOZORDER);

  {$IFDEF test}
    SkinAddLog(format('%s skin active %1x',[caption,hwnd]));
  {$ENDIF}
end;

procedure TWinSkinForm.EnableSysbtn(b:boolean);
var dwstyle:Dword;
begin
    //mdichildmax has all sysbtn
    if (formstyle=sfsmdichild) and (skinmanager.mdimax)
       and (not b) then exit;

    hassysbtn:=b;
    dwstyle := GetWindowLong( hwnd, GWL_STYLE );
    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;   }
      if (parenthwnd<>0) or (formstyle=sfsmdichild) then begin
          dwstyle := dwstyle and (not WS_MINIMIZEBOX);
          dwstyle := dwstyle and (not WS_MAXIMIZEBOX);
          dwstyle := dwstyle and ( not WS_SYSMENU);
      end else begin
          formicons := formicons + [sbicaption];
          dwstyle := dwstyle and ( not WS_CAPTION);
      end;
// {$IFnDEF taskbar}
// {$else}
// {$ENDIF}
    end;
    SetWindowLong( hwnd, GWL_STYLE, dwstyle );
end;

procedure TWinSkinForm.SubclassMDI;
begin
    FMDIObjectInst := MakeObjectInstance(WinMDIProc);
    FMDIWndProc := Pointer(GetWindowLong(Clienthwnd,GWL_WNDPROC));
    SetWindowLong(Clienthwnd, GWL_WNDPROC,LongInt(FMDIObjectInst));
end;

procedure TWinSkinForm.UnSubclassMDI;
begin
    if FMDIObjectInst<>nil then begin
       SetWindowLong(Clienthwnd, GWL_WNDPROC,LongInt(FMDIWndProc));
       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('Shift+F4');
   Sysmenu.Items.Add(item);
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;
begin
   if windowstate<>swsmax then begin
     GetWindowRect(hwnd,r2);
     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;
             //fClientRect.right:=fform.ClientWidth;
         end;
         h:=fClientRect.bottom+bw.top+bw.bottom+menuheight;
     end else begin
        GetClientRect(hwnd,fClientRect);
        h:=fClientRect.bottom+bw.top+bw.bottom + menuheight;
     end;

     if ((classname='TMessageForm') or (classname='#32770'))
        and (i=0) then begin
        caption := getformcaption(hwnd);
        FDC := GetWindowDC(hwnd);
        acanvas:=Tcanvas.create;;
        acanvas.Handle := fdc;
        acanvas.font := CaptionFont;
        charwidth :=  acanvas.Textwidth(caption);
        acanvas.free;
        ReleaseDc(hwnd,fdc);

//        minwidth := (length(caption))*charwidth+bw.Left+bw.Right+
//                    fsd.title.r.left+fsd.title.r.right;
//                    +fsd.title.backleft+fsd.title.backright;
        minwidth := charwidth+fsd.title.r.left+fsd.title.r.right;

        if w<minwidth then begin
          w2:=(minwidth-w) div 2;
          hCtrl := GetTopWindow( hWnd );
          while ( hCtrl<>0 ) do begin
              temp := GetNextWindow( hCtrl, GW_HWNDNEXT );
              GetWindowRect(hCtrl,r3);
              p:=point(r3.Left,r3.Top);
              screentoclient(hwnd,p);
              SetWindowPos(hCtrl, 0, p.X+w2, p.y,
                           r3.right-r3.Left,r3.Bottom-r3.Top,
                           SWP_NOSENDCHANGING or SWP_NOOWNERZORDER );
              hCtrl := temp ;
          end;
          w:=minwidth;
        end;
     end;

     SetWindowPos(hwnd, 0, r2.left, r2.top, w, h,
       SWP_NOMOVE or SWP_DRAWFRAME or SWP_NOZORDER );
//       SWP_NOREDRAW or SWP_NOMOVE or SWP_NOZORDER );
   end else Refresh;
end;

procedure TWinSkinForm.RePaint(ahwnd:Thandle);
var w,h:integer;
    r,r2:Trect;
begin
//   GetWindowRect(ahwnd,r2);
//   SetWindowPos(ahwnd, 0, r2.left, r2.top, r2.right-r2.left, r2.bottom-r2.top,
//       SWP_DRAWFRAME or SWP_NOZORDER or SWP_NOACTIVATE);

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -