main.pas

软件类别: 数据库 软件大小: 1.24M 运行环境: DELPHI 精巧的DELPHI通讯录程序

            begin
             TV.Items.AddChildObject(TmpNode,FieldValues['Name'],Pstr);
             next;
            end;                          // End while
        end;                              // End with
    end;                                  // End for
  end else showmessage('打不开ADBK表!');  // End if
  RootList.Free;
  TV.Items.EndUpdate;
end;

procedure TFrmMain.FormCreate(Sender: TObject);
{主窗口初始化}
var
  TmpTAB:TTinyTable;
begin
  Logined:=False;  //如果想屏蔽登录，可以将此处设为True;
  LogPass:='';
  DBName:=ExtractFilePath(Application.ExeName)+'ADBK.Tdb';
  if  not FileExists(DBName) then CreateDB(sender)
  else
  begin
    TmpTAB:=TTinyTable.Create(Self);
    if DBOpen_SysInfo(TmpTAB) then
      LogPass:=Trim(TmpTAB.FieldValues['Password']);
    TmpTAB.Free;
  end;
end;

procedure TFrmMain.FormActivate(Sender: TObject);
{主窗口活动时}
begin
  if (not Logined) and (length(LogPass)<>0) then
  begin
     Application.CreateForm(TFrmLogin, FrmLogin);
     FrmLogin.ShowModal;
     FrmLogin.Free;
  end;
  TVRefresh(TreeView1);
end;

procedure TFrmMain.Timer1Timer(Sender: TObject);
{计时器，设置右下角状态栏时间}
begin
  StaTusBar1.Panels[1].Text:=
  FormatDateTime('yyyy-mm-dd  hh:mm:ss',now())+'   ';
end;

procedure TFrmMain.RecAddNewClick(Sender: TObject);
{增加记录}
begin
  if ShowInputFrm('增加','') then TVRefresh(Treeview1);
//ShowInputFrm函数在Input.Pas中调用
end;


procedure TFrmMain.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 TFrmMain.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;
           LABSClear;
           TVRefresh(Treeview1);
         end;
    end;
end;

procedure TFrmMain.TreeView1Change(Sender: TObject; Node: TTreeNode);
{TreeView移动或点击姓名时浏览资料}
begin
  if Treeview1.Selected=nil then
    begin
      LABSClear;
      exit;
    end;
  if (TreeView1.Selected.Parent<>Nil) and
     ((length(Trim(TreeView1.Selected.Text))<>0))
  then  LABSShow(TreeView1.Selected.Text)
  else  LABSClear;
end;

procedure TFrmMain.TreeView1DblClick(Sender: TObject);
{TreeView双击姓名--修改记录}
begin
  RecModifyClick(Sender);
end;

procedure TFrmMain.POPAddNewClick(Sender: TObject);
{TreeView右键菜单--增加}
begin
   RecAddNewClick(Sender);
end;

procedure TFrmMain.POPModifyClick(Sender: TObject);
{TreeView右键菜单--修改}
begin
  RecModifyClick(Sender);
end;

procedure TFrmMain.PopDeleteClick(Sender: TObject);
{TreeView右键菜单--删除}
begin
  RecDeleteClick(Sender);
end;

procedure TFrmMain.PopRefreshClick(Sender: TObject);
{TreeView右键菜单--刷新}
begin
  TVRefresh(TreeView1);
end;

procedure TFrmMain.PopQuitClick(Sender: TObject);
{TreeView右键菜单--退出}
begin
  close;
end;

procedure TFrmMain.QuitSysClick(Sender: TObject);
{退出系统}
begin
  close;
end;

procedure TFrmMain.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
    LABSClear;
    showmessage ('没找到符合条件的记录!');
  end;

end;

procedure TFrmMain.EditSearchKeyPress(Sender: TObject; var Key: Char);
{拦截查询Edit中的Enter键-->查询}
begin
  if Key=#13 then CmdSearchClick(Sender);
end;

procedure TFrmMain.EditSearchDblClick(Sender: TObject);
{双击查询Edit清空内容}
begin
  EditSearch.Text:='';
end;

procedure TFrmMain.DBBackupClick(Sender: TObject);
{保存数据库}
var
  SaveDialog: TSaveDialog;
begin
  TAB1.Filtered:=False;
  if TAB1.RecordCount<=0 then
    begin
      showmessage('没有任何记录，无需保存!');
      exit;
    end
  else
    begin
      TAB1.Close;
      TAB2.Close;
      SaveDialog := TSaveDialog.Create(Self);
      SaveDialog.Filter := '通信录数据库(*.Dat)|*.Dat';
      SaveDialog.DefaultExt := '.Dat';
      SaveDialog.FileName:=FormatDateTime('yymmdd',now())+'通信录存档';
      SaveDialog.Options := SaveDialog.Options + [ofOverwritePrompt];
      if SaveDialog.Execute then
        CopyFile(Pchar(DBName),Pchar(SaveDialog.FileName),False);
      SaveDialog.Free;
      TVRefresh(TreeView1);
    end;
