📄 main.pas
字号:
if not OutLookBtn7.Visible then
begin
OutLookBtn7.Visible:=True;
OutLookBtn7.Caption:=s1;
OutLookBtn7.Hint:='创建人:'+Creator+' 创建日期:'+Create_d+'登录代码:'+Name;
end
else
if not OutLookBtn8.Visible then
begin
OutLookBtn8.Visible:=True;
OutLookBtn8.Caption:=s1;
OutLookBtn8.Hint:='创建人:'+Creator+' 创建日期:'+Create_d+'登录代码:'+Name;
end
else
if not OutLookBtn9.Visible then
begin
OutLookBtn9.Visible:=True;
OutLookBtn9.Caption:=s1;
OutLookBtn9.Hint:='创建人:'+Creator+' 创建日期:'+Create_d+'登录代码:'+Name;
end
else
if not OutLookBtn10.Visible then
begin
OutLookBtn10.Visible:=True;
OutLookBtn10.Caption:=s1;
OutLookBtn10.Hint:='创建人:'+Creator+' 创建日期:'+Create_d+'登录代码:'+Name;
end
else ShowMessage('请作者帮助建立项目数!');
// DM.sys_operatorsDAO.Connected:=False;
DM.sys_operators.close;
until (FindNext(SearchRec) <> 0);
end;
end;
procedure TMainForm.SetDirectory(Dir:string);
Var
SearchRec:TSearchRec;
begin
if FindFirst(Dir,faDirectory,SearchRec)<>0 then
MKDir(ExtractFilePath(Application.Exename)+Dir);
end;
procedure TMainForm.SetOutLookCaption;
Var
sr:TSearchRec;
l:Integer;
Attr:Integer;
ls:array [0..100] of char;
begin
DataFileName:=ExtractFilePath(paramstr(0))+'\Data\*.jsh';
Attr:=faAnyFile;
if FindFirst(DataFileName,Attr,sr)<>0 then
// begin
// MessageBox(Application.Handle,PChar('在Data目录下没有*.jsh文件!'),Pchar('错误提示'),mb_OK or MB_ICONERROR);
exit;
// end
// else
begin
StrLCopy(ls,Pchar(ExtractFileName(sr.Name)),length(ExtractFileName(sr.Name))-length(ExtractFileExt(sr.Name)));
l:=1;
OutLookBtn1.Caption:=string(ls);
while FindNext(sr) = 0 do
begin
l:=l+1;
case l of
2:
OutLookBtn2.Caption:=string(ls);
3:
OutLookBtn3.Caption:=string(ls);
4:
OutLookBtn4.Caption:=string(ls);
5:
OutLookBtn5.Caption:=string(ls);
6:
OutLookBtn6.Caption:=string(ls);
7:
OutLookBtn7.Caption:=string(ls);
8:
OutLookBtn8.Caption:=string(ls);
9:
OutLookBtn9.Caption:=string(ls);
10:
OutLookBtn10.Caption:=string(ls);
end;
end;
end;
end;
procedure TMainForm.SetOutLookBtnPos(OutLook:TOutLookBtn;PosMark,x,y:Integer);
var T,L:Integer;
begin
T:=0;
L:=0;
with OutLook do
begin
case PosMark of
0:begin//左上
T:=y;
L:=x;
end;
1:begin//左下
T:=Screen.Height-Height-y;
L:=x;
end;
2:begin//右上
T:=y;
L:=Screen.Width-Width-x;
end;
3:begin//右下
T:=Screen.Height-Height-y;
L:=Screen.Width-Width-x;
end;
end;
Top:=T;
Left:=L;
end;
end;
procedure TMainForm.SetTBtnPos(TBtn:TTransparentButton;PosMark,x,y:Integer);
var T,L:Integer;
begin
T:=0;
L:=0;
with TBtn do
begin
case PosMark of
0:begin//左上
T:=y;
L:=x;
end;
1:begin//左下
T:=Screen.Height-Height-y;
L:=x;
end;
2:begin//右上
T:=y;
L:=Screen.Width-Width-x;
end;
3:begin//右下
T:=Screen.Height-Height-y;
L:=Screen.Width-Width-x;
end;
end;
Top:=T;
Left:=L;
end;
end;
procedure TMainForm.FormCreate(Sender: TObject);
begin
Datafilename:=ExtractFilePath(paramstr(0))+'jkdata.jsh';
if not fileExists(Datafilename) then
begin
MessageBox(Application.Handle,PChar('在当前目录下没有jkdata.jsh文件!'),Pchar('错误提示'),mb_OK or MB_ICONERROR);
exit;
end;
try
mainform.Refresh;
DM.ADOC.Connected:=False;
DM.ADOC.ConnectionString :='Provider=Microsoft.Jet.OLEDB.4.0;Data Source='+
Datafilename+'; Persist Security Info=False';
DM.ADOC.LoginPrompt :=false;
DM.ADOC.Connected:=true;
except
MessageBox(Application.Handle,PChar('不能正常连接数据文件。请重新选择打开文件!'),Pchar('错误提示'),mb_OK or MB_ICONERROR);
exit;
end;
OpenAllK;
// HideTaskBar;
SetOutLookBtnPos(ExitOutLookBtn,3,20,20);
SetOutLookBtnPos(InfoOutLookBtn,2,23,50);
SetOutLookBtnPos(CreateProjectOutLookBtn,0,30,100);
SetDirectory('Data');
GetOutLookBtnVisible(Sender);
SetOutLookBtnPos(OutLookBtn1,1,20,20);
SetOutLookBtnPos(OutLookBtn6,1,20,20+97);
SetOutLookBtnPos(OutLookBtn2,1,20+81,20);
SetOutLookBtnPos(OutLookBtn7,1,20+81,20+97);
SetOutLookBtnPos(OutLookBtn3,1,20+81+81,20);
SetOutLookBtnPos(OutLookBtn8,1,20+81+81,20+97);
SetOutLookBtnPos(OutLookBtn4,1,20+81+81+81,20);
SetOutLookBtnPos(OutLookBtn9,1,20+81+81+81,20+97);
SetOutLookBtnPos(OutLookBtn5,1,20+81+81+81+81,20);
SetOutLookBtnPos(OutLookBtn10,1,20+81+81+81+81,20+97);
SetOutLookCaption;
end;
procedure TMainForm.ExitOutlookBtnClick(Sender: TObject);
begin
Close;
end;
procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
ShowTaskBar;
end;
Function TMainForm.ProjectName(Pn:TOutLookBtn;PnStr:String):Boolean;
begin
Result:=False;
if Success=True then
begin
if Pn.Visible=False then
begin
Pn.Caption:=PnStr;
Pn.Visible:=True;
Result:=True;
end;
end;
end;
procedure TMainForm.CreateProjectOutlookBtnClick(Sender: TObject);
begin
with TCreateProjectForm.Create(Self) do
Try
ShowModal;
Finally
Free;
end;
if ProjectName(OutLookBtn1,CreateProjectName) then exit
else if ProjectName(OutLookBtn2,CreateProjectName) then exit
else if ProjectName(OutLookBtn3,CreateProjectName) then exit
else ShowMessage('您使用的是[非注册版]!请向作者注册!');
{ else if ProjectName(OutLookBtn4,CreateProjectName) then exit
else if ProjectName(OutLookBtn5,CreateProjectName) then exit
else if ProjectName(OutLookBtn6,CreateProjectName) then exit
else if ProjectName(OutLookBtn7,CreateProjectName) then exit
else if ProjectName(OutLookBtn8,CreateProjectName) then exit
else if ProjectName(OutLookBtn9,CreateProjectName) then exit
else if ProjectName(OutLookBtn10,CreateProjectName) then exit
else ShowMessage('请作者帮助建立[新项目]!');}
end;
procedure TMainForm.OriCall(DBFullName:string;ExecPN:String);
//DBFullName:要打开的数据库全名(路径+库名)
//ExecPN:要进入的项目名字
begin
{ if not RegistryVersion then
begin
ShowMessage('使用期限已过,请向作者注册!');
exit;
end;}
with TPasswordForm.Create(Self) do
Try
ShowModal;
Finally
Free;
end;
if Success then
begin
AllDBFullName:=DBFullName;
AllExecPN:=ExecPN;
with TCallProgramForm.Create(Self) do
Try
ShowModal;
Finally
Free;
end;
end;
end;
procedure TMainForm.OutlookBtn1Click(Sender: TObject);
begin
DataBaseName:=ExtractFilePath(Application.Exename)+'Data\'+OutLookBtn1.Caption+'.jsh';
ExecProjectName:=OutLookBtn1.Caption;
OriCall(DataBaseName,ExecProjectName);
end;
procedure TMainForm.OutlookBtn2Click(Sender: TObject);
begin
DataBaseName:=ExtractFilePath(Application.Exename)+'Data\'+OutLookBtn2.Caption+'.jsh';
ExecProjectName:=OutLookBtn2.Caption;
OriCall(DataBaseName,ExecProjectName);
end;
procedure TMainForm.OutlookBtn3Click(Sender: TObject);
begin
DataBaseName:=ExtractFilePath(Application.Exename)+'Data\'+OutLookBtn3.Caption+'.jsh';
ExecProjectName:=OutLookBtn3.Caption;
OriCall(DataBaseName,ExecProjectName);
end;
procedure TMainForm.OutlookBtn4Click(Sender: TObject);
begin
DataBaseName:=ExtractFilePath(Application.Exename)+'Data\'+OutLookBtn4.Caption+'.jsh';
ExecProjectName:=OutLookBtn4.Caption;
OriCall(DataBaseName,ExecProjectName);
end;
procedure TMainForm.OutlookBtn5Click(Sender: TObject);
begin
DataBaseName:=ExtractFilePath(Application.Exename)+'Data\'+OutLookBtn5.Caption+'.jsh';
ExecProjectName:=OutLookBtn5.Caption;
OriCall(DataBaseName,ExecProjectName);
end;
procedure TMainForm.OutlookBtn6Click(Sender: TObject);
begin
DataBaseName:=ExtractFilePath(Application.Exename)+'Data\'+OutLookBtn6.Caption+'.jsh';
ExecProjectName:=OutLookBtn6.Caption;
OriCall(DataBaseName,ExecProjectName);
end;
procedure TMainForm.OutlookBtn7Click(Sender: TObject);
begin
DataBaseName:=ExtractFilePath(Application.Exename)+'Data\'+OutLookBtn7.Caption+'.jsh';
ExecProjectName:=OutLookBtn7.Caption;
OriCall(DataBaseName,ExecProjectName);
end;
procedure TMainForm.OutlookBtn8Click(Sender: TObject);
begin
DataBaseName:=ExtractFilePath(Application.Exename)+'Data\'+OutLookBtn8.Caption+'.jsh';
ExecProjectName:=OutLookBtn8.Caption;
OriCall(DataBaseName,ExecProjectName);
end;
procedure TMainForm.OutlookBtn9Click(Sender: TObject);
begin
DataBaseName:=ExtractFilePath(Application.Exename)+'Data\'+OutLookBtn9.Caption+'.jsh';
ExecProjectName:=OutLookBtn9.Caption;
OriCall(DataBaseName,ExecProjectName);
end;
procedure TMainForm.OutlookBtn10Click(Sender: TObject);
begin
DataBaseName:=ExtractFilePath(Application.Exename)+'Data\'+OutLookBtn10.Caption+'.jsh';
ExecProjectName:=OutLookBtn10.Caption;
OriCall(DataBaseName,ExecProjectName);
end;
procedure TMainForm.InfoOutlookBtnClick(Sender: TObject);
begin
with TAboutForm.Create(Self) do
Try
ShowModal;
Finally
Free;
end;
end;
function TMainForm.deleteOutLookBtn(DBFullName:string;ExecPN:String):Boolean;
//DBFullName:要打开的数据库全名(路径+库名)
//ExecPN:要进入的项目名字
begin
with TPasswordForm.Create(Self) do
Try
ShowModal;
Finally
Free;
end;
AllDBFullName:=DBFullName;
AllExecPN:=ExecPN;
if Success then
begin
if MessageDlg('删除项目后数据将丢失,放弃吗?',mtWarning, [mbYes,mbNo], 0) = mrYes then
begin
Result:=False;
with TCallProgramForm.Create(Self) do
Try
ShowModal;
Finally
Free;
end;
end
else
begin
if FileExists(AllDBFullName) then
if MessageDlg('删除 ' + ExtractFileName(AllDBFullName)
+ '吗 ?', mtWarning, [mbYes,mbNo], 0) = mrYes then
begin
DeleteFile(AllDBFullName);
Result:=True;
end
else Result:=False;
end;
end;
end;
procedure TMainForm.deleteN1Click(Sender: TObject);
begin
DataBaseName:=ExtractFilePath(Application.Exename)+'Data\'+OutLookBtn1.Caption+'.jsh';
ExecProjectName:=OutLookBtn1.Caption;
if deleteOutLookbtn(DataBaseName,ExecProjectName) then OutLookBtn1.Visible :=false;
end;
procedure TMainForm.deleteN2Click(Sender: TObject);
begin
DataBaseName:=ExtractFilePath(Application.Exename)+'Data\'+OutLookBtn2.Caption+'.jsh';
ExecProjectName:=OutLookBtn2.Caption;
if deleteOutLookbtn(DataBaseName,ExecProjectName) then OutLookBtn2.Visible :=false;
end;
procedure TMainForm.deleteN3Click(Sender: TObject);
begin
DataBaseName:=ExtractFilePath(Application.Exename)+'Data\'+OutLookBtn3.Caption+'.jsh';
ExecProjectName:=OutLookBtn3.Caption;
if deleteOutLookbtn(DataBaseName,ExecProjectName) then OutLookBtn3.Visible :=false;
end;
procedure TMainForm.deleteN4Click(Sender: TObject);
begin
DataBaseName:=ExtractFilePath(Application.Exename)+'Data\'+OutLookBtn4.Caption+'.jsh';
ExecProjectName:=OutLookBtn4.Caption;
if deleteOutLookbtn(DataBaseName,ExecProjectName) then OutLookBtn4.Visible :=false;
end;
procedure TMainForm.deleteN5Click(Sender: TObject);
begin
DataBaseName:=ExtractFilePath(Application.Exename)+'Data\'+OutLookBtn5.Caption+'.jsh';
ExecProjectName:=OutLookBtn5.Caption;
if deleteOutLookbtn(DataBaseName,ExecProjectName) then OutLookBtn5.Visible :=false;
end;
procedure TMainForm.deleteN6Click(Sender: TObject);
begin
DataBaseName:=ExtractFilePath(Application.Exename)+'Data\'+OutLookBtn6.Caption+'.jsh';
ExecProjectName:=OutLookBtn6.Caption;
if deleteOutLookbtn(DataBaseName,ExecProjectName) then OutLookBtn6.Visible :=false;
end;
procedure TMainForm.deleteN7Click(Sender: TObject);
begin
DataBaseName:=ExtractFilePath(Application.Exename)+'Data\'+OutLookBtn7.Caption+'.jsh';
ExecProjectName:=OutLookBtn7.Caption;
if deleteOutLookbtn(DataBaseName,ExecProjectName) then OutLookBtn7.Visible :=false;
end;
procedure TMainForm.deleteN8Click(Sender: TObject);
begin
DataBaseName:=ExtractFilePath(Application.Exename)+'Data\'+OutLookBtn8.Caption+'.jsh';
ExecProjectName:=OutLookBtn8.Caption;
if deleteOutLookbtn(DataBaseName,ExecProjectName) then OutLookBtn8.Visible :=false;
end;
procedure TMainForm.deleteN9Click(Sender: TObject);
begin
DataBaseName:=ExtractFilePath(Application.Exename)+'Data\'+OutLookBtn9.Caption+'.jsh';
ExecProjectName:=OutLookBtn9.Caption;
if deleteOutLookbtn(DataBaseName,ExecProjectName) then OutLookBtn9.Visible :=false;
end;
procedure TMainForm.deleteN10Click(Sender: TObject);
begin
DataBaseName:=ExtractFilePath(Application.Exename)+'Data\'+OutLookBtn10.Caption+'.jsh';
ExecProjectName:=OutLookBtn10.Caption;
if deleteOutLookbtn(DataBaseName,ExecProjectName) then OutLookBtn10.Visible :=false;
end;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -