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

📄 main.pas

📁 材料租赁
💻 PAS
字号:
unit Main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Menus, ImgList, DB, ADODB, mxOutlookBarPro, StdCtrls, ExtCtrls,
  Buttons, ComCtrls, ToolWin, jpeg, shellapi;

type
  TfrmMain = class(TForm)
    MainMenu1: TMainMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    ADOConnect: TADOConnection;
    PrinterSetup: TPrinterSetupDialog;
    Image1: TImage;
    il1: TImageList;
    il4: TImageList;
    il3: TImageList;
    il2: TImageList;
    ImageListmenu: TImageList;
    ImageList4: TImageList;
    ImageTools: TImageList;
    ImageList2: TImageList;
    clb1: TCoolBar;
    tlb1: TToolBar;
    tbtn3: TToolButton;
    tbtn2: TToolButton;
    tbtnXGMM: TToolButton;
    tbSound: TToolButton;
    tlb2: TToolBar;
    tbtn16: TToolButton;
    tbtnclose: TToolButton;
    tbtn15: TToolButton;
    btnTree: TSpeedButton;
    pnl1: TPanel;
    pnl2: TPanel;
    lbl1: TLabel;
    pnl3: TPanel;
    sb1: TSpeedButton;
    mxOutlookBarPro: TmxOutlookBarPro;
    StatusBar1: TStatusBar;
    N5: TMenuItem;
    N6: TMenuItem;
    N7: TMenuItem;
    N8: TMenuItem;
    N9: TMenuItem;
    N10: TMenuItem;
    N11: TMenuItem;
    N12: TMenuItem;
    N13: TMenuItem;
    N14: TMenuItem;
    N15: TMenuItem;
    N16: TMenuItem;
    N17: TMenuItem;
    N18: TMenuItem;
    adoqytmp: TADOQuery;
    N19: TMenuItem;
    N20: TMenuItem;
    N21: TMenuItem;
    N22: TMenuItem;
    N23: TMenuItem;
    N24: TMenuItem;
    N25: TMenuItem;
    N26: TMenuItem;
    N27: TMenuItem;
    pShwomessage: TPanel;
    adoRep: TADOQuery;
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure tbtncloseClick(Sender: TObject);
    procedure btnTreeClick(Sender: TObject);
    procedure sb1Click(Sender: TObject);
    procedure mxOutlookBarProHeaders4Buttons1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure N5Click(Sender: TObject);
    procedure N6Click(Sender: TObject);
    procedure N19Click(Sender: TObject);
    procedure N21Click(Sender: TObject);
    procedure N12Click(Sender: TObject);
    procedure N8Click(Sender: TObject);
    procedure mxOutlookBarProHeaders0Buttons5Click(Sender: TObject);
    procedure N10Click(Sender: TObject);
    procedure N13Click(Sender: TObject);
    procedure N26Click(Sender: TObject);
    procedure N15Click(Sender: TObject);
    procedure N25Click(Sender: TObject);
    procedure N24Click(Sender: TObject);
    procedure N23Click(Sender: TObject);
    procedure N27Click(Sender: TObject);
  private
   procedure DoEnterAsTab(var Msg: TMsg; var Handled: Boolean);
    { Private declarations }
   procedure CloseAll;
  public

    { Public declarations }
      bConnect:boolean;
      Year,Month,Day:word;
  end;

var
  frmMain: TfrmMain;

implementation
    uses common,U_Public,DBConnectFrm,U_DM,U_dwinfo,U_bmbm,U_User,u_dlck,u_xgmm
         ,u_Spbm,U_clffd,u_Zlflr,u_Clhsd,u_clcx,U_clffd_sort,u_Jsmx,Usltz,Ujetz
         ,utLeasehold;
{$R *.dfm}
//关闭子窗口
procedure TfrmMain.CloseAll;
var
  i:integer;
begin
  for i:=0 to MDIChildCount-1  do
    begin
       MDIChildren[i].Close;
    end;
end;
//  转换TAB
procedure Tfrmmain.DoEnterAsTab(var Msg: TMsg; var Handled: Boolean);
begin
  if Msg.Message = WM_KEYDOWN then
  begin
    if Msg.wParam = VK_RETURN then
      Keybd_event(VK_TAB, 0, 0, 0);
  end; //if      Application.OnMessage := DoEnterAsTab;
end;

procedure TfrmMain.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
 if application.MessageBox('真的要退出本系统吗?!','材料租赁系统!',MB_YESNO)=IDYES then
     begin
      if bConnect then
         CanClose:=True;
 //        dbconnect.Close ;
     end
   else
      CanClose:=False;
end;

procedure TfrmMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Application.Terminate;
end;

procedure TfrmMain.tbtncloseClick(Sender: TObject);
begin
close;
end;

procedure TfrmMain.btnTreeClick(Sender: TObject);
begin
Pnl1.Visible := btnTree.Down;
end;

procedure TfrmMain.sb1Click(Sender: TObject);
begin
  btnTree.Down := false;
  Pnl1.Visible := btnTree.Down;
end;

procedure TfrmMain.mxOutlookBarProHeaders4Buttons1Click(Sender: TObject);
begin
PrinterSetup.Execute ;
end;

procedure TfrmMain.FormCreate(Sender: TObject);
var
  Datapath:string;
  serverName, databaseName, userName, password: string;
begin
//Provider=SQLOLEDB.1;Password=ccponline;Persist Security Info=True;User ID=sa;Initial Catalog=CLZL;Data Source=CCPSEVER;Use Procedure for Prepare=1;Auto Translate=True;Packet Size=4096;Workstation ID=CCPSEVER;Use Encryption for Data=False;Tag with column collation when possible=False
  readFromIni(serverName, databaseName, userName, password);//读取配置文件
 if not ConnectLocalDB(ADOConnect,databaseName,serverName,userName, password) then
    if not DBConnectExecute(TfrmDBConnect) then
      Application.Terminate;  //如果连接不成功,退出应用程序
