?? main.pas
字號:
unit MAIN;
interface
uses Windows, SysUtils, Classes, Graphics, Forms, Controls, Menus,
StdCtrls, Dialogs, Buttons, Messages, ExtCtrls, ComCtrls, StdActns,
ActnList, ToolWin, ImgList;
type
TMainForm = class(TForm)
MainMenu1: TMainMenu;
File1: TMenuItem;
FileNewItem: TMenuItem;
FileCloseItem: TMenuItem;
Help1: TMenuItem;
N1: TMenuItem;
FileExitItem: TMenuItem;
HelpAboutItem: TMenuItem;
OpenDialog: TOpenDialog;
FileSaveItem: TMenuItem;
FileSaveAsItem: TMenuItem;
Edit1: TMenuItem;
CutItem: TMenuItem;
CopyItem: TMenuItem;
StatusBar: TStatusBar;
ActionList1: TActionList;
ToolBar2: TToolBar;
ImageList1: TImageList;
OpenInput: TAction;
ToolButton1: TToolButton;
ToolButton2: TToolButton;
ToolButton3: TToolButton;
EditCodeServ: TAction;
ToolButton4: TToolButton;
OpenGroupView: TAction;
OpenAbout: TAction;
OpenCentre: TAction;
OpenAreaList: TAction;
registe: TAction;
N2: TMenuItem;
Login: TAction;
OpenSetRight: TAction;
E1: TMenuItem;
N3: TMenuItem;
OpenChangePass: TAction;
N4: TMenuItem;
OpenReport: TAction;
procedure FileExit1Execute(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure OpenInputExecute(Sender: TObject);
procedure EditCodeServExecute(Sender: TObject);
procedure OpenAboutExecute(Sender: TObject);
procedure OpenGroupViewExecute(Sender: TObject);
procedure OpenCentreExecute(Sender: TObject);
procedure OpenAreaListExecute(Sender: TObject);
procedure registeExecute(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure LoginExecute(Sender: TObject);
procedure OpenSetRightExecute(Sender: TObject);
procedure OpenChangePassExecute(Sender: TObject);
procedure OpenReportExecute(Sender: TObject);
private
license_key: string;
switchkey: string;
function OpenForm2(FormClass: TFormClass; aCaption: string; formwidth, formheight: Integer): TForm;
function get_switchkey(keystr: string): string;
procedure restoresettings;
procedure savesettings;
procedure setsysright(const bitcode: string);
procedure setuserright(const oper: string);
public
end;
var
MainForm: TMainForm;
implementation
{$R *.dfm}
uses fmdatainput, about, insert, table, selectcompany, datepass, arealist
, inifiles, CheckSerial, datamodule, licenseinput, Login, setright
,changepass,fmreports;
procedure TMainForm.FileExit1Execute(Sender: TObject);
begin
Close;
end;
function TMainForm.get_switchkey(keystr: string): string;
begin
with TCheckSerial.Create(nil) do try
Result := get_bitcode_bysn(keystr);
finally
Free;
end;
end;
procedure TMainForm.FormCreate(Sender: TObject);
begin
DM.install_dir := ExtractFilePath(application.ExeName);
//檢查序列號
restoresettings;
if license_key = '' then
registe.Execute;
Login.Execute;
end;
procedure TMainForm.restoresettings;
begin
with TInifile.Create(DM.install_dir + 'config.ini') do try
license_key := ReadString('license', 'key', '');
finally
Free;
end;
end;
procedure TMainForm.savesettings;
begin
with TInifile.Create(DM.install_dir + 'config.ini') do try
WriteString('license', 'key', license_key);
finally
Free;
end;
end;
function TMainForm.OpenForm2(FormClass: TFormClass; aCaption: string; formwidth, formheight: Integer): TForm;
var i: Integer;
begin
for i := 0 to screen.FormCount - 1 do
if screen.Forms[i] is FormClass then begin
screen.Forms[i].show;
exit;
end;
with FormClass.Create(self) do begin
if aCaption <> '' then
Caption := aCaption;
if formwidth > 0 then
width := formwidth;
if formheight > 0 then
height := formheight;
show;
end
end;
procedure TMainForm.setsysright(const bitcode: string);
var i, j: Integer;
begin
j := 1;
for i := 0 to ActionList1.ActionCount - 1 do
if ActionList1.Actions[i].Category = 'Window' then begin
if j > Length(bitcode) then
TAction(ActionList1.Actions[i]).Enabled := false
else
if bitcode[j] = '1' then
TAction(ActionList1.Actions[i]).Enabled := true
else
TAction(ActionList1.Actions[i]).Enabled := false;
inc(j);
end;
end;
procedure TMainForm.setuserright(const oper: string);
var
strs_tmp: TStringList;
i, j: Integer;
begin
strs_tmp := TStringList.Create;
try
strs_tmp.Text := DM.getrsstring(Format('select funcname from userright where username=''%s''', [oper]));
for i := 0 to ActionList1.ActionCount - 1 do
if (ActionList1.Actions[i].Category = 'Window')
and (TAction(ActionList1.Actions[i]).Enabled = true) then begin
if strs_tmp.IndexOf(ActionList1.Actions[i].Name) < 0 then
TAction(ActionList1.Actions[i]).Enabled := false;
end;
finally
strs_tmp.Free;
end;
end;
procedure TMainForm.OpenInputExecute(Sender: TObject);
begin
try
OpenForm2(Tinsertform, '數據錄入', 607, 487);
except
on E: Exception do ShowMessage(E.Message);
end;
end;
procedure TMainForm.EditCodeServExecute(Sender: TObject);
begin
try
OpenForm2(Tupdatetable, '編輯品牌對應表', 507, 300);
except
on E: Exception do ShowMessage(E.Message);
end;
end;
procedure TMainForm.OpenAboutExecute(Sender: TObject);
begin
try
OpenForm2(TFormAbout, '', 607, 487);
except
on E: Exception do ShowMessage(E.Message);
end;
end;
procedure TMainForm.OpenGroupViewExecute(Sender: TObject);
begin
try
OpenForm2(Tcompany, '查看已有集團名稱', 507, 300);
except
on E: Exception do ShowMessage(E.Message);
end;
end;
procedure TMainForm.OpenCentreExecute(Sender: TObject);
begin
try
OpenForm2(Tdatesee, '查看所有數據', 0, 0)
except
on E: Exception do ShowMessage(E.Message);
end;
end;
procedure TMainForm.OpenAreaListExecute(Sender: TObject);
begin
try
OpenForm2(TFormAreaList, '編輯區域數據', 300, 400);
except
on E: Exception do ShowMessage(E.Message);
end;
end;
procedure TMainForm.registeExecute(Sender: TObject);
begin
with TFormLicense.Create(nil) do try
Edit1.Text := license_key;
ShowModal;
license_key := Edit1.Text;
finally
Free;
end;
end;
procedure TMainForm.FormDestroy(Sender: TObject);
begin
savesettings;
end;
procedure TMainForm.LoginExecute(Sender: TObject);
begin
{with TFormLogin.Create(nil) do try
ShowModal;
DM.oper_code := trim(Edit1.Text);
if ModalResult <> mrOK then
application.Terminate;
switchkey := get_switchkey(license_key);
setsysright(switchkey); //設置系統權限
if DM.oper_code <> 'admin' then
setuserright(DM.oper_code); //設置用戶權限
finally
Free;
end; }
end;
procedure TMainForm.OpenSetRightExecute(Sender: TObject);
begin
try
OpenForm2(TFormSetRight, '', 400, 300);
except
on E: Exception do ShowMessage(E.Message);
end;
end;
procedure TMainForm.OpenChangePassExecute(Sender: TObject);
begin
try
OpenForm2(TFormChangePass, '', 300, 200);
except
on E: Exception do ShowMessage(E.Message);
end;
end;
procedure TMainForm.OpenReportExecute(Sender: TObject);
begin
try
OpenForm2(TFormReports, '', 520, 472);
except
on E: Exception do ShowMessage(E.Message);
end;
end;
end.
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -