uinfocard.pas

一个把具有名片功能的通讯录

        TmpNode := TV.Items.AddObject(nil,RootList[i],pstr);
        with InfoCardFrm.TAB1 do
        begin
          Filtered := False;
          Filter := 'ADType=' + '''' + RootList[I] + '''';
          Filtered := True;
          First;
          while not eof do
            begin
             TV.Items.AddChildObject(TmpNode, FieldValues['Name'], Pstr);
             Next;
            end;
        end;
    end;
  end else showmessage('打不开InfoCard表!');
  RootList.Free;
  TV.Items.EndUpdate;
end;
{================主窗口初始化=====================}
procedure TInfoCardFrm.FormCreate(Sender: TObject);
var
  TmpTAB:TTinyTable;
begin
  IsLogined := False;  //如果想屏蔽登录，可以将此处设为True;
  LoginPass := '';
  DBName := ExtractFilePath(Application.ExeName) + 'InfoCard.Tdb';
  if  not FileExists(DBName) then CreateDB(Sender)
  else
  begin
    TmpTAB:=TTinyTable.Create(Self);
    if OpenDBSysInfo(TmpTAB) then
      LoginPass := Trim(TmpTAB.FieldValues['Password']);
    TmpTAB.Free;
  end;
end;
{===================主窗口活动时====================}
procedure TInfoCardFrm.FormActivate(Sender: TObject);
begin
  if (not IsLogined) and (Length(LoginPass) <> 0) then
  begin
     Application.CreateForm(TLoginFrm, LoginFrm);
     LoginFrm.ShowModal;
     LoginFrm.Free;
  end;
  TVRefresh(TreeView1);
end;
{计时器，设置右下角状态栏时间}
procedure TInfoCardFrm.Timer1Timer(Sender: TObject);
begin
  StaTusBar1.Panels[1].Text:= '====KingLong Software Studio==== [' + FormatDateTime('yyyy-mm-dd hh:mm:ss', Now)+']   ';
end;
{======================增加记录=======================}
procedure TInfoCardFrm.RecAddNewClick(Sender: TObject);
begin
  if ShowInputFrm('增加名片通信录资料','') then TVRefresh(Treeview1);
{=========ShowInputFrm函数在uInput.Pas中声明==========}
end;

{======================修改记录=======================}
procedure TInfoCardFrm.RecModifyClick(Sender: TObject);
begin
  if Treeview1.Selected=nil then exit;
  if (TreeView1.Selected.Parent<>Nil) and
     ((length(Trim(Treeview1.Selected.Text))<>0)) then
     begin
       if  ShowInputFrm('名片通信录资料更新',TreeView1.Selected.Text)
       then TVRefresh(TreeView1)
       else LABSShow(TreeView1.Selected.Text);
     end;
end;
{======================删除记录=======================}
procedure TInfoCardFrm.RecDeleteClick(Sender: TObject);
begin
  if Treeview1.Selected = nil then Exit;
  if (TreeView1.Selected.Parent <> nil) and
     ((length(Trim(TreeView1.Selected.Text)) <> 0)) then
    begin
      TAB1.Filtered := False;
      TAB1.Locate('Name',Trim(TreeView1.Selected.Text), []);
      if MessageDlg('你确定要删除 [' + Trim(TreeView1.Selected.Text) + '] 的资料吗？',
         mtConfirmation, [mbYes,mbNo],0) = mrYes then
         begin
           TAB1.Delete;
           ClearRightContent;
           TVRefresh(Treeview1);
         end;
    end;
end;
{===================TreeView移动或点击姓名时浏览资料====================}
procedure TInfoCardFrm.TreeView1Change(Sender: TObject; Node: TTreeNode);
begin
  if Treeview1.Selected = nil then
    begin
      ClearRightContent;
      exit;
    end;
  if (TreeView1.Selected.Parent <> nil) and
     ((length(Trim(TreeView1.Selected.Text)) <> 0))
  then LABSShow(TreeView1.Selected.Text)
  else ClearRightContent;
end;
{==============TreeView双击姓名--修改记录================}
procedure TInfoCardFrm.TreeView1DblClick(Sender: TObject);
begin
  RecModifyClick(Sender);
end;
{===============TreeView右键菜单--增加================}
procedure TInfoCardFrm.POPAddNewClick(Sender: TObject);
begin
   RecAddNewClick(Sender);
