main.pas

一个做得很好地实验室仪器管理系统源代码！相信大家用得上

//   
//      -'`"_         -'`" \
//     /     \       /      "
//    /     /\\__   /  ___   \       西安科技学院143信箱 710054
//   |      | \  -"`.-(   \   |
//   |      |  |     | \"  |  |                万  重
//   |     /  /  "-"  \  \    |
//    \___/  /  (o o)  \  (__/       电邮: [e-mail]
//         __| _     _ |__
//        (      ( )      )          网址: http://www.DelphiBox.com
//         \_\.-.___.-./_/
//           __  | |  __             QQ  : 6036742
//          |  \.| |./  |
//          | '#.   .#' |
//          |__/ '"" \__|                     2001.1.1
//        -/             \-
//

unit Main;

interface

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

type
  TMainForm = class(TForm)
    MainMenu1: TMainMenu;
    File1: TMenuItem;
    FileNewItem: TMenuItem;
    FileOpenItem: TMenuItem;
    Window1: TMenuItem;
    Help1: TMenuItem;
    N1: TMenuItem;
    FileExitItem: TMenuItem;
    WindowCascadeItem: TMenuItem;
    WindowTileItem: TMenuItem;
    WindowArrangeItem: TMenuItem;
    OpenDialog: TOpenDialog;
    FileSaveItem: TMenuItem;
    Edit1: TMenuItem;
    CutItem: TMenuItem;
    CopyItem: TMenuItem;
    PasteItem: TMenuItem;
    WindowMinimizeItem: TMenuItem;
    StatusBar: TStatusBar;
    ActionList1: TActionList;
    EditCut1: TEditCut;
    EditCopy1: TEditCopy;
    EditPaste1: TEditPaste;
    YQ_Lab: TAction;
    AddressList: TAction;
    FileExit1: TAction;
    YQ_Borrow: TAction;
    WindowCascade1: TWindowCascade;
    WindowTileHorizontal1: TWindowTileHorizontal;
    WindowArrangeAll1: TWindowArrange;
    WindowMinimizeAll1: TWindowMinimizeAll;
    WindowTileVertical1: TWindowTileVertical;
    WindowTileItem2: TMenuItem;
    ToolBar2: TToolBar;
    ToolButton4: TToolButton;
    ToolButton5: TToolButton;
    ToolButton6: TToolButton;
    ToolButton7: TToolButton;
    ToolButton8: TToolButton;
    ToolButton10: TToolButton;
    ToolButton11: TToolButton;
    ImageList1: TImageList;
    ToolButton1: TToolButton;
    ToolButton2: TToolButton;
    ToolButton3: TToolButton;
    ToolButton9: TToolButton;
    EditUndo1: TEditUndo;
    N2: TMenuItem;
    N3: TMenuItem;
    ToolButton12: TToolButton;
    YQ_Code: TAction;
    ToolButton13: TToolButton;
    N4: TMenuItem;
    ToolButton14: TToolButton;
    ToolButton15: TToolButton;
    ToolButton16: TToolButton;
    ToolButton17: TToolButton;
    HelpAbout: TAction;
    N5: TMenuItem;
    Tools_Sort: TAction;
    Tools: TMenuItem;
    N7: TMenuItem;
    Tools_Chart: TAction;
    N8: TMenuItem;
    N9: TMenuItem;
    N10: TMenuItem;
    N11: TMenuItem;
    V1: TMenuItem;
    N12: TMenuItem;
    N13: TMenuItem;
    Tools_Chart1: TAction;
    Tools_Chart2: TAction;
    N14: TMenuItem;
    N15: TMenuItem;
    N16: TMenuItem;
    procedure YQ_LabExecute(Sender: TObject);
    procedure YQ_BorrowExecute(Sender: TObject);
    procedure HelpAbout1Execute(Sender: TObject);
    procedure FileExit1Execute(Sender: TObject);
    procedure AddressListExecute(Sender: TObject);
    procedure YQ_CodeExecute(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure HelpAboutExecute(Sender: TObject);
    procedure Tools_SortExecute(Sender: TObject);
    procedure Tools_ChartExecute(Sender: TObject);
    procedure N0Click(Sender: TObject);
    procedure N12Click(Sender: TObject);
    procedure N13Click(Sender: TObject);
    procedure Tools_Chart1Execute(Sender: TObject);
    procedure Tools_Chart2Execute(Sender: TObject);
    procedure FormShow(Sender: TObject);
  private
    { Private declarations }
  public
    function GetExePath: String;
    { Public declarations }
  end;

var
  MainForm: TMainForm;

implementation

{$R *.DFM}

uses Child_lab, Chind_Address, Child_Code, Child_Borrow,
  About, Child_Sort, Child_Chart, Child_Chart1, Child_Chart2;

procedure OpenForm(FormClass: TFormClass; var fm; AOwner:TComponent);
var
  i: integer;
  Child:TForm;
begin
  for i := 0 to Screen.FormCount -1 do
      if Screen.Forms[i].ClassType=FormClass then
      begin
        Child:=Screen.Forms[i];
        if Child.WindowState=wsMinimized then
           ShowWindow(Child.handle,SW_SHOWNORMAL)
        else
           ShowWindow(Child.handle,SW_SHOWNA);
        if (not Child.Visible) then Child.Visible:=True;
        Child.BringToFront;
        Child.Setfocus;
        TForm(fm):=Child;
        exit;
      end;
  Child:=TForm(FormClass.NewInstance);
  TForm(fm):=Child;
  Child.Create(AOwner);
end;

function TMainForm.GetExePath:String;
begin
  Result:=ExtractFilePath(ParamStr(0));
  if Result[Length(Result)]<>'\' then
    Result:=Result+'\';
end;

procedure TMainForm.YQ_LabExecute(Sender: TObject);
begin
  OpenForm(Tfrm_YQ_Lab,frm_YQ_Lab, self);
end;

procedure TMainForm.YQ_BorrowExecute(Sender: TObject);
begin
  OpenForm(Tfrm_Borrow,frm_Borrow, self);
end;

procedure TMainForm.HelpAbout1Execute(Sender: TObject);
begin
//  AboutBox.ShowModal;
end;

procedure TMainForm.FileExit1Execute(Sender: TObject);
begin
  Close;
end;

procedure TMainForm.AddressListExecute(Sender: TObject);
begin
  OpenForm(Tfrm_Address,frm_Address, self);
end;

procedure TMainForm.YQ_CodeExecute(Sender: TObject);
begin
  OpenForm(Tfrm_Code,frm_Code, self);
end;

procedure TMainForm.FormCreate(Sender: TObject);
begin
//  Application.HintColor:=clWhite;
  Application.HintPause:=100;
//  FormStorage1.IniFileName:=GetExePath+'MyLab.ini';
end;

procedure TMainForm.HelpAboutExecute(Sender: TObject);
begin
  Application.CreateForm(Tfrm_About, frm_About);
  frm_About.ShowModal;
end;

procedure TMainForm.Tools_SortExecute(Sender: TObject);
begin
  OpenForm(Tfrm_Sort,frm_Sort, self);
end;

procedure TMainForm.Tools_ChartExecute(Sender: TObject);
begin
  OpenForm(Tfrm_Chart,frm_Chart, self);
end;

procedure TMainForm.N0Click(Sender: TObject);
begin
  //打开记事本
  if sender=N11 then
  begin
    Winexec('Notepad.exe',sw_Normal);
  end;
  //打开计算器
  if sender=N10 then
  begin
    Winexec('CALC.EXE',sw_Normal);
  end;
end;

procedure TMainForm.N12Click(Sender: TObject);
begin
  N12.Checked:=not N12.Checked;
  if N12.Checked then ToolBar2.Visible:=True else ToolBar2.Visible:=False;
end;

procedure TMainForm.N13Click(Sender: TObject);
begin
  N13.Checked:=not N13.Checked;
  if N13.Checked then StatusBar.Visible:=True else StatusBar.Visible:=False;
end;

procedure TMainForm.Tools_Chart1Execute(Sender: TObject);
begin
  OpenForm(Tfrm_Chart1,frm_Chart1, self);
end;

procedure TMainForm.Tools_Chart2Execute(Sender: TObject);
begin
  OpenForm(Tfrm_Chart2,frm_Chart2, self);
end;

procedure TMainForm.FormShow(Sender: TObject);
begin
  YQ_LabExecute(Sender);
end;

end.