neoform.pas

来自「一个仓库管理中的子系统－－采购子系统」· PAS 代码 · 共 510 行

unit NeoForm;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, StdCtrls, ImgList, ToolWin, ComCtrls, MenuBar, Menus, Buttons,
  NMURL, jpeg, HTTPApp,ShellAPI,mmsystem;

const
   {内存状态字符串}
   STotMem    ='Windows操作系统的可用内存:   %f KB';
   {操作系统版本信息字符串}
   SOSVer     ='%d.%d';
   SBuildNo   ='%d';
   SOSPlat    ='%s';
   SOSWin32s  ='Windows 3.1x Running Win32s';
   SOSWin95   ='Windows 95/98';
   SOSWinNT   ='Windows NT/2000';
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;
    ImageDeactiveLeftTop: TImage;
    ImageDeactiveTop: TImage;
    ImageDeactiveRightTop: TImage;
    ImageActiveTop: TImage;
    ImageActiveLeftTop: TImage;
    ImageActiveRightTop: TImage;
    ImageActiveMenubar: TImage;
    ImageDeactiveMenubar: TImage;
    ImageLeftBottom: TImage;
    ImageRightBottom: TImage;
    Label1: TLabel;
    Label2: TLabel;
    Image1: TImage;
    Label3: TLabel;
    Label4: TLabel;
    Bevel1: TBevel;
    MemLabel: TLabel;
    OSVersion: TLabel;
    LabelCPUSpeed: TLabel;
    mail: TLabel;
    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 FormActivate(Sender: TObject);
    procedure LabelCPUSpeedClick(Sender: TObject);
    procedure mailMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure mailClick(Sender: TObject);
    procedure PanelBkGndMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
  private
    { Private declarations }
    FCanResize,FisDown:Boolean;
    FDetax,FDetaY:Integer;
    FP,FOldP:TPoint;
    FzypNeoBorderIcons:TZypNeoBorderIcons;
    MenuBar:TMenuBar;
    stop:Boolean;
  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 OpenMidi;
begin
  MCISendString('OPEN music2.MID TYPE SEQUENCER ALIAS NN','',0,0);
  MCISendString('PLAY NN FROM 0','',0,0);
  MCISendString('CLOSE ANIMATION','',0,0);
end;

procedure CloseMidi;
begin
   MCISendString('OPEN music2.MID TYPE SEQUENCER ALIAS NN','',0,0);
   MCISendString('STOP NN','',0,0);
   MCISendString('CLOSE ANIMATION','',0,0);
end;

function GetCPUSpeed: Double;
const
  DelayTime = 500; // measure time in ms
var
  TimerHi, TimerLo: DWORD;
  PriorityClass, Priority: Integer;
begin
  PriorityClass := GetPriorityClass(GetCurrentProcess);
  Priority := GetThreadPriority(GetCurrentThread);

  SetPriorityClass(GetCurrentProcess, REALTIME_PRIORITY_CLASS);
  SetThreadPriority(GetCurrentThread, THREAD_PRIORITY_TIME_CRITICAL);

  Sleep(10);
  asm
    dw 310Fh // rdtsc
    mov TimerLo, eax
    mov TimerHi, edx
  end;
  Sleep(DelayTime);
  asm
    dw 310Fh // rdtsc
    sub eax, TimerLo
    sbb edx, TimerHi
    mov TimerLo, eax
    mov TimerHi, edx
  end;

  SetThreadPriority(GetCurrentThread, Priority);
  SetPriorityClass(GetCurrentProcess, PriorityClass);

  Result := TimerLo / (1000.0 * DelayTime);
end;

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;
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;

procedure TzypNeoForm.FormActivate(Sender: TObject);
var
MS:TMemoryStatus;
VI: TOSVersionInfo;
begin
  stop:=false;
  MS.dwLength:=Sizeof(MS);
  GlobalMemoryStatus(MS);
  with MS do
  MemLabel.caption:=Format(STotMem,[dwTotalPhys/1024]);

  VI.dwOSVersionInfoSize:=SizeOf(VI);
  GetVerSionEx(VI);
  with VI do
  begin
  case dwPlatformID of
      VER_PLATFORM_WIN32S:Osversion.Caption:=Format(SOSPlat,[SOSWin32s]);
      VER_PLATFORM_WIN32_WINDOWS:Osversion.Caption:=Format(SOSPlat,[SOSWin95]);
      VER_PLATFORM_WIN32_NT:Osversion.Caption:=Format(SOSPlat,[SOSWinNT]);
  end;
  Osversion.Caption:=Osversion.Caption+' (Build '+Format(SOSVer,[dwmajorVersion,dwMinorVersion]);
  Osversion.Caption:=OsVersion.Caption+'.'+Format(SBuildNo,[loWord(dwBuildNumber)])+')';
  end;
  LabelCPUSpeed.Caption := Format('CPU speed: %f MHz', [GetCPUSpeed]);
end;

procedure TzypNeoForm.LabelCPUSpeedClick(Sender: TObject);
begin
    if stop=false then
    stop:=True
    else
    stop:=False;
    while not Stop do
    begin
    LabelCPUSpeed.Caption := Format('CPU speed: %f MHz', [GetCPUSpeed]);
    Application.ProcessMessages;
    end;
end;

procedure TzypNeoForm.mailMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
    mail.Font.Color:=$00ACaa00;

end;

procedure TzypNeoForm.mailClick(Sender: TObject);
begin
   ShellExecute(handle,nil,pchar('http://www.whyxdz.com'),nil,nil,SW_SHOWNORMAL);
end;

procedure TzypNeoForm.PanelBkGndMouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
begin
  mail.Font.Color:=clNavy;
end;

end.