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

📄 main.pas

📁 非长好的DELPHI办公系统 直接可以用
💻 PAS
字号:
unit MAIN;

interface

uses Windows, SysUtils, Classes, Graphics, Forms, Controls, Menus,
  StdCtrls, Dialogs, Buttons, Messages, ExtCtrls, ComCtrls, StdActns,
  ActnList, ToolWin, ImgList, ADODB,IniFiles;

type
  TMainForm = class(TForm)
    MainMenu1: TMainMenu;
    File1: TMenuItem;
    ItemChapwd: TMenuItem;
    ItemAdmin: TMenuItem;
    Window1: TMenuItem;
    Help1: TMenuItem;
    N1: TMenuItem;
    ItemExit: TMenuItem;
    ItemImport: TMenuItem;
    ItemExport: TMenuItem;
    miLog: TMenuItem;
    OpenDialog: TOpenDialog;
    Edit1: TMenuItem;
    ItemType: TMenuItem;
    ItemGoods: TMenuItem;
    sbPer: TStatusBar;
    ActionList1: TActionList;
    actChapwd: TAction;
    actExit: TAction;
    actAdmin: TAction;
    actAbout: TAction;
    ImageList1: TImageList;
    itemAbout: TMenuItem;
    actLog: TAction;
    actImport: TAction;
    actExport: TAction;
    actType: TAction;
    actGoods: TAction;
    actBack: TAction;
    actRestore: TAction;
    actCom: TAction;
    N2: TMenuItem;
    itemBack: TMenuItem;
    itemRestore: TMenuItem;
    itemCom: TMenuItem;
    imgMain: TImage;
    tmrMain: TTimer;
    actRelogin: TAction;
    N3: TMenuItem;
    procedure actChapwdExecute(Sender: TObject);
    procedure actAdminExecute(Sender: TObject);
    procedure actExitExecute(Sender: TObject);
    procedure actLogExecute(Sender: TObject);
    procedure actAboutExecute(Sender: TObject);
    procedure actGoodsExecute(Sender: TObject);
    procedure actTypeExecute(Sender: TObject);
    procedure actImportExecute(Sender: TObject);
    procedure actExportExecute(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure actComExecute(Sender: TObject);
    procedure actRestoreExecute(Sender: TObject);
    procedure actBackExecute(Sender: TObject);
    procedure tmrMainTimer(Sender: TObject);
    procedure actReloginExecute(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
    procedure LoadPlugin;
    procedure InitData;
    
  public
    { Public declarations }
  end;

var
  MainForm: TMainForm;

implementation

{$R *.dfm}

uses  uChgpwd, uAdmin, uAbout, uLogInfo, uGoods, uType, uImport, uExport,
  uDM, uGlobal, uLogin;

type
  TDataProc = procedure (hPar: THandle; acPer: TADOConnection); stdcall;
var
  lHandle: THandle;
  BackupData, ComRepData, RestoreData: TDataProc;
procedure TMainForm.InitData;
var
  iFile: TIniFile;
begin
  MyApp.Image := imgMain;
  iFile := TIniFile.Create(MyApp.Path + 'goodsset.ini');
  try
    MyApp.Topic := iFile.ReadString('sTopic', 'topic', AppCaption);
    MyApp.ImgStr := iFile.ReadString('sysbg', 'bground', 'main.jpg');
  finally
    iFile.Free;
  end;
  if MyApp.Topic = '' then MyApp.Topic := AppCaption;
  if (MyApp.ImgStr = '') or not FileExists(MyApp.Path + MyApp.ImgStr) then MyApp.ImgStr := 'main.jpg';
  Caption := MyApp.Topic;

  sbPer.Panels[0].Text := MyApp.Topic;
  Application.ShowHint := True;
  Application.HintColor := clLime;
 
end;

procedure TMainForm.LoadPlugin;
begin
  if lHandle = 0 then Exit;
  @BackupData := GetProcAddress(lHandle, PAnsiChar('BackupData'));
  @ComRepData := GetProcAddress(lHandle, PAnsiChar('ComRepData'));
  @RestoreData := GetProcAddress(lHandle, PAnsiChar('RestoreData'));
end;
procedure TMainForm.actChapwdExecute(Sender: TObject);
begin
  try
    frmChgpwd :=TfrmChgpwd.Create(nil);
    frmChgpwd.ShowModal;
  finally
    frmChgpwd.Free;
  end;
end;

procedure TMainForm.actAdminExecute(Sender: TObject);
begin
  try
    frmAdmin :=TfrmAdmin.Create(nil);
    frmAdmin.ShowModal;
  finally
    frmAdmin.Free;
  end;
end;

procedure TMainForm.actExitExecute(Sender: TObject);
begin
  Close;
end;

procedure TMainForm.actLogExecute(Sender: TObject);
begin
  try
    frmLog :=TfrmLog.Create(nil);
    frmLog.ShowModal;
  finally
    frmLog.Free;
  end;
end;

procedure TMainForm.actAboutExecute(Sender: TObject);
begin
   try
    frmAbout :=TfrmAbout.Create(nil);
    frmAbout.ShowModal;
  finally
    frmAbout.Free;
  end;
end;

procedure TMainForm.actGoodsExecute(Sender: TObject);
begin
   if not Assigned(frmGoods) then
    frmGoods := TfrmGoods.Create(Application)
  else if IsIconic(frmGoods.Handle) then
    frmGoods.WindowState := wsNormal;
end;

procedure TMainForm.actTypeExecute(Sender: TObject);
begin
  try
    frmType :=TfrmType.Create(nil);
    frmType.ShowModal;
  finally
    frmType.Free;
  end;
end;

procedure TMainForm.actImportExecute(Sender: TObject);
begin
   if not Assigned(frmImport) then
    frmImport := TfrmImport.Create(Application)
  else if IsIconic(frmGoods.Handle) then
    frmImport.WindowState := wsNormal;
end;

procedure TMainForm.actExportExecute(Sender: TObject);
begin
   if not Assigned(frmExport) then
    frmExport := TfrmExport.Create(Application)
  else if IsIconic(frmExport.Handle) then
    frmExport.WindowState := wsNormal;
end;

procedure TMainForm.FormCreate(Sender: TObject);
begin
   InitData;
   LoadPlugin;
end;

procedure TMainForm.actComExecute(Sender: TObject);
begin
  if @ComRepData <> nil then
  begin
    ComRepData(Handle, DM.adoCon);
  end;
end;

procedure TMainForm.actRestoreExecute(Sender: TObject);
begin
  
  if @RestoreData <> nil then
  begin
    RestoreData(Handle, DM.adoCon);
  end;
end;

procedure TMainForm.actBackExecute(Sender: TObject);
begin
  if @BackupData <> nil then BackupData(Handle, DM.adoCon);
end;

procedure TMainForm.tmrMainTimer(Sender: TObject);
begin
  tmrMain.Enabled := False;
  frmLogin := TfrmLogin.Create(Self);
  if frmLogin.ShowModal <> mrOk then Close;
  FreeAndNil(frmLogin);
  miLog.Visible := MyApp.Admin;
end;

procedure TMainForm.actReloginExecute(Sender: TObject);
begin
  tmrMainTimer(Sender);
end;

procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  close;
end;

initialization
  lHandle := LoadLibrary('data.dll');
finalization
  FreeLibrary(lHandle);

end.

⌨️ 快捷键说明

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