⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 main.pas

📁 仓库管理信息系统
💻 PAS
字号:
unit main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Menus, ComCtrls, ToolWin, FR_Desgn, FR_Class, FR_DSet, FR_DBSet;

type
  Tmainfrm = class(TForm)
    CoolBar1: TCoolBar;
    ToolBar1: TToolBar;
    MainMenu1: TMainMenu;
    N1: TMenuItem;
    mnjcdwh: TMenuItem;
    N3: TMenuItem;
    mnccdwh: TMenuItem;
    N5: TMenuItem;
    mndjtzwh: TMenuItem;
    N7: TMenuItem;
    mncldqkc: TMenuItem;
    N15: TMenuItem;
    mngyjccx: TMenuItem;
    N17: TMenuItem;
    mnckwh: TMenuItem;
    N19: TMenuItem;
    mngyswh: TMenuItem;
    mnjclxwh: TMenuItem;
    N22: TMenuItem;
    mnlybmwh: TMenuItem;
    mncclxwh: TMenuItem;
    N25: TMenuItem;
    mncllxwh: TMenuItem;
    mnclbmwh: TMenuItem;
    N9: TMenuItem;
    mnyhsz: TMenuItem;
    N28: TMenuItem;
    mndqmmxg: TMenuItem;
    mnysrwh: TMenuItem;
    frReport1: TfrReport;
    frDesigner1: TfrDesigner;
    mmbb: TMenuItem;
    mnbbgl: TMenuItem;
    mnccdcx: TMenuItem;
    N4: TMenuItem;
    mnjcdcx: TMenuItem;
    N8: TMenuItem;
    mndjtzcx: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure mnckwhClick(Sender: TObject);
    procedure mngyswhClick(Sender: TObject);
    procedure mnjclxwhClick(Sender: TObject);
    procedure mnlybmwhClick(Sender: TObject);
    procedure mncclxwhClick(Sender: TObject);
    procedure mncllxwhClick(Sender: TObject);
    procedure mnclbmwhClick(Sender: TObject);
    procedure mnjcdwhClick(Sender: TObject);
    procedure mnysrwhClick(Sender: TObject);
    procedure mnccdwhClick(Sender: TObject);
    procedure mndjtzwhClick(Sender: TObject);
    procedure mncldqkcClick(Sender: TObject);
    procedure mngyjccxClick(Sender: TObject);
    procedure mnyhszClick(Sender: TObject);
    procedure mndqmmxgClick(Sender: TObject);
    procedure mnbbglClick(Sender: TObject);
    procedure mnccdcxClick(Sender: TObject);
    procedure mnjcdcxClick(Sender: TObject);
    procedure mndjtzcxClick(Sender: TObject);
  private
    { Private declarations }
  public
     ckmc,yhmc,yhid,ckid:string;
     cjqx:boolean;
    { Public declarations }
  end;

var
  mainfrm: Tmainfrm;

implementation

uses data, ckwh, gyswh, jclxwh, clbmwh, cclxwh, cllxwh, jcdwh, ysrwh, ccdwh,
  lybmwh, cjtjwh, clkccx, cljccx, yhqxwh,dlpd, mmxg, bmyly, gysjhqk,
  qclyjeb;

{$R *.dfm}

procedure Tmainfrm.FormCreate(Sender: TObject);
var sltConn:TStringlist;
    ConnStrFile,str_connet:STRING;
begin
yhid:='adf';
ckid:='ddd';
ConnStrFile:=ExtractFileDir(application.ExeName)+'\Sqlset.ini';
sltConn := TStringList.Create;
TRY
if FileExists(ConnStrFile) then
BEGIN
   sltConn.LoadFromFile(ConnStrFile);
   str_connet := sltConn.Text;
   dm.adocn.Close;
   DM.adocn.ConnectionString:=STR_CONNET;
   try
     DM.adocn.Connected:=TRUE;
   except
     showmessage('无法连接服务器,请检查服务器或配置文件!');
     application.Terminate;
   end;
END
ELSE
  with Application do
  begin
  MessageBox('请先在程序运行目录下,设置好连接文件:Sqlset.ini','注意!', );
  Terminate;
  end;
FINALLY
sltConn.free;
END;
end;

procedure Tmainfrm.FormClose(Sender: TObject; var Action: TCloseAction);
VAR I:INTEGER;
begin
  if Screen.FormCount>1 then
  begin
   for i:=0 to Screen.FormCount-1 do
   begin
//     if Screen.Forms[i].Caption<>Self.Caption then
//     begin
//       screen.ActiveForm.Close;
//      ShowMessage('请先关闭"'+Screen.Forms[i].Caption+'"窗口后,再关闭系统!');
//       abort;
//     end;
   end;
  end;
  if MessageDlg('确实要退出系统吗 ?', mtConfirmation,
    [mbYes, mbNo], 0) = mrYes then
    begin
    Application.Terminate;
    end
  else
    abort;
end;

procedure Tmainfrm.mnckwhClick(Sender: TObject);
begin
if not Assigned(CKWHFRM) then
  CKWHFRM := tCKWHFRM.Create(Self);
  CKWHFRM.ShowModal;
end;

procedure Tmainfrm.mngyswhClick(Sender: TObject);
begin
if not Assigned(gysWHFRM) then
  gysWHFRM := tgysWHFRM.Create(Self);
  gysWHFRM.ShowModal;
end;

procedure Tmainfrm.mnjclxwhClick(Sender: TObject);
begin
if not Assigned(jclxWHFRM) then
  jclxWHFRM := tjclxWHFRM.Create(Self);
  jclxWHFRM.ShowModal;
end;

procedure Tmainfrm.mnlybmwhClick(Sender: TObject);
begin
if not Assigned(bmlyWHFRM) then
  bmlyWHFRM := tbmlyWHFRM.Create(Self);
  bmlyWHFRM.ShowModal;
end;

procedure Tmainfrm.mncclxwhClick(Sender: TObject);
begin
if not Assigned(cclxWHFRM) then
  cclxWHFRM := tcclxWHFRM.Create(Self);
  cclxWHFRM.ShowModal;
end;

procedure Tmainfrm.mncllxwhClick(Sender: TObject);
begin
if not Assigned(cllxWHFRM) then
  cllxWHFRM := tcllxWHFRM.Create(Self);
  cllxWHFRM.ShowModal;
end;

procedure Tmainfrm.mnclbmwhClick(Sender: TObject);
begin
if not Assigned(clbmWHFRM) then
  clbmWHFRM := tclbmWHFRM.Create(Self);
  clbmWHFRM.ShowModal;
end;

procedure Tmainfrm.mnjcdwhClick(Sender: TObject);
begin
if not Assigned(jcdWHFRM) then
  jcdWHFRM := tjcdWHFRM.Create(Self);
  jcdWHFRM.ShowModal;
end;

procedure Tmainfrm.mnysrwhClick(Sender: TObject);
begin
if not Assigned(ysrwhfrm) then
  ysrwhfrm := tysrwhfrm.Create(Self);
  ysrwhfrm.ShowModal;
end;

procedure Tmainfrm.mnccdwhClick(Sender: TObject);
begin
if not Assigned(ccdwhfrm) then
  ccdwhfrm := tccdwhfrm.Create(Self);
  ccdwhfrm.ShowModal;
end;

procedure Tmainfrm.mndjtzwhClick(Sender: TObject);
begin
if not Assigned(cjtzwhfrm) then
  cjtzwhfrm := tcjtzwhfrm.Create(Self);
  cjtzwhfrm.ShowModal;
end;

procedure Tmainfrm.mncldqkcClick(Sender: TObject);
begin
if not Assigned(clkccxfrm) then
  clkccxfrm := tclkccxfrm.Create(Self);
  clkccxfrm.Show;
end;

procedure Tmainfrm.mngyjccxClick(Sender: TObject);
begin
if not Assigned(cljccxfrm) then
  cljccxfrm := tcljccxfrm.Create(Self);
  cljccxfrm.Show;
end;

procedure Tmainfrm.mnyhszClick(Sender: TObject);
begin
if not Assigned(yhqxWHFRM) then
  yhqxWHFRM := tyhqxWHFRM.Create(Self);
  yhqxWHFRM.ShowModal;
end;

procedure Tmainfrm.mndqmmxgClick(Sender: TObject);
begin
if not Assigned(mmxgfrm) then
  mmxgfrm := tmmxgfrm.Create(Self);
  mmxgfrm.ShowModal;
end;

procedure Tmainfrm.mnbbglClick(Sender: TObject);
begin
frreport1.DesignReport;
end;

procedure Tmainfrm.mnccdcxClick(Sender: TObject);
begin
if not Assigned(bmlyhzb) then
  bmlyhzb := tbmlyhzb.Create(Self);
  bmlyhzb.Show;
end;

procedure Tmainfrm.mnjcdcxClick(Sender: TObject);
begin
if not Assigned(gysjhqkfrm) then
  gysjhqkfrm := tgysjhqkfrm.Create(Self);
  gysjhqkfrm.Show;
end;

procedure Tmainfrm.mndjtzcxClick(Sender: TObject);
begin
if not Assigned(qclyfrm) then
  qclyfrm := tqclyfrm.Create(Self);
  qclyfrm.Show;
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -