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

📄 sxskinform.pas

📁 skin components for design of your applicastions
💻 PAS
📖 第 1 页 / 共 3 页
字号:
 if FState.ResizeRight<>'' then
  ResizeRightRgn:=EvaluateRegion(FState.ResizeRight,SkinFilePath,ZipFilePath,
     FForm.Width,FForm.Height,SkinLibrary,False,OnGetVariable);
 if FState.CaptionRegion<>'' then
  CaptionRgn:=EvaluateRegion(FState.CaptionRegion,SkinFilePath,ZipFilePath,
     FForm.Width,FForm.Height,SkinLibrary,False,OnGetVariable);
end;

function TSXSkinCustomForm.HitTest(X,Y:Integer):Integer;
begin
 if PtInRect(FIconRect,Point(X,Y)) then
  begin
   Result:=HTSYSMENU;
   exit;
  end;
 if PtInRect(FCloseRect,Point(X,Y)) then
  begin
   Result:=HTCLOSE;
   exit;
  end;
 if PtInRect(FMaximizeRect,Point(X,Y)) then
  begin
   Result:=HTMAXBUTTON;
   exit;
  end;
 if PtInRect(FMinimizeRect,Point(X,Y)) then
  begin
   Result:=HTMINBUTTON;
   exit;
  end;
 if PtInRect(FHelpRect,Point(X,Y)) then
  begin
   Result:=HTHELP;
   exit;
  end;
 if FForm.BorderStyle in [bsSizeable,bsSizeToolWin] then
  begin
   if (ResizeTopRgn<>0) and PtInRegion(ResizeTopRgn,X,Y) then
    begin
     Result:=HTTOP;
     exit;
    end;
   if (ResizeTopLeftRgn<>0) and PtInRegion(ResizeTopLeftRgn,X,Y) then
    begin
     Result:=HTTOPLEFT;
     exit;
    end;
   if (ResizeTopRightRgn<>0) and PtInRegion(ResizeTopRightRgn,X,Y) then
    begin
     Result:=HTTOPRIGHT;
     exit;
    end;
   if (ResizeBottomRightRgn<>0) and PtInRegion(ResizeBottomRightRgn,X,Y) then
    begin
     Result:=HTBOTTOMRIGHT;
     exit;
    end;
   if (ResizeRightRgn<>0) and PtInRegion(ResizeRightRgn,X,Y) then
    begin
     Result:=HTRIGHT;
     exit;
    end;
   if (ResizeBottomRgn<>0) and PtInRegion(ResizeBottomRgn,X,Y) then
    begin
     Result:=HTBOTTOM;
     exit;
    end;
   if (ResizeLeftRgn<>0) and PtInRegion(ResizeLeftRgn,X,Y) then
    begin
     Result:=HTLEFT;
     exit;
    end;
   if (ResizeBottomLeftRgn<>0) and PtInRegion(ResizeBottomLeftRgn,X,Y) then
    begin
     Result:=HTBOTTOMLEFT;
     exit;
    end;
  end;
 if (CaptionRgn<>0) and PtInRegion(CaptionRgn,X,Y) then
  begin
   Result:=HTCAPTION;
   exit;
  end;
 Result:=HTCLIENT;
end;

procedure TSXSkinCustomForm.ProcessNCMouseMove;
var   PT:TPoint;
 Changed:Boolean;

 procedure CheckButton(const ButtonRect:TRect;var ButtonOver:Boolean);
 var IsOver:Boolean;
 begin
  IsOver:=PtInRect(ButtonRect,PT);
  if IsOver<>ButtonOver then
   begin
    ButtonOver:=not ButtonOver;
    Changed:=True;
   end;
 end;

begin
 PT:=Mouse.CursorPos;
 Dec(PT.X,FForm.Left);
 Dec(PT.Y,FForm.Top);
 Changed:=False;
 CheckButton(FCloseRect,FCloseOver);
 if biMaximize in FForm.BorderIcons then
  CheckButton(FMaximizeRect,FMaximizeOver);
 if biMinimize in FForm.BorderIcons then
  CheckButton(FMinimizeRect,FMinimizeOver);
 if biHelp in FForm.BorderIcons then
  CheckButton(FHelpRect,FHelpOver);  
 if Changed then
  SendMessage(FForm.Handle,WM_NCPAINT,0,0);
end;

procedure TSXSkinCustomForm.NewWndProc(var Message:TMessage);
var PT:TPoint;
     A:Integer;
     E:Boolean;
   Rgn:HRGN;
//     H:HBRUSH;
//     R:TRect;
 Style:TSXSkinFormStyle;
