neoform.pas

Barcode And LabelPrint

unit NeoForm;

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;
  TGBKPForm = 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;
    ImageDeactiveLeftTop: TImage;
    ImageDeactiveTop: TImage;
    ImageDeactiveRightTop: TImage;
    ImageActiveTop: TImage;
    ImageActiveLeftTop: TImage;
    ImageActiveRightTop: TImage;
    ImageActiveMenubar: TImage;
    ImageDeactiveMenubar: TImage;
    ImageLeftBottom: TImage;
    ImageRightBottom: TImage;
    CoolBar: TCoolBar;
    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);
    procedure CoolBarClick(Sender: TObject);
  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
  GBKPForm: TGBKPForm;
  cMaxWidth: Word = 800; //1024;//
  cMaxHeight: Word = 600; //896;//
implementation

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


procedure TGBKPForm.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 TGBKPForm.SetBorderIcons;
begin
  case BorderStyle of
    bsToolWindow,
      bsSizeToolWin,
      bsDialog:
      begin
        FzypNeoBorderIcons[1] := True;
        FzypNeoBorderIcons[2] := False; // True ;
        FzypNeoBorderIcons[3] := False; //True;
        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 TGBKPForm.SetCanResize(value: Boolean);
begin
  if FCanResize <> value then FCanResize := value;
end;

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

procedure TGBKPForm.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 TGBKPForm.FormCreate(Sender: TObject);
begin
  cMaxWidth := screen.width; //
  cMaxHeight := screen.Height; //
  { CASE GetDeviceCaps(GetDC(GBKPForm.Handle)，HORZRES) of


    640 ： //对640×480分辨率进行处理的代码；

    800 ： //对800×600分辨率进行处理的代码；

    1024： //对1024×768分辨率进行处理的代码；

    1280： //对1280×1024分辨率进行处理的代码； }
  PanelBKGND.Color := TColor($00CFCFCF);
//因为PanelBGNND是应用程序的所有控件的平台，因此它的大小应决定窗体的大小
  Width := PanelBKGND.Width + cLeftWidth + cRightWidth;
  Height := PanelBKGND.Height + cTopHeight + cBottomHeight - 2;
  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;
    //toolbar.Menu:=Menu;
    Menu := nil;
  end
  else
  begin
    //Coolbar.Visible := False;
  end;
  FormResize(Sender);
end;

procedure TGBKPForm.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;
  //toolbar.Width:=ImageRightTop.Left-toolbar.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 TGBKPForm.ImageCloseClick(Sender: TObject);
begin
  Close;
end;

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

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

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

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

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

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

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

procedure TGBKPForm.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 TGBKPForm.CoolBarClick(Sender: TObject);
begin
  ShowMessage(Sender.ClassName);
end;

end.