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

📄 theme.pas

📁 一款不错的商务程序商品管理系统,有简易的窗体皮肤
💻 PAS
字号:

unit Theme;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, ImgList, jpeg;

type
  //初始化,关闭,最大化,最小化,还原
  TState = (stIni,stClose,stMax,stMin,stRes,stNone);
  TBaseForm = class(TForm)
    ClientImage: TImage;
    Title3: TImage;
    Left1: TImage;
    Bottom1: TImage;
    MinButton: TImage;
    title2: TImage;
    title1: TImage;
    RedButton: TImage;
    MaxButton: TImage;
    CloseButton: TImage;
    Icon: TImage;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormPaint(Sender: TObject);
    procedure FormResize(Sender: TObject);
  private
    IsMax: Boolean; //是否处于最大化状态
    IsHint: Boolean;
    IsDrawForm: Boolean;//是否需要绘制窗体
    FTitle: String;
    ButtonState: TState;
    FTitleColor: TColor;
     x,y,z: integer;
     Brush1: TBrush;
    GlobleDC: HDC;
    OrigonLeft,OrigonTop,OrigonWidth,OrigonHeight: Integer;
    { Private declarations }
    procedure RepaintWin(Var Msg: TWMNCACTIVATE); Message WM_NCACTIVATE;
    procedure PosMove(var Message: TWMWindowPosChanging); message WM_WINDOWPOSCHANGING;
    procedure NoClientMouseMove(Var Msg: TWMNCMouseMove);message WM_NCMouseMove;
    procedure ActiveForm(Var Msg: TWMACTIVATE); Message WM_ACTIVATE;
    Procedure NoClientMouseDown(var Msg: TWMNCLBUTTONDOWN);message WM_NCLBUTTONDOWN;
    Procedure NCPaint(var Msg: TWMNCPAINT);message WM_NCPAINT;
    Procedure PARENTNOTIFY(Var Msg: TWMPARENTNOTIFY);message WM_PARENTNOTIFY;
    //阻止用于双击标题栏
    Procedure PreventDlbTitle(Var Msg: TWMNCLBUTTONDBLCLK);Message WM_NCLBUTTONDBLCLK;
    procedure SetTitle(Text: String);
    procedure DrawTitle;
    Procedure SetTitleColor(Color: TColor);
  published
    Property Title: String Read FTitle Write SetTitle;
    property TitleColor: TColor Read FTitleColor Write SetTitleColor default clBlue;
  public
     IniRect,MinRect,MaxRect,CloseRect: TRect;
     Procedure DrawForm; virtual;
     procedure DoExtra(State: TState);virtual;
    { Public declarations }
  end;

var
  BaseForm: TBaseForm;
implementation

uses Math, Types;

{$R *.dfm}

procedure TBaseForm.RepaintWin(var Msg: TWMNCACTIVATE);
begin
  Inherited;
  IsDrawForm := True;
  DrawForm;
end;

procedure TBaseForm.PosMove(var Message: TWMWindowPosChanging);
begin
  Inherited;
  DrawForm;
  IsDrawForm := True;
  
end;

procedure TBaseForm.FormCreate(Sender: TObject);
begin
  x:= GetSystemMetrics(SM_CXBORDER);
  y := GetSystemMetrics(SM_CYBORDER);
  z := GetSystemMetrics(SM_CYCAPTION);
  GlobleDC := GetWindowDC(Handle);
  //Icon.Picture.Icon.LoadFromFile('C:\Documents and Settings\梁水\桌面\新建文件夹\MACOS.ICO');
  FTitle:=Self.Caption;
  FTitleColor := clBlack;
  OrigonLeft := Left;
  OrigonTop :=  Top;
  OrigonWidth := Width;
  OrigonHeight := Height;
  IsMax := True;
  IsDrawForm := True;
  IsHint := False;
  Brush.Bitmap := ClientImage.Picture.Bitmap;
  Brush1 := TBrush.Create;
  IniRect := Rect(8,(z+3*y -Self.Icon.Height)div 2,Self.Icon.Width,Self.Icon.Height);
  MinRect := Rect(Width-45,(z+2*y-MinButton.Height)div 2,MinButton.Width,MinButton.Height);
  MaxRect := Rect(Width-32,(z+2*y-MaxButton.Height)div 2,MaxButton.Width,MaxButton.Height);
  CloseRect := Rect(Width-19,(z+2*y-CloseButton.Height)div 2,CloseButton.Width,CloseButton.Height);
  ButtonState :=stNone;
end;

procedure TBaseForm.NoClientMouseMove(var Msg: TWMNCMouseMove);
var

  dc1: HDC;
  Point1: TPoint;
  IniTemp,MinTemp,MaxTemp,CloseTemp: TRect;
begin
  inherited;
  Point1 := Point(Msg.XCursor,Msg.YCursor);
  IniTemp:=  Rect(IniRect.Left+ Left,Top+ IniRect.Top,IniRect.Right+IniRect.Left+ Left,IniRect.Bottom+IniRect.Top+Top);
  MinTemp:=  Rect(MinRect.Left+ Left,Top+ MinRect.Top,MinRect.Right+MinRect.Left+ Left,MinRect.Bottom+MinRect.Top+Top);
  MaxTemp:=  Rect(MaxRect.Left+ Left,Top+ MaxRect.Top,MaxRect.Right+MaxRect.Left+ Left,MaxRect.Bottom+MaxRect.Top+Top);
  CloseTemp:=  Rect(CloseRect.Left+ Left,Top+ CloseRect.Top,CloseRect.Right+CloseRect.Left+ Left,CloseRect.Bottom+CloseRect.Top+Top);
  if PtInRect(IniTemp,Point1) then
  begin
    IsDrawForm := True;
    ButtonState := stIni;
    dc1 := GetWindowDC(Handle);
    StretchBlt(dc1,IniRect.Left,IniRect.Top,IniRect.Right,IniRect.Bottom,RedButton.Canvas.Handle,0,0,RedButton.Width,RedButton.Height,SRCCOPY);
    ReleaseDC(Handle,dc1);
    DoExtra(stIni);
  end
  else if  PtInRect(MinTemp,Point1) then
  begin
    IsHint := True;
    IsDrawForm := True;
    ButtonState := stMin;
    dc1 := GetWindowDC(Handle);
    //DrawForm;
    StretchBlt(dc1,MinRect.Left,MinRect.Top,MinRect.Right,MinRect.Bottom,MinButton.Canvas.Handle,0,0,MinButton.Width,MinButton.Height,SRCCOPY);
    ReleaseDC(Handle,dc1);
    DoExtra(stMin);
  end
  else if PtInRect(MaxTemp,Point1) then
  begin
    IsDrawForm := True;
    dc1 := GetWindowDC(Handle);
    //DrawForm;
    StretchBlt(dc1,MaxRect.Left,MaxRect.Top,MaxRect.Right,MaxRect.Bottom,MaxButton.Canvas.Handle,0,0,MaxButton.Width,MaxButton.Height,SRCCOPY);
    ReleaseDC(Handle,dc1);
    if IsMax then
    begin
      ButtonState := stMax;
      DoExtra(stMax);
    end
    else
    begin
      ButtonState := stRes;
      DoExtra(stRes);
    end;
  end
  else if PtInRect(CloseTemp,Point1) then
  begin
    IsDrawForm := True;
    ButtonState := stClose;
    dc1 := GetWindowDC(Handle);
     //DrawForm;
    StretchBlt(dc1,CloseRect.Left,CloseRect.Top,CloseRect.Right,CloseRect.Bottom,CloseButton.Canvas.Handle,0,0,CloseButton.Width,CloseButton.Height,SRCCOPY);
    ReleaseDC(Handle,dc1);
    DoExtra(stClose);
  end
  else
  begin
  //  t_hint.Hide;
    IsHint := True;

    ButtonState := stNone;
    DoExtra(stNone);
    DrawForm;
  end;
end;

procedure TBaseForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  //Brush1.Free;
  //ReleaseDC(Handle,GlobleDC);
end;

procedure TBaseForm.DrawForm;
var
  Rect1: TRect;
  dc: HDC;
begin

  inherited;
  dc := GetWindowDC(Handle);
  if IsDrawForm then
  begin
    Rect1 := GetClientRect;
    Rect1 := Rect(Rect1.Left-2,Rect1.Top,Rect1.Right+x,Rect1.Bottom);

    //左边线
    StretchBlt(dc,1-x,-3,Left1.Width+1,Height+2*y+1,Left1.Canvas.Handle,0,0,Left1.Width,Left1.Height,SRCCOPY );
     //右边线
    StretchBlt(dc,Width-y*4-2,Title3.Height,Left1.Width+1,Height+2*y+1,Left1.Canvas.Handle,0,0,Left1.Width,Left1.Height,SRCCOPY);

    //中间标题
    StretchBlt(dc,Title1.Width-1,0,Width-Title1.Width-Title3.Width,z+4,Title2.Canvas.Handle,0,0,Title2.Width,Title2.Height,SRCCOPY );
    //左标题
    StretchBlt(dc,-x,0,Title1.Width,z+4,Title1.Canvas.Handle,0,0,Title1.Width,Title1.Height,SRCCOPY );
    //右标题
    StretchBlt(dc,Width-Title3.Width-1,0,Title3.Width+3,z+4,Title3.Canvas.Handle,0,0,Title3.Width,Title3.Height,SRCCOPY);
    //底边线
    StretchBlt(dc,-x+Left1.Width,Height-2*y-3,Width,Bottom1.Height,Bottom1.Canvas.Handle,0,0,Bottom1.Width,Bottom1.Height,SRCCOPY);

    //绘制左按钮
    StretchBlt(dc,IniRect.Left,IniRect.Top,IniRect.Right,IniRect.Bottom,Icon.Canvas.Handle,0,0,Icon.Width,Icon.Height,SRCCOPY);
    //绘制关闭按钮
    StretchBlt(dc,CloseRect.Left,CloseRect.Top,CloseRect.Right,CloseRect.Bottom,CloseButton.Canvas.Handle,0,0,CloseButton.Width,CloseButton.Height,SRCCOPY);
    //绘制最大化按钮
    StretchBlt(dc,MaxRect.Left,MaxRect.Top,MaxRect.Right,MaxRect.Bottom,MaxButton.Canvas.Handle,0,0,MaxButton.Width,MaxButton.Height,SRCCOPY);
    //绘制最小化按钮
    StretchBlt(dc,MinRect.Left,MinRect.Top,MinRect.Right,MinRect.Bottom,MinButton.Canvas.Handle,0,0,MinButton.Width,MinButton.Height,SRCCOPY);
    IsDrawForm := False;
     // Brush.Bitmap := ClientImage.Picture.Bitmap;
    DrawTitle; 
  end;
  ReleaseDC(Handle,dc);
