umain.pas

这是一个门禁系统的应用程序,用 delphi编写,希望与大家交流.

unit umain;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Menus, Jpeg, ExtCtrls, XPMenu, ComObj, ComCtrls, IniFiles, ImgList,
  ActnList;

type
  TfrmPer = class(TForm)
    mnuPer: TMainMenu;
    miSys: TMenuItem;
    miChgPwd: TMenuItem;
    miAdmin: TMenuItem;
    miLogin: TMenuItem;
    space01: TMenuItem;
    miExit: TMenuItem;
    tmrMain: TTimer;
    sbPer: TStatusBar;
    tmrTime: TTimer;
    miStaff: TMenuItem;
    miStaInfo: TMenuItem;
    miAdds: TMenuItem;
    miInqus: TMenuItem;
    miEdits: TMenuItem;
    miDels: TMenuItem;
    miSet: TMenuItem;
    miDep: TMenuItem;
    space02: TMenuItem;
    miAbout: TMenuItem;
    miTrs: TMenuItem;
    miCData: TMenuItem;
    miBkData: TMenuItem;
    miData: TMenuItem;
    miReData: TMenuItem;
    miSetp: TMenuItem;
    miRepir: TMenuItem;
    imgMain: TImage;
    xmPer: TXPMenu;
    miSeto: TMenuItem;
    miOther: TMenuItem;
    ilPer: TImageList;
    alPer: TActionList;
    actDep: TAction;
    actChgpwd: TAction;
    actOther: TAction;
    actAdmin: TAction;
    actLogin: TAction;
    actExitSystem: TAction;
    actStaInfo: TAction;
    actAdd: TAction;
    actEdit: TAction;
    actDel: TAction;
    actSet: TAction;
    actTrans: TAction;
    actBackup: TAction;
    actPress: TAction;
    actRepair: TAction;
    actRestore: TAction;
    actInqu: TAction;
    procedure tmrMainTimer(Sender: TObject);
    procedure tmrTimeTimer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure actChgpwdExecute(Sender: TObject);
    procedure actAdminExecute(Sender: TObject);
    procedure actLoginExecute(Sender: TObject);
    procedure actExitSystemExecute(Sender: TObject);
    procedure actStaInfoExecute(Sender: TObject);
    procedure actAddExecute(Sender: TObject);
    procedure actEditExecute(Sender: TObject);
    procedure actDelExecute(Sender: TObject);
    procedure actInquExecute(Sender: TObject);
    procedure actDepExecute(Sender: TObject);
    procedure actOtherExecute(Sender: TObject);
    procedure actSetExecute(Sender: TObject);
    procedure actTransExecute(Sender: TObject);
    procedure actBackupExecute(Sender: TObject);
    procedure actPressExecute(Sender: TObject);
    procedure actRepairExecute(Sender: TObject);
    procedure actRestoreExecute(Sender: TObject);
    procedure miAboutClick(Sender: TObject);
  private
    { Private declarations }
    procedure ActiveForm;
  public
    { Public declarations }
  end;

var
  frmPer: TfrmPer;

implementation

uses ulogin, uchgpwd, uglobal, uadmin, ustainfo, ufind, udep, uabout,
  udata, uset, uoinfo, uredata;

{$R *.dfm}

procedure TfrmPer.FormCreate(Sender: TObject);
var
  iFile: TIniFile;
begin
  sPath := ExtractFilePath(Application.ExeName);
  iFile := TIniFile.Create(sPath + 'perset.ini');
  sTopic := iFile.ReadString('sTopic', 'topic', '秋风人事档案管理系统1.9正式版');
  bgstr := iFile.ReadString('sysbg', 'bground', 'main.jpg');
  bStaffBirth := iFile.ReadBool('staff', 'sbirth', false);
  iFile.Free;
  if sTopic = '' then sTopic := '秋风人事档案管理系统1.9正式版';
  if (bgStr = '') or (not FileExists(sPath + bgStr)) then
    bgStr := 'main.jpg';
  imgMain.Picture.LoadFromFile(sPath + bgStr);
  self.Caption := sTopic;
  Application.Title := sTopic;
  Application.ShowHint := true;
  Application.HintColor := clLime;
  self.Constraints.MaxWidth := 800;
  self.Constraints.MaxHeight := 600;
end;

procedure TfrmPer.tmrMainTimer(Sender: TObject);
var
  frmLogin: TfrmLogin;
begin
  sbPer.Panels[0].Text := '管理员:还没有登录';
  sbPer.Panels[1].Text := sTopic;
  tmrMain.Enabled := false;
  frmLogin := TfrmLogin.Create(self);
  if frmLogin.ShowModal <> mrOk then
    Close;
  FreeAndNil(frmLogin);
  self.Caption := sTopic;
  self.Caption := self.Caption + '  管理员：' + sUserID;

  sbPer.Panels[0].Text := '管理员:' + sUserID;
  if sysAdmin then
  begin
    self.Caption := self.Caption + '  --系统管理员';
    sbPer.Panels[0].Text := sbPer.Panels[0].Text + '  您是系统管理员';
  end
  else
    sbPer.Panels[0].Text := sbPer.Panels[0].Text + '  您是普通管理员';
end;

procedure TfrmPer.tmrTimeTimer(Sender: TObject);
var
  wdStr: string;
begin
  case DayOfWeek(Date()) of
    1: wdStr := '星期日';
    2: wdStr := '星期一';
    3: wdStr := '星期二';
    4: wdStr := '星期三';
    5: wdStr := '星期四';
    6: wdStr := '星期五';
    7: wdStr := '星期六';
  end;
  sbPer.Panels[2].Text := FormatDateTime('yyyy年mm月dd日 hh时nn分ss秒', Now()) + '  [' + wdStr + ']';
end;

procedure TfrmPer.ActiveForm;
begin
  if not Assigned(frmStainfo) then
    frmStainfo := TfrmStainfo.Create(Application)
  else if frmStainfo.WindowState = wsMinimized then
    frmStainfo.WindowState := wsNormal;
end;

procedure TfrmPer.actChgpwdExecute(Sender: TObject);
var
  frmChgPwd: TfrmChgPwd;
begin
  sbPer.Panels[1].Text := '更新您的密码';
  frmChgPwd := TfrmChgPwd.Create(self);
  if frmChgPwd.ShowModal = mrOk then
    MessageBox(self.Handle, '密码更新成功!', '提示',  mb_IconInformation + mb_Ok);
  FreeAndNil(frmChgPwd);
  sbPer.Panels[1].Text := sTopic;
end;

procedure TfrmPer.actAdminExecute(Sender: TObject);
var
  frmAdmin: TfrmAdmin;
begin
  sbPer.Panels[1].Text := '管理员管理--此为系统管理员权限';
  if sysAdmin = true then
  begin
    frmAdmin := TfrmAdmin.Create(self);
    frmAdmin.ShowModal;
    FreeAndNil(frmAdmin);
  end
  else
    MessageBox(handle, '这是系统管理员的权限!', '提示',  mb_IconWarning + mb_Ok);
  sbPer.Panels[1].Text := sTopic;
end;

procedure TfrmPer.actLoginExecute(Sender: TObject);
begin
  tmrMainTimer(Sender);
end;

procedure TfrmPer.actExitSystemExecute(Sender: TObject);
begin
  sbPer.Panels[1].Text := '退出系统';
  if MessageBox(self.Handle, '要退出系统么?', '提示',  mb_IconQuestion + mb_YesNo) = idYes then
    Close;
  sbPer.Panels[1].Text := sTopic;
end;

procedure TfrmPer.actStaInfoExecute(Sender: TObject);
begin
  sbPer.Panels[1].Text := '员工档案信息';
  ActiveForm;
end;

procedure TfrmPer.actAddExecute(Sender: TObject);
begin
  sbPer.Panels[1].Text := '档案信息添加';
  ActiveForm;
  frmStaInfo.btnaddClick(Sender);
end;

procedure TfrmPer.actEditExecute(Sender: TObject);
begin
  sbPer.Panels[1].Text := '档案信息编辑';
  ActiveForm;
  if frmStaInfo.tvper.selected.data <> nil then
    frmStaInfo.btneditClick(Sender)
  else
    MessageBox(self.Handle, '请先选择记录!', '提示', mb_IconInformation + mb_Ok);
end;

procedure TfrmPer.actDelExecute(Sender: TObject);
begin
  sbPer.Panels[1].Text := '档案信息删除';
  ActiveForm;
end;

