styleform.pas

产品信息系统!关于产品基础信息的系统!功能强大!

unit StyleForm;

interface

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

type
  TWhichBorder = (wbTop,wbLeft, wbRight, wbBottom, wbLeftTop, wbLeftBottom,
                  wbRightTop, wbRightBottom, wbNone);
  TzypNeoBorderIcons = array [1..3] of Boolean;
  
  TfrmStyleBase = class(TForm)
    ImageTop: TImage;
    ImageLeft: TImage;
    ImageLeftTop: TImage;
    ImageRightTop: TImage;
    ImageRight: TImage;
    ImageBottom: TImage;
    LabelCaption: TLabel;
    ImageIcon: TImage;
    pnlClient: TPanel;
    ImageMax: TImage;
    ImageMin: TImage;
    ImageNormal: TImage;
    ImageClose: TImage;
    ImageDeactiveLeftTop: TImage;
    ImageDeactiveTop: TImage;
    ImageDeactiveRightTop: TImage;
    ImageActiveTop: TImage;
    ImageActiveLeftTop: TImage;
    ImageActiveRightTop: TImage;
    ImageActiveMenubar: TImage;
    ImageDeactiveMenubar: TImage;
    ImageLeftBottom: TImage;
    ImageRightBottom: TImage;
    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);
    procedure LabelCaptionMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure LabelCaptionMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure LabelCaptionMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure LabelCaptionDblClick(Sender: TObject);
  private
    FCanResize, FisDown: Boolean;
    FDetax, FDetaY: Integer;
    FP, FOldP: TPoint;
    FzypNeoBorderIcons: TZypNeoBorderIcons;
  protected
    procedure WndProc(var Msg: TMessage); override;
    procedure WMNCHitTest(var Msg: TWMNCHitTest); message WM_NCHITTEST;
  public
    procedure AfterConstruction; override;
  end;

var
  frmStyleBase: TfrmStyleBase;

implementation

{$R *.DFM}

const
  cTopHeight = 50;
  cRightTopWidth = 97;
  cLeftWidth = 10;
  cRightWidth = 10;
  cBottomHeight = 12;
  cMaxWidth = 1024;
  cMaxHeight = 768;
  cMinWidth = 50;
  cMinHeight = 50;
  cPenWidth = 3;
  cIconTop = 6;

procedure TfrmStyleBase.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 TfrmStyleBase.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
      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
    FzypNeoBorderIcons[3] := FzypNeoBorderIcons[3] and True
  else
    FzypNeoBorderIcons[3] := FzypNeoBorderIcons[3] and False;
  if biMaximize in BorderIcons then
    FzypNeoBorderIcons[2] := FzypNeoBorderIcons[2] and True
  else
    FzypNeoBorderIcons[2] := FzypNeoBorderIcons[2] and False;
  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 TfrmStyleBase.SetCanResize(value : Boolean);
begin
  if FCanResize <> value then FCanResize := value;
end;

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

procedure TfrmStyleBase.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 TfrmStyleBase.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;
  pnlClient.Left := cLeftWidth;
  pnlClient.Top := cTopHeight;
  pnlClient.Width := ClientWidth - cLeftWidth - cRightWidth;
  pnlClient.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
    ImageMin.Left := Width - 3 - i * 17 - 2;
  //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 TfrmStyleBase.ImageCloseClick(Sender: TObject);
begin
  Close;
end;

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

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

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

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

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

procedure TfrmStyleBase.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 TfrmStyleBase.ImageTopMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  FisDown := False;
end;

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

procedure TfrmStyleBase.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;

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

procedure TfrmStyleBase.LabelCaptionMouseMove(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 TfrmStyleBase.LabelCaptionMouseUp(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  FisDown := False;
end;

procedure TfrmStyleBase.LabelCaptionDblClick(Sender: TObject);
begin
  if ImageMax.Visible and ImageMax.Enabled then
    WindowState := wsMaximized
  else if ImageNormal.Visible and ImageNormal.Enabled then
    WindowState := wsNormal;
end;

procedure TfrmStyleBase.AfterConstruction;
var
  w,h: Integer;
begin
  inherited;
  w := pnlClient.Width;
  h := pnlClient.Height;
  pnlClient.Color := TColor($00CFCFCF);
  LabelCaption.Caption := Caption;
  SetBorderIcons;
  if (BorderStyle = bsSizeable) or (BorderStyle = bsSizeToolWin) then //窗体是否允许改变大小
    SetCanResize(True)
  else
    SetCanResize(False);
  //因为PanelBGNND是应用程序的所有控件的平台，因此它的大小应决定窗体的大小
  BorderStyle := bsNone;
  Width := w + cLeftWidth + cRightWidth;
  Height := h + cTopHeight + cBottomHeight - 2;
  {if Assigned(Menu) then
  begin
    //CoolBar.Visible := True;
    //Menubar.Menu := Menu;
    //Menu := nil;
  end
  else
    Coolbar.Visible := False;}
  FormResize(Self);
end;

end.