main.pas

一个桌面数据库应用的源码,适合初学数据库编程的新手.

unit Main;

interface

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

type
  TMainForm = class(TForm)
    OpenDialog: TOpenDialog;
    StatusBar: TStatusBar;
    ImageList1: TImageList;
    ActionManager1: TActionManager;
    Action1: TAction;
    Action2: TAction;
    Action3: TAction;
    Action4: TAction;
    Action5: TAction;
    EditCut2: TEditCut;
    EditCopy2: TEditCopy;
    EditPaste2: TEditPaste;
    WindowCascade2: TWindowCascade;
    WindowTileHorizontal2: TWindowTileHorizontal;
    WindowTileVertical2: TWindowTileVertical;
    WindowMinimizeAll2: TWindowMinimizeAll;
    WindowArrange1: TWindowArrange;
    EditUndo2: TEditUndo;
    Action6: TAction;
    Action7: TAction;
    Action8: TAction;
    Action9: TAction;
    Action10: TAction;
    ControlBar1: TControlBar;
    ActionMainMenuBar1: TActionMainMenuBar;
    ActionToolBar1: TActionToolBar;
    Action11: TAction;
    WindowClose1: TWindowClose;
    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 Tools_Chart1Execute(Sender: TObject);
    procedure Tools_Chart2Execute(Sender: TObject);
  private
    function ExistsForm(MDIFormCaption:String): boolean;
    { 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;

function TMainForm.ExistsForm(MDIFormCaption:String):boolean;
var
  i:byte;
begin
  result:=true;
  for i:=0 to MDIChildCount-1 do
  begin
    if MDIChildren[i].Caption=MDIFormCaption
    then result:=false;
  end;
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;
end;

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

procedure TMainForm.Tools_SortExecute(Sender: TObject);
begin
  if ExistsForm('数据库排序察看') then
  begin
    Tfrm_Sort.Create(Application);
  end else
  begin
    ShowMessage('数据库排序察看窗口已经打开！');
  end;
end;

procedure TMainForm.Tools_ChartExecute(Sender: TObject);
begin
  if ExistsForm('仪器状态统计图表') then
  begin
    Tfrm_Chart.Create(Application);
  end else
  begin
    ShowMessage('仪器状态统计图表窗口已经打开！');
  end;
end;

procedure TMainForm.Tools_Chart1Execute(Sender: TObject);
begin
  if ExistsForm('仪器分类统计图表') then
  begin
    Tfrm_Chart1.Create(Application);
  end else
  begin
    ShowMessage('仪器分类统计图表窗口已经打开！');
  end;
end;

procedure TMainForm.Tools_Chart2Execute(Sender: TObject);
begin
  if ExistsForm('仪器所属实验统计图表') then
  begin
    Tfrm_Chart2.Create(Application);
  end else
  begin
    ShowMessage('仪器所属实验统计图表窗口已经打开！');
  end;
end;

end.