neoform.pas

代码齐全

unit NeoForm;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, StdCtrls, ImgList, ToolWin, ComCtrls, MenuBar, Menus, Buttons;

type
  TWhichBorder=(wbTop,wbLeft,wbRight,wbBottom,wbLeftTop,wbLeftBottom,wbRightTop,
    wbRightBottom,wbNone);
  TzypNeoBorderIcons=Array [1..3] of Boolean;
  TzypNeoForm = class(TForm)
    ImageTop: TImage;
    ImageLeft: TImage;
    ImageLeftTop: TImage;
    ImageRightTop: TImage;
    ImageRight: TImage;
    ImageBottom: TImage;
    LabelCaption: TLabel;
    ImageIcon: TImage;
    PanelBkGnd: TPanel;
    ImageMax: TImage;
    ImageMin: TImage;
    ImageNormal: TImage;
    ImageClose: TImage;
    CoolBar: TCoolBar;
    MenuBar: TMenuBar;
    ImageDeactiveLeftTop: TImage;
    ImageDeactiveTop: TImage;
    ImageDeactiveRightTop: TImage;
    ImageActiveTop: TImage;
    ImageActiveLeftTop: TImage;
    ImageActiveRightTop: TImage;
    ImageActiveMenubar: TImage;
    ImageDeactiveMenubar: TImage;
    ImageLeftBottom: TImage;
    ImageRightBottom: TImage;
    procedure FormCreate(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure ImageCloseClick(Sender: TObject);
    procedure ImageMinClick(Sender: TObject);
    procedure ImageNormalClick(Sender: TObject);
    procedure ImageMaxClick(Sender: TObject);
    procedure ImageTopDblClick(Sender: TObject);
    procedure SetCanResize(value:Boolean);
    function  GetcanResize:Boolean;
    procedure SetBorderIcons;
    procedure ImageTopMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure ImageTopMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure ImageTopMouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
    procedure ImageIconDblClick(Sender: TObject);
    procedure FormCanResize(Sender: TObject; var NewWidth,
      NewHeight: Integer; var Resize: Boolean);
  private
    { Private declarations }
    FCanResize,FisDown:Boolean;
    FDetax,FDetaY:Integer;
    FP,FOldP:TPoint;
    FzypNeoBorderIcons:TZypNeoBorderIcons;
  public
    { Public declarations }
  protected
    procedure WndProc(var Msg:TMessage);override;
    procedure WMNCHitTest(var Msg:TWMNCHitTest);message WM_NCHITTEST;
  end;

var
  zypNeoForm: TzypNeoForm;

implementation

{$R *.DFM}
const
  cTopHeight=50;
  cRightTopWidth=97;
  cLeftWidth=10;
  cRightWidth=10;
  cBottomHeight=12;
  cMaxWidth=800;
  cMaxHeight=600;
  cMinWidth=300;
  cMinHeight=200;
  cPenWidth=3;
  cIconTop=6;


procedure TzypNeoForm.WMNCHitTest(var Msg:TWMNCHitTest);
var
  pt:TPoint;
begin
if (GetCanReSize=False) or (WindowState<>wsNormal) then
  begin
  inherited;
  exit;
  end;
pt:=Point(Msg.xPos,Msg.yPos);
pt:=ScreenToClient(pt);
if (pt.x<5) and (pt.y<5) then Msg.Result:=htTopLeft
else if (pt.x>width-5) and (pt.y<5) then Msg.Result:=htTopRight
else if (pt.x>width-5) and (pt.y>height-5) then Msg.Result:=htBottomRight
else if (pt.x<5) and (pt.y>height-5) then Msg.Result:=htBottomLeft
else if (pt.x<5) then Msg.Result:=htLeft
else if (pt.y<5) then Msg.Result:=htTop
else if (pt.x>width-5) then Msg.Result:=htRight
else if (pt.y>height-5) then Msg.Result:=htBottom
else inherited;
end;

procedure TzypNeoForm.SetBorderIcons;
begin
case BorderStyle of
  bsToolWindow,
  bsSizeToolWin,
  bsDialog:
    begin
    FzypNeoBorderIcons[1]:=True;
    FzypNeoBorderIcons[2]:=False;
    FzypNeoBorderIcons[3]:=False;
    ImageIcon.Visible:=False;
    ImageIcon.Enabled:=False;
    end;
  bsNone:     //虽然设为bsNone，但是仍然有Caption栏，如果连Caption栏都不想要的话，
    begin     //老兄，我劝你还是不要用我的这个Form了。
    FzypNeoBorderIcons[1]:=False;
    FzypNeoBorderIcons[2]:=False;
    FzypNeoBorderIcons[3]:=False;
    ImageIcon.Visible:=False;
    ImageIcon.Enabled:=False;
    end;
else
    FzypNeoBorderIcons[1]:=True;
    FzypNeoBorderIcons[2]:=True;
    FzypNeoBorderIcons[3]:=True;
    ImageIcon.Visible:=True;
    ImageIcon.Enabled:=True;
    end;
if biSystemMenu in BorderIcons then
  begin
  FzypNeoBorderIcons[1]:=FzypNeoBorderIcons[1] and True;
  FzypNeoBorderIcons[2]:=FzypNeoBorderIcons[2] and True;
  FzypNeoBorderIcons[3]:=FzypNeoBorderIcons[3] and True;
  ImageIcon.Visible:=ImageIcon.Visible and True;
  ImageIcon.Enabled:=ImageIcon.Enabled and True;
  end
else
  begin
  FzypNeoBorderIcons[1]:=FzypNeoBorderIcons[1] and False;
  FzypNeoBorderIcons[2]:=FzypNeoBorderIcons[2] and False;
  FzypNeoBorderIcons[3]:=FzypNeoBorderIcons[3] and False;
  ImageIcon.Visible:=ImageIcon.Visible and False;
  ImageIcon.Enabled:=ImageIcon.Enabled and False;
  end;
if biMinimize in BorderIcons then
  begin
  FzypNeoBorderIcons[3]:=FzypNeoBorderIcons[3] and True;
  end
else
  begin
  FzypNeoBorderIcons[3]:=FzypNeoBorderIcons[3] and False;
  end;
if biMaximize in BorderIcons then
  begin
  FzypNeoBorderIcons[2]:=FzypNeoBorderIcons[2] and True;
  end
else
  begin
  FzypNeoBorderIcons[2]:=FzypNeoBorderIcons[2] and False;
  end;
ImageClose.Visible:=FzypNeoBorderIcons[1];
ImageClose.Enabled:=FzypNeoBorderIcons[1];
ImageMax.Visible:=FzypNeoBorderIcons[2];
ImageMax.Enabled:=FzypNeoBorderIcons[2];
ImageMin.Visible:=FzypNeoBorderIcons[3];
ImageMin.Enabled:=FzypNeoBorderIcons[3];
end;

procedure TzypNeoForm.SetCanResize(value:Boolean);
begin
if FCanResize<>value then FCanResize:=value;
end;

function TzypNeoForm.GetcanResize;
begin
Result:=FCanResize;
end;

procedure TzypNeoForm.WndProc(var Msg:TMessage);
begin
inherited WndProc(Msg);
if Msg.Msg=WM_ACTIVATE then
  begin
  case Msg.WParamLo of
    WA_ACTIVE,WA_CLICKACTIVE:
      begin
      ImageTop.Picture:=ImageActiveTop.Picture;
      ImageLeftTop.Picture:=ImageActiveLeftTop.Picture;
      ImageRightTop.Picture:=ImageActiveRightTop.Picture;
      Coolbar.Bitmap:=ImageActiveMenubar.Picture.Bitmap;
      end;
    WA_INACTIVE:
      begin
      ImageLeftTop.Picture:=ImageDeactiveLeftTop.Picture;
      ImageTop.Picture:=ImageDeactiveTop.Picture;
      ImageRightTop.Picture:=ImageDeactiveRightTop.Picture;
      CoolBar.Bitmap:=ImageDeactiveMenuBar.Picture.Bitmap;
      end;
    end;
  end;
end;

procedure TzypNeoForm.FormCreate(Sender: TObject);
begin
PanelBKGND.Color:=TColor($00CFCFCF);
//因为PanelBGNND是应用程序的所有控件的平台，因此它的大小应决定窗体的大小
//Width:=PanelBKGND.Width+cLeftWidth+cRightWidth;
//Height:=PanelBKGND.Height+cTopHeight+cBottomHeight-2;
PanelBKGND.Width:=Width;
PanelBKGND.Height:=Height;

LabelCaption.Caption:=Caption;
SetBorderIcons;
if (BorderStyle=bsSizeable)or(BorderStyle=bsSizeToolWin) then //窗体是否允许改变大小
  begin
  SetCanResize(True);
  end
else
  begin
  SetCanResize(False);
  end;
BorderStyle:=bsNone;
if Assigned(Menu) then
  begin
  CoolBar.Visible:=True;
  Menubar.Menu:=Menu;
  Menu:=Nil;
  end
else
  begin
  Coolbar.Visible:=False;
  end;
FormResize(Sender);
end;

procedure TzypNeoForm.FormResize(Sender: TObject);
var
  i:Integer;
begin
ImageTop.Left:=0;
ImageTop.Top:=0;
ImageTop.Width:=ClientWidth;
ImageBottom.Width:=ClientWidth;
ImageBottom.Top:=ClientHeight-cBottomHeight;
ImageLeft.Height:=ClientHeight;
ImageRight.Height:=ClientHeight;
ImageRight.Left:=ClientWidth-cRightWidth;
ImageLeftBottom.left:=0;
ImageLeftBottom.Top:=ClientHeight-cBottomHeight;
ImageRightBottom.Top:=ClientHeight-cBottomHeight;
ImageRightBottom.Left:=ClientWidth-cRightWidth;
ImageRightTop.Left:=ClientWidth-cRightTopWidth;
ImageRightTop.top:=0;
ImageLeftTop.Left:=0;
ImageLeftTop.Top:=0;
PanelBKGND.Left:=cLeftWidth;
PanelBKGND.Top:=cTopHeight;
PanelBKGND.Width:=ClientWidth-cLeftWidth-cRightWidth;
PanelBKGND.Height:=ClientHeight-cTopHeight-cBottomHeight+2;
ImageMin.top:=cIconTop;
ImageMax.top:=cIconTop;
ImageNormal.Top:=cIconTop;
ImageClose.top:=cIconTop;
i:=1;
if FzypNeoBorderIcons[1] then
  begin
  ImageClose.Left:=Width-3-i*17-2;
  Inc(i);
  end;
if FzypNeoBorderIcons[2] then
  begin
  ImageMax.Left:=Width-3-i*17-2;
  ImageNormal.Left:=ImageMax.Left;
  Inc(i);
  end;
if FzypNeoBorderIcons[3] then
  begin
  ImageMin.Left:=Width-3-i*17-2;
  end;
MenuBar.Width:=ImageRightTop.Left-MenuBar.Left;
if FzypNeoBorderIcons[2] then
 if WindowState=wsMaximized then
  begin
  ImageNormal.Enabled:=True;
  ImageNormal.Visible:=True;
  ImageMax.Enabled:=False;
  ImageMax.Visible:=False;
  end
 else
  begin
  ImageNormal.Enabled:=False;
  ImageNormal.Visible:=False;
  ImageMax.Enabled:=True;
  Imagemax.Visible:=True;
  end;
end;

procedure TzypNeoForm.ImageCloseClick(Sender: TObject);
begin
Close;
end;

procedure TzypNeoForm.ImageMinClick(Sender: TObject);
begin
if Application.MainForm=Self then
  Application.Minimize   //Change here!!!
else
  WindowState:=wsMinimized;
end;

procedure TzypNeoForm.ImageNormalClick(Sender: TObject);
begin
WindowState:=wsNormal;
end;

procedure TzypNeoForm.ImageMaxClick(Sender: TObject);
begin
WindowState:=wsMaximized;
end;

procedure TzypNeoForm.ImageTopDblClick(Sender: TObject);
begin
if WindowState<>wsMaximized then
  WindowState:=wsMaximized
else
  WindowState:=wsNormal;
end;

procedure TzypNeoForm.ImageTopMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
FisDown:=True;
GetCursorPos(FOldP);
end;

procedure TzypNeoForm.ImageTopMouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
begin
if not FisDown then exit;
GetCursorPos(Fp);
FDetaX:=Fp.x-Foldp.x;
FDetaY:=FP.y-FOldP.y;
SetBounds(Left+FDetaX,Top+FDetaY,Width,Height);
GetCursorPos(FOldP);
end;

procedure TzypNeoForm.ImageTopMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
FisDown:=false;
end;

procedure TzypNeoForm.ImageIconDblClick(Sender: TObject);
begin
Close;
end;

procedure TzypNeoForm.FormCanResize(Sender: TObject; var NewWidth,
  NewHeight: Integer; var Resize: Boolean);
begin
if NewWidth>=cMaxWidth then NewWidth:=cMaxWidth;
if NewWidth<=cMinWidth then NewWidth:=cMinWidth;
if NewHeight>=cMaxHeight then NewHeight:=cMaxHeight;
if NewHeight<=cMinHeight then NewHeight:=cMinHeight;
end;

end.