end;

procedure TBaseForm.NoClientMouseDown(var Msg: TWMNCLBUTTONDOWN);
var
  Point1: TPoint;
begin
  inherited;
  Point1 := Point(Msg.XCursor,Msg.YCursor);
  Case ButtonState of
    stIni : begin
              //top := Top+500;
              ShowWindow(Handle,SW_RESTORE);
              SetWindowPos(Handle,HWND_NOTOPMOST,(Screen.Width-OrigonWidth)div 2,(Screen.Height- OrigonHeight)div 2,OrigonWidth,OrigonHeight,SWP_SHOWWINDOW);
              DrawForm;
              IsMax := True;
            end;
    stMax:  begin
              ButtonState := stMax;
              ShowWindow(Handle,SW_MAXIMIZE);
              //SetWindowPos(Handle,HWND_NOTOPMOST,0,0,Screen.Width,Screen.Height,SWP_SHOWWINDOW);
              IsMax := False;
              //DrawForm;
            end;
    stMin:  begin
//              ButtonState := stMin;
              //ShowWindow(Handle,SW_MINIMIZE);
              //SetWindowPos(Handle,HWND_NOTOPMOST ,(Screen.Width-OrigonWidth)div 2,2,OrigonWidth,0,SWP_SHOWWINDOW);
//              DrawForm;
//              Self.WindowState:=wsMinimized;
            end;
    stRes:  begin
             // ButtonState := stRes;
             //if  biMinimize in Self.BorderIcons  then
              ShowWindow(Handle,SW_RESTORE);
              DrawForm;
              IsMax := True;
            end;
    stClose:begin
              //ButtonState := stClose;
              //if  biMaximize in Self.BorderIcons  then
              Close;
            end;
  end;
end;


procedure TBaseForm.SetTitle(Text: String);
begin
  FTitle := Text;
  DrawTitle;
end;

procedure TBaseForm.DrawTitle;
begin
  if (FTitle <>'')then
  begin
    SetBkMode(GlobleDC,TRANSPARENT);
    SetTextColor(GlobleDC,FTitleColor);
    SelectObject(GlobleDC,Font.Handle);
    SetTextAlign(GlobleDC,TA_CENTER);
    //TextOut(GlobleDC,width div 2,z div 3 ,Pchar(FTitle),Length(FTitle));
    TextOut(GlobleDC,60,z div 3 ,Pchar(FTitle),Length(FTitle));
  end;
end;

procedure TBaseForm.DoExtra(State: TState);
begin
  //add code...
end;

procedure TBaseForm.SetTitleColor(Color: TColor);
begin
  FTitleColor := Color;
end;

procedure TBaseForm.ActiveForm(var Msg: TWMACTIVATE);
begin
  DrawForm;
  IsDrawForm := True;
  inherited;
end;

procedure TBaseForm.NCPaint(var Msg: TWMNCPAINT);
begin
  DrawForm;
  IsDrawForm := True;
  //IsDrawTitle := True;
  inherited;
end;

procedure TBaseForm.FormPaint(Sender: TObject);
begin
  DrawForm;
  IsDrawForm := True;
end;

procedure TBaseForm.FormResize(Sender: TObject);
begin
  IniRect := Rect(8,(z+3*y -Icon.Height)div 2,Icon.Width,Icon.Height);
  MinRect := Rect(Width-45,(z+2*y-MinButton.Height)div 2,MinButton.Width,MinButton.Height);
  MaxRect := Rect(Width-32,(z+2*y-MaxButton.Height)div 2,MaxButton.Width,MaxButton.Height);
  CloseRect := Rect(Width-19,(z+2*y-CloseButton.Height)div 2,CloseButton.Width,CloseButton.Height);
  Refresh;
end;

procedure TBaseForm.PARENTNOTIFY(var Msg: TWMPARENTNOTIFY);
begin
  inherited;
  DrawForm;
end;

procedure TBaseForm.PreventDlbTitle(var Msg: TWMNCLBUTTONDBLCLK);
begin
//
end;

end.



⌨️ 快捷键说明

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