end;

procedure TFrmMain.DBRestoreClick(Sender: TObject);
{恢复数据库}
var
  OpenDialog: TOpenDialog;
begin
  if MessageDlg(
  '恢复数据库会覆盖当前所有记录，'+#13+#13+
  '你确认要恢复存档数据吗?',mtConfirmation,[mbYes,mbNo],0)=mrYes then
  begin
    TAB1.Close;
    TAB2.Close;
    OpenDialog:=TOpenDialog.Create(self);
    OpenDialog.Filter := '通信录数据库(*.Dat)|*.Dat';
    OpenDialog.DefaultExt := '.Dat';
    OpenDialog.Options := OpenDialog.Options;
    if OpenDialog.Execute then
    if  CopyFile(Pchar(OpenDialog.FileName),Pchar(DBName),False) then
        MessageDlg(
        '成功读入：'+OpenDialog.FileName+'!',mtInformation,[mbOK],0)
    else MessageDlg('读入失败，请检查是否文件损坏！',mtError,[mbOk],0);
    OpenDialog.Free;
    TVRefresh(TreeView1);
  end;
end;

procedure TFrmMain.DBToTxtClick(Sender: TObject);
{导出至文本文件}
var
  TxtFile:TextFile;
begin
  AssignFile(TxtFile,'Adbk.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);
  MessageDlg(
   '已成功导出文本文件:Adbk.Txt(与执行程序同目录)!'+#13+#13+
   '可以在Excel中打开或导入其它格式的数据库。',mtInformation,
   [mbOk],0);
  ShellExecute(Handle,nil,'Adbk.Txt',nil,nil,SW_Normal);
end;

procedure TFrmMain.SetLogPassClick(Sender: TObject);
{设置登录密码}
begin
  Application.CreateForm(TFrmSetPass, FrmSetPass);
  FrmSetPass.ShowModal;
  FrmSetPass.Free;
end;

procedure TFrmMain.SetADBKTypeClick(Sender: TObject);
{设置通信录分类}
begin
  Application.CreateForm(TFrmSetADType, FrmSetADType);
  FrmSetADType.ShowModal;
  FrmSetADType.Free;
  TVRefresh(TreeView1);
end;

procedure TFrmMain.AboutHelpClick(Sender: TObject);
{使用帮助}
begin
  Application.CreateForm(TFrmHelp, FrmHelp);
  FrmHelp.ShowModal;
  FrmHelp.Free;
end;

procedure TFrmMain.AboutSourceClick(Sender: TObject);
{程序说明}
begin
  Application.MessageBox(
  '前言：'+#13+
  '======'+#13+
  '    由于小生的通信录总是存在手机上，若不小心弄丢手机就造成一大本通信录的拜拜，'+#13+#13+
  '(厚着脸皮再问其它朋友要人家说你没良心^-^)，在网上搜索了几个通信录软件，但要么'+#13+#13+
  '功能多而庞大，要么就是执行不稳定，还有就是教科书上的样板...于是自己编写了这个'+#13+#13+
  '只有一个文件，不到 500K 的小软件。'+#13+#13+#13+
  '简介：'+#13+
  '======'+#13+
  '    本软件采用Borland Delphi 6.0及轻型数据库引擎TinyDB 2.9(感谢TinyDB作者'+#13+#13+
  '郝新庚先生写出如此轻盈的引擎)，属免费绿色软件，无需额外的驱动程序或软件环'+#13+#13+
  '境支持，只有一个独立执行文件，不会对系统造成任何影响，可运行于Windows 98/'+#13+#13+
  'ME/Windows 2000/XP 等环境，安装时只需建一目录拷贝进Adbk.exe文件即可运行。'+#13+#13+#13+
  '后记：'+#13+
  '===='+#13+
  '    由于水平所限及非专业写手，系统可能还有不如意的地方，在使用过程中有什么'+#13+#13+
  '错误及需要改进的地方，请及时与本人联系，如阁下有兴趣完善此软件，请与我联系。'+#13+#13+#13+
  '                                   作者：周小军 (CSDN上的ID:FCBFighter)'+#13+#13+
  '                                      Email:[e-mail]   2003年6月',
  '程序说明',MB_OK);
end;

procedure TFrmMain.AboutMeClick(Sender: TObject);
{关于}
begin
  Application.CreateForm(TFrmAboutMe, FrmAboutMe);
  FrmAboutMe.ShowModal;
  FrmAboutMe.Free;
end;

end.