📄 main.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 + -