if not LoginExecute(TfrmLogin) then //如果身份验证无效,就退出系统
    Application.Terminate;
width:=800;
height:=600;
Datapath :=ExtractFilePath(ParamStr(0));
ShortDateFormat:='YYYY/MM/DD';
longdateformat:='YYYY/MM/DD';
DATESEPARATOR:='/';
Application.OnMessage := DoEnterAsTab;
DecodeDate(date,Year,Month,Day);
end;

procedure TfrmMain.N5Click(Sender: TObject);
begin
ShowModalForm(TfrmDwinfo);
end;

procedure TfrmMain.N6Click(Sender: TObject);
var
frmBmda:TfrmBmda;
begin
CloseAll;
screen.Cursor := crHourGlass;
frmBmda:=TfrmBmda.Create(self);
frmBmda.show;
screen.Cursor := crDefault;

end;

procedure TfrmMain.N19Click(Sender: TObject);
begin
ShowModalForm(TfrmUse);
end;

procedure TfrmMain.N21Click(Sender: TObject);
begin
ShowModalForm(TfrmXgmm);
end;

procedure TfrmMain.N12Click(Sender: TObject);
var
frmSpbm:TfrmSpbm;
begin
CloseAll;
screen.Cursor := crHourGlass;
frmSpbm:=TfrmSpbm.Create(self);
frmSpbm.show;
screen.Cursor := crDefault;
end;

procedure TfrmMain.N8Click(Sender: TObject);
var
  frmclffd_sort:Tfrmclffd_sort;
begin
screen.Cursor := crHourGlass;
CloseAll;
CurrentParam.Num :=0;
frmclffd_sort:=Tfrmclffd_sort.Create(self);
frmclffd_sort.Show ;
screen.Cursor := crDefault;
//ShowModalForm(Tfrmclffd_sort);
//ShowModalForm(TfrmClffd);
end;

procedure TfrmMain.mxOutlookBarProHeaders0Buttons5Click(Sender: TObject);
var
frmZlflr:TfrmZlflr;
begin
screen.Cursor := crHourGlass;
frmZlflr:=TfrmZlflr.Create(self);
frmZlflr.show;
//screen.Cursor := crHourGlass;
screen.Cursor := crDefault;

//ShowModalForm(TfrmZlflr);
end;

procedure TfrmMain.N10Click(Sender: TObject);
var
  frmclffd_sort:Tfrmclffd_sort;
begin
CloseAll;
CurrentParam.Num :=1;
frmclffd_sort:=Tfrmclffd_sort.Create(self);
frmclffd_sort.Show ;
//ShowModalForm(Tfrmclffd_sort);
//ShowModalForm(TfrmClhsd);
end;

procedure TfrmMain.N13Click(Sender: TObject);
//var
//frmclcx:Tfrmclcx;
begin
{screen.Cursor := crHourGlass;
frmclcx:=Tfrmclcx.Create(self);
frmclcx.show;
screen.Cursor := crDefault; }
ShowModalForm(Tfrmclcx);
end;

procedure TfrmMain.N26Click(Sender: TObject);
begin
ShellExecute(handle, 'open', 'Calc.exe', nil, nil, SW_SHOWNORMAL);
end;

procedure TfrmMain.N15Click(Sender: TObject);
begin
ShowModalForm(TfrmJsmx );
end;

procedure TfrmMain.N25Click(Sender: TObject);
var
 frmSltz:TfrmSltz;
begin
CloseAll;
screen.Cursor := crHourGlass;
//screen.Cursor := crDefault;
 frmSltz:=TfrmSltz.Create(self);
 frmSltz.Show ;
 screen.Cursor := crDefault;

end;

procedure TfrmMain.N24Click(Sender: TObject);
var
 frmjetz:Tfrmjetz;
begin
CloseAll;
screen.Cursor := crHourGlass;
//screen.Cursor := crDefault;
 frmjetz:=Tfrmjetz.Create(self);
 frmjetz.Show ;
 screen.Cursor := crDefault;
end;

procedure TfrmMain.N23Click(Sender: TObject);
begin
ShellExecute(handle, 'open', 'Ptools.exe', nil, nil, SW_SHOWNORMAL);
end;

procedure TfrmMain.N27Click(Sender: TObject);
var
  sSql:string;
begin
if application.MessageBox('是否要清空所输入的数据?!','材料租赁系统!',MB_YESNO)=IDNO then
exit;
pShwomessage.Caption :='正在清空查询数据,请稍候!......' ;
pShwomessage.Visible :=true;
pShwomessage.Update ;
ADOConnect.BeginTrans;
try
sSql:='DELETE  FROM cljxb';
ExecuteSQL(sSql,adoqytmp,true);
sSql:='DELETE  FROM ggxhb';
ExecuteSQL(sSql,adoqytmp,true);
sSql:='DELETE  FROM sfdj';
ExecuteSQL(sSql,adoqytmp,true);
sSql:='DELETE  FROM sfmx';
ExecuteSQL(sSql,adoqytmp,true);
except
Application.MessageBox('清空数据失败!', '错误', mb_iconInformation + mb_defbutton1);
ADOConnect.RollbackTrans ;
pShwomessage.Visible :=false;
exit;
end;
ADOConnect.CommitTrans ;
Application.MessageBox('数据已被初始完成!', '提示信息', mb_iconInformation + mb_defbutton1);
pShwomessage.Visible :=false;
end;

end.

⌨️ 快捷键说明

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