procedure TfrmPer.actInquExecute(Sender: TObject);
var
  frmFind: TfrmFind;
begin
  ActiveForm;
  frmFind := TfrmFind.Create(self);
  frmFind.Show;
end;

procedure TfrmPer.actDepExecute(Sender: TObject);
var
  frmDep: TfrmDep;
begin
  frmDep := TfrmDep.Create(self);
  frmDep.ShowModal;
  FreeAndNil(frmDep);
end;

procedure TfrmPer.actOtherExecute(Sender: TObject);
var
  frmOInfo: TfrmOInfo;
begin
  frmOInfo := TfrmOInfo.Create(self);
  frmOInfo.ShowModal;
  FreeAndNil(frmOInfo);
end;

procedure TfrmPer.actSetExecute(Sender: TObject);
var
  frmSet: TfrmSet;
begin
  frmSet := Tfrmset.Create(self);
  frmSet.ShowModal;
  FreeAndNil(frmSet);
end;

procedure TfrmPer.actTransExecute(Sender: TObject);
begin
  miTrs.Checked := not miTrs.Checked;
  if miTrs.Checked then
  begin
    self.AlphaBlend := true;
    self.AlphaBlendValue := 125;
  end
  else
    self.AlphaBlend := false;
end;

procedure TfrmPer.actBackupExecute(Sender: TObject);
var
  sFileName, sDBName: string;
begin
  if dmPer.acPer.Connected then dmPer.acPer.Close;
  sFileName := 'per' + FormatDateTime('mmdd', Date()) + '.bak';
  sDBName := sPath + sFileName;
  if FileExists(sDBName) then DeleteFile(sDBName);
  CopyFile(Pchar('permis.mdb'), Pchar(sDBName), true);
  MessageBox(self.Handle, PChar('数据已成功备份为[' + sFileName + ']!'), '提示', mb_IconInformation + mb_Ok);
  dmPer.acPer.Open;
end;

procedure CompactAccess(sDBName: string; JetId: string = '4.0');   //压缩
var
  AVariant: Variant;
begin
  if FileExists(sDBName + '.tmp') then DeleteFile(sDBName + '.tmp');
  AVariant := CreateOleObject('JRO.JetEngine');
  AVariant.CompactDataBase('Provider=Microsoft.Jet.OLEDB.' + JetId + ';Jet OLEDB:DataBase Password=780927+790621;Data Source=' + sDBName ,
  'Provider=Microsoft.Jet.OLEDB.' + JetId + ';Jet OLEDB:DataBase Password=780927+790621;Data Source=' + sDBName + '.tmp');
  DeleteFile(sDBName);
  ReNameFile(sDBName + '.tmp', sDBName);
end;

procedure TfrmPer.actPressExecute(Sender: TObject);
var
  sDBName: string;
begin
  if dmPer.acPer.Connected then dmPer.acPer.Close;
  Sleep(500);
  sDBName := sPath + 'permis.mdb';
  CompactAccess(sDBName);
  MessageBox(self.Handle, '数据库压缩成功!', '提示', mb_IconInformation + mb_Ok);
  dmPer.acPer.Open;
end;

procedure TfrmPer.actRepairExecute(Sender: TObject);
var
  sDBName: string;
begin
  if dmPer.acPer.Connected = true then dmPer.acPer.Close;
  Sleep(500);
  sDBName := sPath + 'permis.mdb';
  CompactAccess(sDBName);
  MessageBox(self.Handle, '数据库修复成功!', '提示', mb_IconInformation + mb_Ok);
  dmPer.acPer.Open;
end;

procedure TfrmPer.actRestoreExecute(Sender: TObject);
var
  frmReData: TfrmReData;
begin
  frmReData := TfrmReData.Create(self);
  frmReData.ShowModal;
  FreeAndNil(frmReData);
end;

procedure TfrmPer.miAboutClick(Sender: TObject);
var
  frmAbout: TfrmAbout;
begin
  frmAbout := TfrmAbout.Create(self);
  frmAbout.ShowModal;
  FreeAndNil(frmAbout);
end;

procedure TfrmPer.FormResize(Sender: TObject);
begin
  if Screen.Width = 800 then Exit;
  self.Left := Trunc((Screen.Width - self.Width) / 2);
  self.Top := Trunc((Screen.Height - self.Height) / 2);
end;

end.