end;
{===============TreeView右键菜单--修改================}
procedure TInfoCardFrm.POPModifyClick(Sender: TObject);
begin
  RecModifyClick(Sender);
end;
{===============TreeView右键菜单--删除================}
procedure TInfoCardFrm.PopDeleteClick(Sender: TObject);
begin
  RecDeleteClick(Sender);
end;
{===============TreeView右键菜单--刷新=================}
procedure TInfoCardFrm.PopRefreshClick(Sender: TObject);
begin
  TVRefresh(TreeView1);
end;
{======================退出系统=====================}
procedure TInfoCardFrm.QuitSysClick(Sender: TObject);
begin
  if Application.MessageBox('确定要关闭名片通讯录吗？', '友情提示', MB_OKCANCEL+MB_ICONQUESTION) <> IDOK then
    Exit
  else
    Close;
end;
{=====================查询记录========================}
procedure TInfoCardFrm.CmdSearchClick(Sender: TObject);
var
  Condition: string;
begin
   if Length(Trim(EditSearch.Text))=0 then exit;
   if RadioButton1.Checked then Condition:='Name';
   if RadioButton2.Checked then Condition:='Mobile';
   if RadioButton3.Checked then Condition:='Email';
   if RadioButton4.Checked then Condition:='QQ';
   TAB1.Filtered := False;
  if  TAB1.Locate(Condition,Trim(EditSearch.Text),[]) then
     LABSShow(TAB1.FieldValues['Name'])
  else begin
    ClearRightContent;
    Application.MessageBox('没找到符合条件的记录!', '信息提示', MB_OK+MB_ICONQUESTION);
  end;

end;
{====================拦截查询Edit中的Enter键-->查询======================}
procedure TInfoCardFrm.EditSearchKeyPress(Sender: TObject; var Key: Char);
begin
  if Key=#13 then CmdSearchClick(Sender);
end;
{===================双击查询Edit清空内容==================}
procedure TInfoCardFrm.EditSearchDblClick(Sender: TObject);
begin
  EditSearch.Text:='';
end;
{================保存通讯录数据库====================}
procedure TInfoCardFrm.DBBackupClick(Sender: TObject);
var
  InfoCardSaveDlg: TSaveDialog;
begin
  TAB1.Filtered := False;
  if TAB1.RecordCount <= 0 then
    begin
      Application.MessageBox('当前状态没有任何记录，无需保存!', '信息提示', MB_OK+MB_ICONQUESTION);
      Exit;
    end
  else
  begin
    TAB1.Close;
    TAB2.Close;
    InfoCardSaveDlg := TSaveDialog.Create(Self);
    InfoCardSaveDlg.InitialDir := ExtractFilePath(Application.ExeName);
    InfoCardSaveDlg.Title := '== 名片通讯录数据存档 ==';
    InfoCardSaveDlg.Filter := '名片通信录数据库(*.Dat)|*.Dat';
    InfoCardSaveDlg.DefaultExt := '.Dat';
    InfoCardSaveDlg.FileName := '数据存档[' + FormatDateTime('yyyymmdd',Now) +']';
    InfoCardSaveDlg.Options := InfoCardSaveDlg.Options + [ofOverwritePrompt];
    if InfoCardSaveDlg.Execute then
      CopyFile(Pchar(DBName), Pchar(InfoCardSaveDlg.FileName), False);
    InfoCardSaveDlg.Free;
    TVRefresh(TreeView1);
  end;
end;
{=================恢复通讯录数据库====================}
procedure TInfoCardFrm.DBRestoreClick(Sender: TObject);
var
  InfoCardOpenDlg: TOpenDialog;
begin
  if Application.MessageBox('恢复数据库会覆盖当前所有记录，'+#13+#13+
  '你确认要恢复存档数据吗?', '警告提示', MB_OKCANCEL+MB_ICONWARNING) = IDOK then
  begin
    TAB1.Close;
    TAB2.Close;
    InfoCardOpenDlg := TOpenDialog.Create(Self);
    InfoCardOpenDlg.InitialDir := ExtractFilePath(Application.ExeName);
    InfoCardOpenDlg.Filter := '名片通信录数据库(*.Dat)|*.Dat';
    InfoCardOpenDlg.Title := '== 选择名片通讯录存档文件 ==';
    InfoCardOpenDlg.DefaultExt := '.Dat';
    InfoCardOpenDlg.Options := InfoCardOpenDlg.Options;
    if InfoCardOpenDlg.Execute then
    if  CopyFile(Pchar(InfoCardOpenDlg.FileName), Pchar(DBName), False) then
    Application.MessageBox(PChar('成功读入：' + InfoCardOpenDlg.FileName+'!'), '信息提示', MB_OK+MB_ICONINFORMATION)
    else
    Application.MessageBox('读入失败，请检查是否文件损坏！', '错误提示', MB_OK+MB_ICONERROR);
    InfoCardOpenDlg.Free;
    TVRefresh(TreeView1);
  end;
end;
{=================导出至文本文件====================}
procedure TInfoCardFrm.DBToTxtClick(Sender: TObject);
var
  TxtFile: TextFile;
begin
  AssignFile(TxtFile,'InfoCard.Txt');
  ReWrite(TxtFile);
  TAB1.Filtered := False;
  TAB1.First;
  while not TAB1.Eof do
  begin
    Writeln(TxtFile,
    TAB1.FieldValues['ADType'] + #9 +
    TAB1.FieldValues['Name'] + #9 +
    TAB1.FieldValues['Mobile'] + #9 +
    TAB1.FieldValues['Email'] + #9 +
    TAB1.FieldValues['QQ'] + #9 +
    TAB1.FieldValues['OffTel'] + #9 +
    TAB1.FieldValues['HomeTel'] + #9 +
    TAB1.FieldValues['Fax'] + #9 +
    TAB1.FieldValues['ZipCode'] + #9 +
    TAB1.FieldValues['ContAdd'] + #9 +
    TAB1.FieldValues['Memo']);
    TAB1.Next;
  end;
  CloseFile(TxtFile);
  Application.MessageBox('已成功导出文本文件:InfoCard.Txt(与执行程序同目录)!'
                         + #13 + #13 + '可以在Excel中打开或导入其它格式的数据库。',
                         '信息提示', MB_OK+MB_ICONINFORMATION);
  ShellExecute(Handle,nil,'InfoCard.Txt',nil,nil,SW_Normal);
end;
{=====================设置登录密码======================}
procedure TInfoCardFrm.SetLogPassClick(Sender: TObject);
begin
  Application.CreateForm(TSetPassFrm, SetPassFrm);
  SetPassFrm.ShowModal;
  SetPassFrm.Free;
end;

procedure TInfoCardFrm.SetADBKTypeClick(Sender: TObject);
{=====================设置通信录分类====================}
begin
  Application.CreateForm(TSetADTypeFrm, SetADTypeFrm);
  SetADTypeFrm.ShowModal;
  SetADTypeFrm.Free;
  TVRefresh(TreeView1);
end;
{=======================使用帮助========================}
procedure TInfoCardFrm.AboutHelpClick(Sender: TObject);
begin
  Application.CreateForm(THelpFrm, HelpFrm);
  HelpFrm.ShowModal;
  HelpFrm.Free;
end;
{=======================程序说明========================}
procedure TInfoCardFrm.AboutSourceClick(Sender: TObject);
begin
  Application.MessageBox('                   ' +
  '======= 刀剑如梦软件创作室 =======' + #13 + #13 + '简介：'+ #13 +
  '======'+ #13 +
  '    本软件采用Borland Delphi 6.0及轻型数据库引擎TinyDB 2.9(感谢TinyDB作者' + #13 + #13 +
  '郝新庚先生写出如此轻盈的引擎)，属免费绿色软件，无需额外的驱动程序或软件环' + #13 + #13 +
  '境支持，只有一个独立执行文件，不会对系统造成任何影响，可运行于Windows 98/' + #13 + #13 +
  'ME/Windows 2000/XP 等环境，运行时只需建一目录拷贝进InfoCard.exe文件即可。',
  '程序说明',MB_OK);
end;
{=======================关于========================}
procedure TInfoCardFrm.AboutMeClick(Sender: TObject);
begin
  Application.CreateForm(TAboutMeFrm, AboutMeFrm);
  AboutMeFrm.ShowModal;
  AboutMeFrm.Free;
end;

end.