📄 unit5.pas
字号:
unit Unit5;
interface
uses
IniFiles,Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, ImgList , Buttons, jpeg, XPMenu,implemntation,DB, ADODB,
ComCtrls,SHELLAPI, Menus;
type
TForm5 = class(TForm)
MainMenu1: TMainMenu;
N1: TMenuItem;
N4: TMenuItem;
N5: TMenuItem;
N6: TMenuItem;
N7: TMenuItem;
N8: TMenuItem;
ImageList1: TImageList;
Image1: TImage;
N9: TMenuItem;
N10: TMenuItem;
XPMenu1: TXPMenu;
F1: TMenuItem;
N11: TMenuItem;
N12: TMenuItem;
Timer1: TTimer;
D1: TMenuItem;
N13: TMenuItem;
N2: TMenuItem;
N3: TMenuItem;
H1: TMenuItem;
N14: TMenuItem;
B1: TMenuItem;
R1: TMenuItem;
N15: TMenuItem;
N16: TMenuItem;
StatusBar1: TStatusBar;
T1: TMenuItem;
N17: TMenuItem;
W1: TMenuItem;
N18: TMenuItem;
H2: TMenuItem;
N21: TMenuItem;
N22: TMenuItem;
N19: TMenuItem;
U1: TMenuItem;
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure N13Click(Sender: TObject);
procedure N6Click(Sender: TObject);
procedure N7Click(Sender: TObject);
procedure N4Click(Sender: TObject);
procedure N10Click(Sender: TObject);
procedure F1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure N12Click(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure N2Click(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure B1Click(Sender: TObject);
procedure R1Click(Sender: TObject);
procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure H1Click(Sender: TObject);
procedure N17Click(Sender: TObject);
procedure N18Click(Sender: TObject);
procedure N21Click(Sender: TObject);
procedure N22Click(Sender: TObject);
procedure N19Click(Sender: TObject);
procedure U1Click(Sender: TObject);
procedure N16Click(Sender: TObject);
procedure N3Click(Sender: TObject);
procedure FormResize(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form5: TForm5;
int_config:Tinifile;
implementation
uses Unit1, Unit4, Unit3, Unit6, about, Unit2, Unit7, Unit8, Unit9, Unit10,
Unit11, Manage_Users;
{$R *.dfm}
function Login_Msg(Prompt: string='您没有足够的权限,请先登录系统!';Caption: string = '登录提示';Flag: LongInt = MB_OK +MB_ICONINFORMATION): integer;
begin
Result := Application.MessageBox(PChar(Prompt), PChar(Caption), Flag);
end;
procedure OpenForm(FormClass: TFormClass; var fm; AOwner:TComponent);
//用于创建MDI子窗口的过程
var
i: integer;
Child:TForm;
begin
for i := 0 to Screen.FormCount -1 do
if Screen.Forms[i].ClassType=FormClass then
begin
Child:=Screen.Forms[i];
if Child.WindowState=wsMinimized then
ShowWindow(Child.handle,SW_SHOWNORMAL)
else
ShowWindow(Child.handle,SW_SHOWNA);
if (not Child.Visible) then Child.Visible:=True;
Child.BringToFront;
Child.Setfocus;
TForm(fm):=Child;
exit;
end;
Child:=TForm(FormClass.NewInstance);
TForm(fm):=Child;
Child.Create(AOwner);
end;
procedure TForm5.FormClose(Sender: TObject; var Action: TCloseAction);
var
filevar: textfile;//用于生成启动日志
buf:string;
begin
if start_log then begin
buf:=DateTimeToStr(date())+'--'+timetostr(time())+'----------Shutdown;';
assignfile(filevar,'log.txt');
append(filevar);
writeln(filevar,buf);
closefile(filevar);
end;
if application.MessageBox('确认要退出程序吗?','退出确认',mb_yesno)= mrYes then begin
Action := caFree;
application.Terminate; end
else
Action := caNone;
end;
procedure TForm5.N13Click(Sender: TObject);
begin
if (login_user<>'admin') and (login_user<>'read') and (login_user<>'do_not_login') then begin Login_Msg(); N12Click(sender); end else begin
OpenForm(tform4,form4,self);
end;
end;
procedure TForm5.N6Click(Sender: TObject);
begin
if (login_user<>'admin') and (login_user<>'read') and (login_user<>'do_not_login') then begin Login_Msg(); N12Click(sender); end else begin
OpenForm(tform3,form3,self);
end;
end;
procedure TForm5.N7Click(Sender: TObject);
begin
if (login_user<>'admin') and (login_user<>'read') and (login_user<>'do_not_login') then begin Login_Msg(); N12Click(sender); end else begin
OpenForm(tform1,form1,self);
end;
end;
procedure TForm5.N4Click(Sender: TObject);
begin
close;
end;
procedure TForm5.N10Click(Sender: TObject);
begin
frm_about:=tfrm_about.create(application);
frm_about.ShowModal;
end;
procedure TForm5.F1Click(Sender: TObject);
begin
login_user:='None';
form2.ShowModal;
end;
procedure TForm5.FormCreate(Sender: TObject);
var
filevar: textfile;//用于生成启动日志
buf:string;
begin
if start_log then begin
buf:=DateTimeToStr(date())+'--'+timetostr(time())+'----------Starting;';
assignfile(filevar,'log.txt');
append(filevar);
writeln(filevar,buf);
closefile(filevar);
end;
Application.Title:=Product_Name;
self.Caption:=Product_Name; //程序标题名称
self.height:=peg_height;
self.Width:=peg_width;
//self.Height:=Screen.Height; //设置全屏显示
//self.Width:=Screen.Width;
self.Update;
self.Position:= poScreenCenter;
end;
procedure TForm5.N12Click(Sender: TObject);
begin
application.CreateForm(Tform2, form2);
form2.ShowModal;
end;
procedure TForm5.Timer1Timer(Sender: TObject);
var i,n:integer;
ks: tkeyboardstate;
year,month,day:word;now2:TDateTime;
begin
if (login_user<>'admin') and (login_user<>'read') and (login_user<>'do_not_login') then f1.Enabled:=false else f1.Enabled:=true; //注销菜单状态
if login_user='do_not_login' then n12.Enabled:=false else n12.Enabled:=true; //如果系统不需要登录则禁止登录命令
//当注销管理后关闭所有子窗体
if (login_user<>'admin') and (login_user<>'read') and (login_user<>'do_not_login') then begin
if self.MDIChildCount>0 then begin
n:=self.MDIChildCount;
for i:=0 to n do self.MDIChildren[0].free;
end;
end;
//控制状态栏的显示
if state_bar then statusbar1.Visible:=true
else if (login_user<>'admin') and (login_user<>'read') and (login_user<>'do_not_login') then statusbar1.Visible:=false
else begin
if self.MDIChildCount=0 then statusbar1.Visible:=false
else
statusbar1.Visible:=true;
end;
getkeyboardstate(ks); //检测键盘状态显示在状态栏函数
statusbar1.panels.items[0].text := '状态: '+state;
if (login_user<>'admin') and (login_user<>'read') and (login_user<>'do_not_login') then statusbar1.panels.items[1].text := '用户: 未登录' else statusbar1.panels.items[1].text :='用户: '+login_user_name;
if odd(ks[VK_NUMLOCK]) then statusbar1.panels.items[6].text := 'NUM' else statusbar1.panels.items[6].text := '';
if odd(ks[VK_INSERT]) then statusbar1.panels.items[5].text := '编辑状态: 插入' else statusbar1.panels.items[5].text := '编辑状态: 改写';
if odd(ks[VK_CAPITAL]) then statusbar1.panels.items[4].text := '大小写: 大写' else statusbar1.panels.items[4].text := '大小写: 小写';
now2:=date(); decodedate(now2,year,month,day);
STATUSBAR1.Panels.Items[7].TEXT:=inttostr(year)+'年'+inttostr(month)+'月'+inttostr(day)+'日 '+ TIMEtostr(time());
if now_num<>'' then statusbar1.panels.items[2].text :='第 '+now_num+' 条记录' else statusbar1.panels.items[2].text :='';
if all_num<>'' then statusbar1.panels.items[3].text :='总共 '+all_num+' 条记录' else statusbar1.panels.items[3].text :='';
end;
procedure TForm5.N2Click(Sender: TObject);
begin
if (login_user<>'admin') and (login_user<>'read') and (login_user<>'do_not_login') then begin Login_Msg(); N12Click(sender); end else begin
OpenForm(tform8,form8,self);
form8.Hide;
form8.QuickRep1.Preview;
end;
end;
procedure TForm5.FormActivate(Sender: TObject);
begin
state:='欢迎使用 '+Product_Name;
Product_Dir:=ExtractFilePath(ParamStr(0)); //把当前程序的绝对路径放进全局变量中
end;
procedure TForm5.B1Click(Sender: TObject);
begin
if (login_user<>'admin') and (login_user<>'read') and (login_user<>'do_not_login') then begin Login_Msg(); N12Click(sender); end else begin
BakupDataBase:=tBakupDataBase.create(application);
BakupDataBase.Showmodal;
end;
end;
procedure TForm5.R1Click(Sender: TObject);
begin
if (login_user<>'admin') and (login_user<>'read') and (login_user<>'do_not_login') then begin Login_Msg(); N12Click(sender); end else begin
RestoreDataBase:=tRestoreDataBase.create(application);
RestoreDataBase.Showmodal;
end;
end;
procedure TForm5.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
state:='欢迎使用 '+Product_Name;
end;
procedure TForm5.H1Click(Sender: TObject);
begin
ShellExecute(handle,'open',pchar(Home_Url),'','',SW_SHOWNORMAL);
end;
procedure TForm5.N17Click(Sender: TObject);
begin
login_user:='';
application.CreateForm(Tform2, form2);
form2.ShowModal;
if login_user='admin' then
begin
Application.CreateForm(TOpertion, Opertion);
Opertion.ShowModal;
end else showmessage('你的权限不够,不能使用本功能!');
end;
procedure TForm5.N18Click(Sender: TObject);
begin
cascade;
end;
procedure TForm5.N21Click(Sender: TObject);
begin
tilemode:=tbHorizontal;
tile;
end;
procedure TForm5.N22Click(Sender: TObject);
begin
TileMode:=tbVertical;
tile;
end;
procedure TForm5.N19Click(Sender: TObject);
var i:integer;
begin
if self.MDIChildCount>0 then begin
for i:=0 to self.MDIChildCount do self.MDIChildren[0].free;
end;
end;
procedure TForm5.U1Click(Sender: TObject);
begin
login_user:='';
application.CreateForm(Tform2, form2);
form2.ShowModal;
if login_user<>'' then
begin
Application.CreateForm(Tform12, form12);
form12.ShowModal;
end;
end;
procedure TForm5.N16Click(Sender: TObject);
begin
if (login_user<>'admin') and (login_user<>'read') and (login_user<>'do_not_login') then begin Login_Msg(); N12Click(sender); end else begin
showmessage('此功能模块开发未完成!');
end;
end;
procedure TForm5.N3Click(Sender: TObject);
begin
if (login_user<>'admin') and (login_user<>'read') and (login_user<>'do_not_login') then begin Login_Msg(); N12Click(sender); end else begin
showmessage('此功能模块开发未完成!');
end;
end;
procedure TForm5.FormResize(Sender: TObject);
begin
if FileExists(Product_Dir+'config.ini') then begin
ini_config:=Tinifile.create(Product_Dir+'config.ini');
data_path:=ini_config.readstring('initialization','data_path',data_path);
login_user:=ini_config.readstring('initialization','login_user','None');
state_bar:=ini_config.readbool('initialization','state_bar',state_bar);
start_log:=ini_config.readbool('initialization','start_log',start_log);
bakup_num:=strtoint(ini_config.readstring('backup','bakup_num',inttostr(bakup_num)));
start_bakup:=ini_config.readbool('backup','start_bakup',start_bakup);
bakup_dir:=ini_config.readstring('backup','Bakup_Dir',bakup_dir);
Bg_Sound:=ini_config.readstring('initialization','bg_sound',bg_sound);
peg_height:=strtoint(ini_config.readstring('initialization','peg_height',inttostr(peg_height)));
peg_width:=strtoint(ini_config.readstring('initialization','peg_width',inttostr(peg_width)));
ini_config.Free; //释放
end;
end;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -