main.pas

这是一个正式的项目工程

unit Main;

interface

uses
  windows,SysUtils, Classes, Graphics, Forms, Controls,WinTypes, WinProcs, Menus,
  StdCtrls, Dialogs, Buttons, Messages, ExtCtrls, ComCtrls, Db, DBTables,
  ActnList, ImgList, ToolWin,Mask,StdActns, DBActns,wsCores,wsTypes;

type

  TfrmMain = class(TForm)
    MainMenu: TMainMenu;
    mnuRegister: TMenuItem;
    mnuWindowManager: TMenuItem;
    mnuHelp: TMenuItem;
    mnuWindowCascade: TMenuItem;
    mnuWindowTile: TMenuItem;
    mnuWindowArrange: TMenuItem;
    mnuHelpAbout: TMenuItem;
    OpenDialog: TOpenDialog;
    mnuInformationQuery: TMenuItem;
    mnuWindowMinimize: TMenuItem;
    StatusBar: TStatusBar;
    imgClient: TImage;
    mnuHelpTopic: TMenuItem;
    mnuSystemManager: TMenuItem;
    N7: TMenuItem;
    mnuYearCheck: TMenuItem;
    mnuReturn: TMenuItem;
    N6: TMenuItem;
    mnuSystemMaintaince: TMenuItem;
    mnuControlPanel: TMenuItem;
    ActionListMain: TActionList;
    ActionDataInput: TAction;
    ActionHelpTopic: TAction;
    mnuToolbar: TMenuItem;
    mnuControlBarMenu: TMenuItem;
    mnuCoolBarStatus: TMenuItem;
    ControlBarMenu: TControlBar;
    ToolBar2: TToolBar;
    ToolButtonCourseArrangement: TToolButton;
    ToolButtonTRestrict: TToolButton;
    ToolBar3: TToolBar;
    ToolButtonGCT: TToolButton;
    ToolButtonMCT: TToolButton;
    ToolBar1: TToolBar;
    ToolButtonControlPanel: TToolButton;
    ToolButtonGrade: TToolButton;
    ToolBar4: TToolBar;
    ToolButton10: TToolButton;
    CoolBarStatus: TCoolBar;
    ArrangeWindow: TWindowArrange;
    CascadeWindow: TWindowCascade;
    CloseWindow: TWindowClose;
    MinimizeAllWindow: TWindowMinimizeAll;
    TileHorizontallyWindow: TWindowTileHorizontal;
    TileVerticallyWindow: TWindowTileVertical;
    H1: TMenuItem;
    l1: TMenuItem;
    ActionSetIME: TAction;
    ActionAboutSystem: TAction;
    mnuActivateNextWindow: TMenuItem;
    mnuActivatePriorWindow: TMenuItem;
    ActionActivateNextWindow: TWindowArrange;
    ActionActivatePriorWindow: TWindowArrange;
    mnuPauseWork: TMenuItem;
    N1: TMenuItem;
    ImageListMenu: TImageList;
    ImageListButton: TImageList;
    ImageListPrinter: TImageList;
    HotImageListPrinter: TImageList;
    ImageListQuery: TImageList;
    HotImageListQuery: TImageList;
    ImageListStatistics: TImageList;
    HotImageListStatistics: TImageList;
    ImageListHelp: TImageList;
    HotImageListHelp: TImageList;
    ProgressBarQuery: TProgressBar;
    ToolButtonGravity: TToolButton;
    ToolButtonExit: TToolButton;
    mnuDataBackup: TMenuItem;
    ActionExitSystem: TAction;
    ActionUserManager: TAction;
    ActionPauseJob: TAction;
    mnuReport: TMenuItem;
    mnuDataRestore: TMenuItem;
    PrinterSetupMain: TPrinterSetupDialog;
    ActionPrinterSetup: TAction;
    ImageListToolBar: TImageList;
    ImageListPCode: TImageList;
    ActionChangBackground: TAction;
    ActionCalculator: TAction;
    ActionDateQuery: TAction;
    ActionControlPanel: TAction;
    N2: TMenuItem;
    mnuInitialize: TMenuItem;
    N4: TMenuItem;
    N5: TMenuItem;
    N11: TMenuItem;
    N15: TMenuItem;
    N18: TMenuItem;
    ActionGravity: TAction;
    ActionRealTimeChart: TAction;
    ActionSendCommand: TAction;
    ActionPrint: TAction;
    ActionInitialize: TAction;
    ActionBackup: TAction;
    ActionRestore: TAction;
    ActionHomePage: TAction;
    ActionHelpIndex: TAction;
    mnuHelpIndex: TMenuItem;
    N3: TMenuItem;
    ActionHistory: TAction;
    ActionCommParameter: TAction;
    ActionMultiAnalysis: TAction;
    N8: TMenuItem;
    N9: TMenuItem;
    ActionViewLog: TAction;
    mnuViewLog: TMenuItem;
    procedure CascadeWindowExecute(Sender: TObject);
    procedure ArrangeWindowExecute(Sender: TObject);
    procedure MinimizeAllWindowExecute(Sender: TObject);
    procedure TileHorizontallyWindowExecute(Sender: TObject);
    procedure TileVerticallyWindowExecute(Sender: TObject);
    procedure ActionActivatePriorWindowExecute(Sender: TObject);
    procedure ActionActivateNextWindowExecute(Sender: TObject);
    procedure CloseWindowExecute(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure ActionAboutSystemExecute(Sender: TObject);
    procedure ActionExitSystemExecute(Sender: TObject);
    procedure ActionUserManagerExecute(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure mnuChangePasswordClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure ActionPauseJobExecute(Sender: TObject);
    procedure mnuControlBarMenuClick(Sender: TObject);
    procedure mnuCoolBarStatusClick(Sender: TObject);
    procedure ActionControlPanelExecute(Sender: TObject);
    procedure ActionSendCommandExecute(Sender: TObject);
    procedure ActionRealTimeChartExecute(Sender: TObject);
    procedure ActionHistoryExecute(Sender: TObject);
    procedure ActionCommParameterExecute(Sender: TObject);
    procedure ActionGravityExecute(Sender: TObject);
    procedure ActionPrintExecute(Sender: TObject);
    procedure ActionMultiAnalysisExecute(Sender: TObject);
    procedure ActionViewLogExecute(Sender: TObject);
    procedure ActionHelpTopicExecute(Sender: TObject);
    procedure ActionHelpIndexExecute(Sender: TObject);
  private
    FClientInstance, FPrevClientProc : TFarProc;
    procedure ShowHint(Sender: TObject);
    Procedure ShowStatus(Sender: TObject;var Done:Boolean);
    procedure ClientWndProc(VAR Message: TMessage);
    procedure ShowForm(FormClass: TFormClass);
//    procedure MenuControl(UserInfo:TUserInfo);

  public
    ExitNo:integer;
    CodeInfo:TCodeInfo;
end;
var
  frmMain: TfrmMain;

implementation
uses
  resMain, ControlPanel, SendCommand, RealChart, History, CommParameter,
  StandardGravity, DataAnalysis, DataDisp, LogInfo,Sampling,GaugeP;


{$R *.DFM}
//*******************************************
//BackGround Paint
//*******************************************
procedure TfrmMain.ShowForm(FormClass: TFormClass);
begin
  With FormClass.Create(Application) do
  try
    ShowModal;
  finally
    Free;
  end;
end;

Procedure TfrmMain.ClientWndProc(VAR Message: TMessage);
var
  MyDC : hDC;
  Ro, Co : Word;
begin
  with Message do
    case Msg of
    WM_ERASEBKGND:
	begin
	  MyDC := TWMEraseBkGnd(Message).DC;
	  for Ro := 0 TO ClientHeight DIV imgClient.Picture.Height DO
	    for Co := 0 TO ClientWIDTH DIV imgClient.Picture.Width DO
	      BitBlt(MyDC, Co*imgClient.Picture.Width, Ro*imgClient.Picture.Height,
		imgClient.Picture.Width, imgClient.Picture.Height,
		imgClient.Picture.Bitmap.Canvas.Handle, 0, 0, SRCCOPY);
	  Result := 1;
	end;
    else
      Result := CallWindowProc(FPrevClientProc, ClientHandle, Msg, wParam, lParam);
    end;
end;

{procedure TfrmMain.MenuControl(UserInfo:TUserInfo);
begin
////;
////;
end; }
/////
// judge exists of subform of Parent form;
/////

Function isFormExist(ParentForm:TForm;SonFormName:String):Boolean;
var
  frmExist:Boolean;
  i:Integer;
begin
  With ParentForm do
  begin
    frmExist:=False;
    for i:=MDIChildCount-1 downto 0 do
    begin
      if (Uppercase(MDIChildren[i].Name)=UpperCase(SonFormName)) then
        begin
          frmExist:=True;
          Break;
        end;
    end;
    Result:=frmExist;
  end;
end;

procedure TfrmMain.CascadeWindowExecute(Sender: TObject);
begin
  Cascade;
end;
procedure TfrmMain.ArrangeWindowExecute(Sender: TObject);
begin
  ArrangeIcons;
end;

procedure TfrmMain.MinimizeAllWindowExecute(Sender: TObject);
var
  I: Integer;
begin
  for I := MDIChildCount - 1 downto 0 do
    MDIChildren[I].WindowState := wsMinimized;
end;
procedure TfrmMain.TileHorizontallyWindowExecute(Sender: TObject);
begin
  frmMain.TileMode:=tbHorizontal;
  Tile;
end;
procedure TfrmMain.TileVerticallyWindowExecute(Sender: TObject);
begin
  frmMain.TileMode:=tbVertical;
  Tile;
end;

procedure TfrmMain.ActionActivatePriorWindowExecute(Sender: TObject);
begin
  frmMain.Previous;
end;

procedure TfrmMain.ActionActivateNextWindowExecute(Sender: TObject);
begin
  frmMain.Next;
end;

procedure TfrmMain.CloseWindowExecute(Sender: TObject);
begin
  Close;
end;

procedure TfrmMain.ShowHint(Sender: TObject);
begin