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

📄 main.pas

📁 房产售楼CRM系统是以房地产销售业务为主线
💻 PAS
📖 第 1 页 / 共 2 页
字号:
      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 + -