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

📄 umain.pas

📁 明日科技的《Delphi数据库开发案例精选》中的资源管理系统源代码。界面美观
💻 PAS
字号:
🔍 
unit UMAIN;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Buttons, ExtCtrls, jpeg, StdCtrls,shellapi,DB,ADODB,DBGrids,Grids;
type
    UserInfo = record
    UserID: string;
    UserName: string;
  end;
type
  TFRM_MAIN = class(TForm)
    Timer1: TTimer;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    Image1: TImage;
    SpeedButton1: TSpeedButton;
    SpeedButton10: TSpeedButton;
    SpeedButton11: TSpeedButton;
    SpeedButton12: TSpeedButton;
    SpeedButton13: TSpeedButton;
    SpeedButton14: TSpeedButton;
    SpeedButton15: TSpeedButton;
    SpeedButton16: TSpeedButton;
    SpeedButton17: TSpeedButton;
    SpeedButton2: TSpeedButton;
    SpeedButton3: TSpeedButton;
    SpeedButton4: TSpeedButton;
    SpeedButton5: TSpeedButton;
    SpeedButton6: TSpeedButton;
    SpeedButton7: TSpeedButton;
    SpeedButton8: TSpeedButton;
    SpeedButton9: TSpeedButton;
    Label2: TLabel;
    Label1: TLabel;
    Label3: TLabel;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure SpeedButton11Click(Sender: TObject);
    procedure SpeedButton12Click(Sender: TObject);
    procedure SpeedButton14Click(Sender: TObject);
    procedure SpeedButton15Click(Sender: TObject);
    procedure SpeedButton16Click(Sender: TObject);
    procedure SpeedButton10Click(Sender: TObject);
    procedure SpeedButton13Click(Sender: TObject);
    procedure SpeedButton17Click(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure SpeedButton2Click(Sender: TObject);
    procedure SpeedButton3Click(Sender: TObject);
    procedure SpeedButton4Click(Sender: TObject);
    procedure SpeedButton5Click(Sender: TObject);
    procedure SpeedButton6Click(Sender: TObject);
    procedure SpeedButton7Click(Sender: TObject);
    procedure SpeedButton8Click(Sender: TObject);
    procedure SpeedButton9Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
  private
    { Private declarations }
  public
    Auser:UserInfo;
    procedure SetDBGird(ADBGrid: TDBGrid;dat:TCustomADODataset; const Rect: TRect; DataCol: Integer; Column: TColumn; State: TGridDrawState);
    { Public declarations }
  end;

var
  FRM_MAIN: TFRM_MAIN;
  ActionCD:string;
implementation

uses UDM, ULOGIN, USC, UABOUT, UYHQX, UGSJBXX, UBMJBXX, UYGJBXX, UKHJBXX,
  USJJBXX, UCLJBXX, UHWTYGL, UHWSQXX, UKHYSXX;

{$R *.dfm}
procedure TFRM_MAIN.SetDBGird(ADBGrid: TDBGrid;dat:TCustomADODataset; const Rect: TRect;
  DataCol: Integer; Column: TColumn; State: TGridDrawState);
begin
  if ((State = [gdSelected]) or (State=[gdSelected,gdFocused])) then //选中行用蓝色显示
   ADBGrid.Canvas.Brush.color:=$00FFB99C;
   ADBGrid.Canvas.pen.mode:=pmMask;
   ADBGrid.DefaultDrawColumnCell(Rect,DataCol,Column,State);
end;
procedure TFRM_MAIN.FormClose(Sender: TObject; var Action: TCloseAction);
begin                 //退出系统提示
  if MessageBox(0,'是否要退出本系统？','提示信息',MB_YESNO+MB_ICONQUESTION)=IDYES then
  begin
    Application.Terminate;
    end
    else
    begin
      Action := caNone;
    end;
end;

procedure TFRM_MAIN.FormCreate(Sender: TObject);
begin
  try
    if (Screen.Width=800) and (Screen.Height=600) then
    begin
      FRM_MAIN.Left:=0;
      FRM_MAIN.Width:=800;
      FRM_MAIN.Top:=0;
      FRM_MAIN.Height:=566;
    end;
    if (Screen.Width=1024) and ( Screen.Height=768) then
    begin
      FRM_MAIN.Width:=800;
      FRM_MAIN.Height:=566;
      FRM_MAIN.Position:=poDesktopCenter;
    end;
  except
    Application.MessageBox('请正确选择屏幕分辨率：1024X768 或 800X600 !','提示！',0+64);
    exit;
  end;
end;

procedure TFRM_MAIN.Timer1Timer(Sender: TObject);
begin
  Label1.Caption:='系统时间：'+DateTimeToStr(now);
end;

procedure TFRM_MAIN.SpeedButton11Click(Sender: TObject);
var
  Str_Path:string;
begin
  SaveDialog1.Filter := '所有文件(*.*)|*.*';
  SaveDialog1.Title := '选择备份路径和文件名';
  if SaveDialog1.Execute=true then
    begin
      Str_Path:=SaveDialog1.FileName;
    end;
  if Str_Path<>'' then
    begin
      with DM.QSJBF do
        begin
          try
            Screen.Cursor := crHourGlass;
            DM.QSJBF.Close;
            DM.QSJBF.SQL.Clear;
            DM.QSJBF.SQL.Add(' BACKUP DATABASE 物流管理系统 TO DISK ='+'''' +Str_Path+'''');
            DM.QSJBF.ExecSQL();
            Screen.Cursor := crDefault;
            Application.MessageBox('数据库备份成功完成','数据库备份',0+mb_iconinformation);
         except
            Screen.Cursor := crDefault;
            Application.MessageBox('数据库备份失败！请检查备份路径或网络状态','数据库备份',0+mb_iconinformation);
            exit;
          end;
        end;
    end;
end;

procedure TFRM_MAIN.SpeedButton12Click(Sender: TObject);
var
  Str_Path:string;
begin
  DM.ADOConn.Close;
  DM.ADOConn.Connected:=False;
  Opendialog1.Filter := '所有文件(*.*)|*.*';
  Opendialog1.Title := '选择恢复文件路径和文件名';
  if Opendialog1.Execute then
    Str_Path:=opendialog1.FileName;
  if Str_Path<>'' then
  begin
    with DM.QSJHF do
    begin
    try
      try
        Screen.Cursor := crHourGlass;
        Close;
        SQL.Clear;
        SQL.Add('use master restore  DATABASE 物流管理系统 from DISK ='+'''' +Str_Path+'''');
        ExecSQL();
        Screen.Cursor := crDefault;
        Application.MessageBox('数据库恢复成功完成!','数据库恢复',0+mb_iconinformation);
      except
        Screen.Cursor := crDefault;
        Application.MessageBox('数据库恢复失败！请检查备份路径或网络状态','数据库恢复',0+mb_iconinformation);
        exit;
      end;
      Finally
        with DM.ADOQuery1 do
          begin
            Close;
            SQL.Clear;
            SQL.Add('USE 物流管理系统');
            ExecSQL;
          end;
      end;
    end;
  end;
  DM.ADOConn.Open;
  DM.ADOConn.Connected:=True;
end;

procedure TFRM_MAIN.SpeedButton14Click(Sender: TObject);
begin
  ShellExecute(handle,'open','calc.exe',nil,nil,sw_shownormal);
end;

procedure TFRM_MAIN.SpeedButton15Click(Sender: TObject);
begin
  ShellExecute(handle,'open','notepad.exe',nil,nil,sw_shownormal);
end;

procedure TFRM_MAIN.SpeedButton16Click(Sender: TObject);
begin
  Application.CreateForm(TFRM_ABOUT,FRM_ABOUT);
  FRM_ABOUT.ShowModal;
  FRM_ABOUT.Free;
end;

procedure TFRM_MAIN.SpeedButton10Click(Sender: TObject);
begin
  Close;
end;

procedure TFRM_MAIN.SpeedButton13Click(Sender: TObject);
begin
  Application.CreateForm(TFRM_YHQX,FRM_YHQX);
  ACtionCD:='M';
  FRM_YHQX.ShowModal;
  FRM_YHQX.Free;
end;

procedure TFRM_MAIN.SpeedButton17Click(Sender: TObject);
var
stable:TStringList;
i:integer;
begin
  if application.messagebox(pchar('系统初始化将清空所有数据，是否要开始？'),
     pchar('警告'),64+MB_YESNO)<>IDYES then
  begin
    exit;
  end;
  stable:=TStringlist.create;
  stable.Add('部门信息表');
  stable.Add('车辆信息表');
  stable.Add('货物申请信息表');
  stable.Add('货物托运信息表');
  stable.Add('用户表');
  stable.Add('客户验收信息表');
  stable.Add('客户信息表');
  stable.Add('员工信息表');
  stable.Add('司机信息表');
  stable.Add('公司信息表');
  for i:=0 to stable.count-1 do
    begin
      DM.QCSH.SQL.clear;
      DM.QCSH.SQL.Add('delete from '+stable.Strings[i]);
      DM.QCSH.ExecSQL;
    end;
  DM.QCSH.SQL.Clear;
  DM.QCSH.sql.add('insert into 用户表(用户编号,用户名称,密码,B1,B2,B3,B4,B5,B6,B7,B8,B9,B10,B11,B12,B13,B14,B15,B16)');
  DM.QCSH.SQL.Add('values(''YH20051209001'',''mingrisoft'',''mingrisoft'',''1'',''1'',''1'',''1'',''1'',''1'',''1'',''1'',''1'',''1'',''1'',''1'',''1'',''1'',''1'',''1'')');
  DM.QCSH.ExecSQL;
  DM.ADOConn.Close;
  DM.ADOConn.Connected:=False;
  DM.ADOConn.Open;
  DM.ADOConn.Connected:=True;
  application.MessageBox('系统初始化成功！','提示',0);
  Exit;
  stable.free;              
end;
procedure TFRM_MAIN.SpeedButton1Click(Sender: TObject);
begin
  Application.CreateForm(TFRM_GSJBXX,FRM_GSJBXX);
  FRM_GSJBXX.ShowModal;
  FRM_GSJBXX.Free;
end;

procedure TFRM_MAIN.SpeedButton2Click(Sender: TObject);
begin
  Application.CreateForm(TFRM_BMJBXX,FRM_BMJBXX);
  ACtionCD:='M';
  FRM_BMJBXX.ShowModal;
  FRM_BMJBXX.Free;
end;

procedure TFRM_MAIN.SpeedButton3Click(Sender: TObject);
begin
  Application.CreateForm(TFRM_YGJBXX,FRM_YGJBXX);
  ACtionCD:='M';
  FRM_YGJBXX.ShowModal;
  FRM_YGJBXX.Free;
end;

procedure TFRM_MAIN.SpeedButton4Click(Sender: TObject);
begin
  Application.CreateForm(TFRM_KHJBXX,FRM_KHJBXX);
  ACtionCD:='M';
  FRM_KHJBXX.ShowModal;
  FRM_KHJBXX.Free;
end;

procedure TFRM_MAIN.SpeedButton5Click(Sender: TObject);
begin
  Application.CreateForm(TFRM_SJJBXX,FRM_SJJBXX);
  ACtionCD:='M';
  FRM_SJJBXX.ShowModal;
  FRM_SJJBXX.Free;
end;

procedure TFRM_MAIN.SpeedButton6Click(Sender: TObject);
begin
  Application.CreateForm(TFRM_CLJBXX,FRM_CLJBXX);
  ACtionCD:='M';
  FRM_CLJBXX.ShowModal;
  FRM_CLJBXX.Free;
end;

procedure TFRM_MAIN.SpeedButton7Click(Sender: TObject);
begin
  try
    if (Screen.Width=800) and (Screen.Height=600) then
    begin
      Application.CreateForm(TFRM_HWSQXX,FRM_HWSQXX);
      FRM_HWSQXX.Left:=0;
      FRM_HWSQXX.Width:=800;
      FRM_HWSQXX.Top:=0;
      FRM_HWSQXX.Height:=566;
      ACtionCD:='M';
      FRM_HWSQXX.ShowModal;
      FRM_HWSQXX.Free;
    end;
    if (Screen.Width=1024) and ( Screen.Height=768) then
    begin
      Application.CreateForm(TFRM_HWSQXX,FRM_HWSQXX);
      FRM_HWSQXX.Width:=800;
      FRM_HWSQXX.Height:=566;
      FRM_HWSQXX.Position:=poDesktopCenter;
      ACtionCD:='M';
      FRM_HWSQXX.ShowModal;
      FRM_HWSQXX.Free;
    end;
  except
    Application.MessageBox('请正确选择屏幕分辨率：1024X768 或 800X600 !','提示！',0+64);
    exit;
  end;
end;

procedure TFRM_MAIN.SpeedButton8Click(Sender: TObject);
begin
  try
    if (Screen.Width=800) and (Screen.Height=600) then
    begin
      Application.CreateForm(TFRM_HWTYGL,FRM_HWTYGL);
      FRM_HWTYGL.Left:=0;
      FRM_HWTYGL.Width:=800;
      FRM_HWTYGL.Top:=0;
      FRM_HWTYGL.Height:=566;
      ACtionCD:='M';
      FRM_HWTYGL.ShowModal;
      FRM_HWTYGL.Free;
    end;
    if (Screen.Width=1024) and ( Screen.Height=768) then
    begin
      Application.CreateForm(TFRM_HWTYGL,FRM_HWTYGL);
      FRM_HWTYGL.Width:=800;
      FRM_HWTYGL.Height:=566;
      FRM_HWTYGL.Position:=poDesktopCenter;
      ACtionCD:='M';
      FRM_HWTYGL.ShowModal;
      FRM_HWTYGL.Free;
    end;
  except
    Application.MessageBox('请正确选择屏幕分辨率：1024X768 或 800X600 !','提示！',0+64);
    exit;
  end;
end;                  

procedure TFRM_MAIN.SpeedButton9Click(Sender: TObject);
begin
  Application.CreateForm(TFRM_KHYSXX,FRM_KHYSXX);
  ACtionCD:='M';
  FRM_KHYSXX.ShowModal;
  FRM_KHYSXX.Free;
end;

procedure TFRM_MAIN.FormShow(Sender: TObject);
begin
  Label3.Caption:='操 作 员:  ' + Auser.UserName;
end;

end.

⌨️ 快捷键说明

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