begin
 case Message.Msg of
  WM_NCACTIVATE:        begin
                         OldWindowProc(Message);
                         FFormActive:=TWMNCActivate(Message).Active;
                         SendMessage(FForm.Handle,WM_NCPAINT,0,0);
                        end;
  WM_NCCALCSIZE:        begin
                         with TWMNCCalcSize(Message).CalcSize_Params^.rgrc[0] do
                          begin
                           if not TWMNCCalcSize(Message).CalcValidRects then
                            TWMNCCalcSize(Message).Result:=0 else
                             begin
                              TWMNCCalcSize(Message).Result:=0{ or WVR_REDRAW};
                             end;
                           if (SkinLibrary<>nil) and SkinLibrary.CanBeUsed and (FForm<>nil) then
                            begin
                             if (FForm.BorderStyle in [bsToolWindow,bsSizeToolWin]) and
                                (SkinStyle='_Form') then
                              SkinStyle:='_FormSmallCaption' else
                             if (FForm.BorderStyle in [bsDialog,bsSingle,bsSizeable]) and
                                (SkinStyle='_FormSmallCaption') then
                              SkinStyle:='_Form';
                             A:=SkinLibrary.Styles.GetIndexByName(SkinStyle);
                             if (A>=0) and (SkinLibrary.Styles[A] is TSXSkinFormStyle) then
                              begin
                               Style:=TSXSkinFormStyle(SkinLibrary.Styles[A]);
                               Inc(Left,Style.LeftFrameWidth);
                               TmpWidth:=FForm.Width;
                               TmpHeight:=FForm.Height;
                               if FCustomCaptionHeight=0 then
                                begin
                                 FCaptionHeight:=round(SXEvalMathString(Style.CaptionHeight,OnGetVariable,E));
                                 if E then FCaptionHeight:=0;
                                end else FCaptionHeight:=FCustomCaptionHeight;
                               Inc(Top,FCaptionHeight);
                               Dec(Right,Style.RightFrameWidth);
                               Dec(Bottom,Style.BottomFrameHeight);
                               if Right<Left then Right:=Left;
                               if Bottom<Top then Bottom:=Top;
                              end;
                            end;
                          end;
                         //if //(csDesigning in ComponentState) and (FForm.Parent<>nil) and
                         //   (FForm.Menu<>nil) and (FForm.Menu.Items.Count>0) then
                         // Inc(TWMNCCalcSize(Message).CalcSize_Params^.rgrc[0].Top,GetSystemMetrics(SM_CYMENU));
                        end;
  WM_NCHITTEST:         begin
                         if FCaptionHeight>0 then
                          begin
                           PT:=Point(Message.LParam and $FFFF,Message.LParam shr 16);
                           NormalizeWinPoint(PT);
                           if FForm<>nil then
                            begin
                             Dec(PT.X,FForm.Left);
                             Dec(PT.Y,FForm.Top);
                            end;
                           Message.Result:=HitTest(PT.X,PT.Y);
                          end else OldWindowProc(Message);
                        end;
  WM_NCMOUSEMOVE,
  WM_NCMOUSELEAVE:      begin
                         ProcessNCMouseMove;
                         OldWindowProc(Message);
                        end;
  WM_NCLBUTTONDOWN:     begin
                         if FCloseOver then
                          begin
                           FCloseDown:=True;
                           SendMessage(FForm.Handle,WM_NCPAINT,0,0);
                          end else
                         if FMaximizeOver then
                          begin
                           FMaximizeDown:=True;
                           SendMessage(FForm.Handle,WM_NCPAINT,0,0);
                          end else
                         if FMinimizeOver then
                          begin
                           FMinimizeDown:=True;
                           SendMessage(FForm.Handle,WM_NCPAINT,0,0);
                          end else
                         if FHelpOver then
                          begin
                           FHelpDown:=True;
                           SendMessage(FForm.Handle,WM_NCPAINT,0,0);
                          end else
                         OldWindowProc(Message);
                        end;
  WM_NCLBUTTONUP,
  WM_LBUTTONUP:         begin
                         if FCloseDown then
                          begin
                           FCloseDown:=False;
                           SendMessage(FForm.Handle,WM_NCPAINT,0,0);
                           if FCloseOver then
                            SendMessage(FForm.Handle,WM_SYSCOMMAND,SC_CLOSE,0);
                          end else
                         if FMaximizeDown then
                          begin
                           FMaximizeDown:=False;
                           SendMessage(FForm.Handle,WM_NCPAINT,0,0);
                           if FMaximizeOver then
                            begin
                             if FForm.WindowState=wsMaximized then
                              SendMessage(FForm.Handle,WM_SYSCOMMAND,SC_RESTORE,0) else
                               SendMessage(FForm.Handle,WM_SYSCOMMAND,SC_MAXIMIZE,0);
                            end;
                          end else
                         if FMinimizeDown then
                          begin
                           FMinimizeDown:=False;
                           SendMessage(FForm.Handle,WM_NCPAINT,0,0);
                           if FMinimizeOver then
                            SendMessage(FForm.Handle,WM_SYSCOMMAND,SC_MINIMIZE,0);
                          end else
                         if FHelpDown then
                          begin
                           FHelpDown:=False;
                           SendMessage(FForm.Handle,WM_NCPAINT,0,0);
                           if FHelpOver then
                            SendMessage(FForm.Handle,WM_SYSCOMMAND,SC_CONTEXTHELP,0);
                          end else
                           OldWindowProc(Message);
                        end;
  {WM_NCRBUTTONUP:       begin
                         //OldWindowProc(Message);
                         P:=Mouse.CursorPos;
                         SendMessage(FForm.Handle,WM_SYSCOMMAND,SC_MOUSEMENU,MakeLong(TWMNCRButtonUp(Message).XCursor,TWMNCRButtonUp(Message).YCursor));
                        end;}
  WM_NCPAINT:           begin
                         Rgn:=Message.WParam;
                         if (Rgn=0) or (Rgn=1) then
                          begin
                           Rgn:=CreateRectRgn(FForm.Left,FForm.Top,FForm.Left+FForm.Width,
                                              FForm.Top+FForm.Height);
                           DrawCaptionAndBorder(Rgn);
                           DeleteObject(Rgn);
                          end else
                           DrawCaptionAndBorder(Rgn);
                         //OffsetRgn(Rgn,-FForm.Left,-FForm.Top);
                         //if Rgn=1 then
                         // Rgn:=CreateRectRgn(FForm.Left,FForm.Top,FForm.Left+FForm.Width,
                         //                     FForm.Top+FForm.Height);
                         //P:=Point(0,0);
                         //MapWindowPoints(0,FForm.Handle,P,1);
                         //OffsetRgn(Rgn,-LastLeft,-LastTop);
                         //H:=CreateSolidBrush(RGB(random(256),random(256),random(256)));
                         //FillRgn(GetWindowDC(FForm.Handle),Rgn,H);
                         //DeleteObject(H);
                         Message.Result:=0;
                        end;
  WM_WINDOWPOSCHANGING: begin
                         LastLeft:=FForm.Left;
                         LastTop:=FForm.Top;
                         OldWindowProc(Message);
                        end;
  WM_SIZE:              begin
                         OldWindowProc(Message);
                         ResetMaskRegion;
                         CalcResizeRegions;
                         CalcCaptionElementsRects;
                         SendMessage(FForm.Handle,WM_NCPAINT,0,0);
                         exit;
                        end;
  WM_STYLECHANGED:      begin
                         ResetMaskRegion;
                         CalcResizeRegions;
                         CalcCaptionElementsRects;
                         OldWindowProc(Message);
//                         SetWindowPos(FForm.ClientHandle,0,FForm.Left,FForm.Top,FForm.Width,FForm.Height,
//                              0{SWP_NOMOVE or SWP_NOACTIVATE or SWP_NOOWNERZORDER or SWP_NOZORDER});

                        end;
  WM_SETTEXT:           begin
                         OldWindowProc(Message);
                         SendMessage(FForm.Handle,WM_NCPAINT,0,0);
                        end;
  else                  OldWindowProc(Message);
 end;
end;

constructor TSXSkinCustomForm.Create(AOwner:TComponent);
var A:Integer;
begin
 inherited;
 if not (AOwner is TForm) then raise Exception.Create(AOwner.Name+' is not a form!');
 FUseTFormIcon:=True;
 FForm:=TForm(AOwner);
 if FForm=nil then exit;
 SkinStyle:='_Form';
 IconStyle:='_Selective_StdIcon';
 if not (csLoading in ComponentState) and (csDesigning in ComponentState) and
    (SkinLibrary=nil) then
  begin
   for A:=0 to FForm.ComponentCount-1 do
    if FForm.Components[A] is TSXSkinLibrary then
     begin
      SkinLibrary:=TSXSkinLibrary(FForm.Components[A]);
      break;
     end;
  end;
 if not (csDesigning in ComponentState) then
  begin
   OldWindowProc:=FForm.WindowProc;
   FForm.WindowProc:=NewWndProc;
   TSXForm(FForm).ReCreateWnd;
   SetWindowLong(FForm.Handle,GWL_STYLE,GetWindowLong(FForm.Handle,GWL_STYLE) and not WS_CAPTION);
  end;
end;

destructor TSXSkinCustomForm.Destroy;
begin
 if ResizeTopLeftRgn<>0 then
  DeleteObject(ResizeTopLeftRgn);
 if ResizeTopRightRgn<>0 then
  DeleteObject(ResizeTopRightRgn);
 if ResizeBottomLeftRgn<>0 then
  DeleteObject(ResizeBottomLeftRgn);
 if ResizeBottomRightRgn<>0 then
  DeleteObject(ResizeBottomRightRgn);
 if ResizeLeftRgn<>0 then
  DeleteObject(ResizeLeftRgn);
 if ResizeRightRgn<>0 then
  DeleteObject(ResizeRightRgn);
 if ResizeTopRgn<>0 then
  DeleteObject(ResizeTopRgn);
 if ResizeBottomRgn<>0 then
  DeleteObject(ResizeBottomRgn);
 if CaptionRgn<>0 then
  DeleteObject(CaptionRgn);
 FTextBitmap.Free;
 inherited;
end;

end.

⌨️ 快捷键说明

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