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

📄 winskinform.pas

📁 超级报表系统软件VclSkin.v2.60.4.29.完整源代码版.rar
💻 PAS
📖 第 1 页 / 共 5 页
字号:
  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);
var dwstyle:Dword;
begin
  if fsd=nil then begin
    factive:=false;
    exit;
  end;
  if value and not (csDesigning in ComponentState) and (not fsd.empty)
    and (FObjectInst=nil) Then begin
    factive:=true;
    timer:=TTimer.create(self);
    timer.Interval:=250;
    timer.Ontimer:=Ontimer;
    timer.enabled:=false;
    sysmenu:=Tpopupmenu.create(fform);
    CreateCaptionFont;
//    bordericons:= fform.bordericons;
    bordericons:= [];
    dwstyle := GetWindowLong( hwnd, GWL_STYLE );
    fsizeable := (dwstyle and WS_SIZEBOX)>0;
    fmaxable:=  (dwstyle and WS_MINIMIZEBOX)>0;
    fminable:=  (dwstyle and WS_MAXIMIZEBOX)>0;

    dwstyle := dwstyle and (not (WS_MINIMIZEBOX));
    dwstyle := dwstyle and (not WS_MAXIMIZEBOX);
    dwstyle := dwstyle and ( not WS_SYSMENU);
    SetWindowLong( hwnd, GWL_STYLE, dwstyle );
    createsysmenu;

    if fform.borderstyle=bsdialog then begin
        fform.borderstyle:=bssingle;
        bordericons:=[];
    end else begin
       fform.bordericons:=[bimaximize,biminimize];
    end;

    if fform.menu<>nil then begin
       menu:=TWinSkinMenu.create(self);
       menu.menu:= fform.menu;
       menu.fsd:=fsd;
       Menu.sf := self;
       fform.menu:=nil;
       MenuHeight := GetSystemMetrics(SM_CYMENU);
       menu.UpdataBtn;
    end;

    fform.AutoScroll := false;
//    fform.color:=fsd.colors[csButtonFace];

    FObjectInst := MakeObjectInstance(WinWndProc);
    FPrevWndProc := Pointer(GetWindowLong(fform.Handle,
      GWL_WNDPROC));
    SetWindowLong(fform.Handle, GWL_WNDPROC,
      LongInt(FObjectInst));

    OldWndProc:= fform.WindowProc;
    fform.WindowProc := NewWndProc;
  {$IFDEF test}
    SkinAddLog(format('%s skin active %1x',[caption,fform.Handle]));
  {$ENDIF}

    creating:=true;
//    creating:=false;
      initskindata;
      Initmenu(fform,true,true);
//      InitControls(fform,true,true);
//      ResizeForm(0);
//      cropwindow;
  end else factive:=false;
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 (xcMainMenu in afsd.SkinControls) then
     InitMenu(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;

    dwstyle := GetWindowLong( hwnd, GWL_STYLE );
    ExdwStyle := GetWindowLong(hwnd, GWL_EXSTYLE);
    bidileft := (exdwstyle and WS_EX_LEFTSCROLLBAR)>0;
    hsysmenu:=GetSystemMenu(hWnd, FALSE);
    geticon(iconbmp);
    caption := 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;
    if ((dwstyle and WS_popup)>0) and
       ((dwstyle and WS_Caption)<>WS_Caption) then
       formborder:=sbsnone
    else if ((Exdwstyle and ws_ex_windowedge)>0) or
       ((dwstyle and WS_THICKFRAME)>0) or
       ((dwstyle and WS_SIZEBOX)>0) then
       formborder:=sbsSizeable   ;
    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;
  
    FObjectInst := MakeObjectInstance(WinWndProc);
    FPrevWndProc := Pointer(GetWindowLong(hwnd,GWL_WNDPROC));
    SetWindowLong(hwnd, GWL_WNDPROC,LongInt(FObjectInst));

    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 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
         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
        FDC := GetWindowDC(hwnd);
        acanvas:=Tcanvas.create;;
        acanvas.Handle := fdc;
        acanvas.font := CaptionFont;
        charwidth :=  acanvas.Textwidth(' ');
        acanvas.free;
        ReleaseDc(hwnd,fdc);

        caption := getformcaption(hwnd);
        minwidth := (length(caption)+7)*charwidth+bw.Left+bw.Right+
                    fsd.title.r.left+fsd.title.r.right+
                    fsd.title.backleft+fsd.title.backright;
        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);

//  getwindowrect(ahwnd,r);
//  offsetrect(r,-r.left,-r.top);
//  if phwnd<>0 then begin

  InvalidateRect(ahwnd, 0,true);
  UpdateWindow(ahwnd);
end;

function TWinSkinForm.IsScrollControl(acontrol:TComponent):boolean;
var hwnd:Thandle;
    Style:longword;
begin
    result:=false;
    if not (acontrol is Twincontrol) then exit;
    hwnd:=Twincontrol(acontrol).handle;
    Style := GetWindowLong( hWnd, GWL_STYLE );
    if ((Style and WS_HSCROLL)=0) and
       ((Style and WS_VSCROLL)=0) then begin
       if (acontrol is Tlistbox)
          or (acontrol is Tmemo)
          or (acontrol.tag = 55)
//          or (acontrol is Tlistview)
          or (acontrol is TCustomListBox)
          or (acontrol is TCustomTreeView)
//          or (acontrol is TCustomGrid)
          or (acontrol is Tscrollbox) then
          result:=true;
    end else result:=true;
end;

procedure TWinSkinForm.InitMenu(wForm: TWinControl; Enable, Update: boolean );
var
  i, x: integer;
  Comp: TComponent;

  procedure Activate(MenuItem: TMenuItem);
  begin
    if Enable then begin
        if (not assigned(MenuItem.OnDrawItem)) or (FOverrideOwnerDraw) then begin
          if (xcMainMenu in fsd.skinControls) then
             MenuItem.OnDrawItem := DrawMenuItem;
          MenuItem.OnMeasureItem := MeasureItem;
        end;
    end else MenuItem.OnDrawItem := nil;
  end;

⌨️ 快捷键说明

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