uinfocard.pas

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

unit uInfoCard;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Menus, XPMenu, StdCtrls, ComCtrls, ExtCtrls, ToolWin, DB, TinyDB,
  DBCtrls, ImgList,ShellAPI;

{在TinyDB中打开数据库的密码}
const
  DBPassWord='KingLong';

type
  TInfoCardFrm = class(TForm)
    MainMenu1: TMainMenu;
    ADBKManual: TMenuItem;
    RecAddNew: TMenuItem;
    RecModify: TMenuItem;
    RecDelete: TMenuItem;
    QuitSys: TMenuItem;
    DataManual: TMenuItem;
    DBBackup: TMenuItem;
    DBRestore: TMenuItem;
    SysHelp: TMenuItem;
    AboutHelp: TMenuItem;
    AboutSource: TMenuItem;
    AboutMe: TMenuItem;
    CoolBar1: TCoolBar;
    ToolBar1: TToolBar;
    RadioButton1: TRadioButton;
    RadioButton2: TRadioButton;
    RadioButton3: TRadioButton;
    RadioButton4: TRadioButton;
    CmdSearch: TButton;
    XPMenu1: TXPMenu;
    TreeView1: TTreeView;
    Panel1: TPanel;
    TAB1: TTinyTable;
    LabT01: TLabel;
    LabT02: TLabel;
    LabT03: TLabel;
    LabT04: TLabel;
    LabT05: TLabel;
    LabT06: TLabel;
    LabT07: TLabel;
    LabT08: TLabel;
    LabT09: TLabel;
    LabT10: TLabel;
    LabT11: TLabel;
    SysSet: TMenuItem;
    SetLogPass: TMenuItem;
    SetADBKType: TMenuItem;
    ImageList1: TImageList;
    StatusBar1: TStatusBar;
    Null11: TMenuItem;
    Null21: TMenuItem;
    Null41: TMenuItem;
    Timer1: TTimer;
    DBToTxt: TMenuItem;
    TAB2: TTinyTable;
    PopupMenu1: TPopupMenu;
    POPAddNew: TMenuItem;
    POPModify: TMenuItem;
    PopDelete: TMenuItem;
    LabS01: TLabel;
    LabS02: TLabel;
    LabS03: TLabel;
    LabS04: TLabel;
    LabS05: TLabel;
    LabS06: TLabel;
    LabS07: TLabel;
    LabS08: TLabel;
    LabS09: TLabel;
    LabS10: TLabel;
    LabS11: TLabel;
    PopRefresh: TMenuItem;
    EditSearch: TEdit;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    BackPnl: TPanel;
    function OpenDBSysInfo(var InfoCardTable: TTinyTable): Boolean;
    function OpenDBAdTypes(var InfoCardTable: TTinyTable): Boolean;
    function OpenDBInfoCard(var InfoCardTable: TTinyTable): Boolean;
    procedure CreateDB(Sender: TObject);
    procedure TVRefresh(var TV:TTreeview);
    procedure FormCreate(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure SetLogPassClick(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure RecAddNewClick(Sender: TObject);
    procedure SetADBKTypeClick(Sender: TObject);
    procedure AboutMeClick(Sender: TObject);
    procedure POPModifyClick(Sender: TObject);
    procedure TreeView1DblClick(Sender: TObject);
    procedure TreeView1Change(Sender: TObject; Node: TTreeNode);
    procedure POPAddNewClick(Sender: TObject);
    procedure PopDeleteClick(Sender: TObject);
    procedure RecModifyClick(Sender: TObject);
    procedure RecDeleteClick(Sender: TObject);
    procedure PopRefreshClick(Sender: TObject);
    procedure QuitSysClick(Sender: TObject);
    procedure CmdSearchClick(Sender: TObject);
    procedure EditSearchKeyPress(Sender: TObject; var Key: Char);
    procedure EditSearchDblClick(Sender: TObject);
    procedure DBBackupClick(Sender: TObject);
    procedure DBRestoreClick(Sender: TObject);
    procedure DBToTxtClick(Sender: TObject);
    procedure AboutHelpClick(Sender: TObject);
    procedure AboutSourceClick(Sender: TObject);
  private
    { Private declarations }
  public
    {数据库名称及系统登录密码，从数据库SysInfo表中读取}
    DBName, LoginPass: string;
    {系统是否已经登录}
    IsLogined: Boolean;
    { Public declarations }
  end;

var
  InfoCardFrm: TInfoCardFrm;

implementation

uses uLogin, uSetPass, uInput, uSetType, uAboutMe, uHelp;

{$R *.dfm}

function TInfoCardFrm.OpenDBSysInfo(var InfoCardTable: TTinyTable): Boolean;
{打开数据库中SysInfo表的函数}
begin
  try
    InfoCardTable.Close;
    InfoCardTable.DatabaseName := InfoCardFrm.DBName;
    InfoCardTable.TableName := 'SysInfo';
    InfoCardTable.Password := DBPassWord;
    InfoCardTable.Open;
    Result := True;
  except
    Result := False;
  end;
end;

function TInfoCardFrm.OpenDBADTypes(var InfoCardTable: TTinyTable): Boolean;
{打开数据库中AdTypes表的函数}
begin
  try
    InfoCardTable.Close;
    InfoCardTable.DatabaseName := InfoCardFrm.DBName;
    InfoCardTable.TableName := 'AdTypes';
    InfoCardTable.Password := DBPassWord;
    InfoCardTable.Open;
    Result := True;
  except
    Result := False;
  end;
end;

function TInfoCardFrm.OpenDBInfoCard(var InfoCardTable: TTinyTable): Boolean;
{打开数据库中InfoCard表的函数}
begin
  try
    InfoCardTable.Close;
    InfoCardTable.DatabaseName:=InfoCardFrm.DBName;
    InfoCardTable.TableName := 'InfoCard';
    InfoCardTable.IndexName := 'InfoCardIdx';
    InfoCardTable.Password := DBPassWord;
    InfoCardTable.Open;
    Result := True;
  except
    Result := False;
  end;
end;

procedure TInfoCardFrm.CreateDB(sender:Tobject);
{生成空白数据库}
var
  TDB: TTinyDataBase;
  TTB: TTinyTable;
begin
   Try
     TDB:=TTinyDataBase.Create(self);
     TDB.DatabaseName:=DBName;
     TDB.Password:=DBPassWord;
     TDB.CreateDatabase(DBName,True, clNormal, 'ZLIB', True, 'Twofish', DbPassWord,True);
     TDB.CreateTable('SysInfo',[FieldItem('PassWord', ftString, 10)]); //密码存储
     TDB.CreateTable('ADTypes',[FieldItem('TypeName', ftstring, 8)]);  //通信录类别
     TDB.CreateTable('InfoCard',[
          FieldItem('ADType',ftString,8),   //类别
          FieldItem('Name',ftString,10),    //姓名
          FieldItem('Mobile',ftString,11),  //手机号码
          FieldItem('Email',ftString,20),   //电子邮箱
          FieldItem('QQ',ftString,12),      //QQ号码
          FieldItem('OffTel',ftString,18),  //办公电话
          FieldItem('HomeTel',ftString,13), //住宅电话
          FieldItem('Fax',ftString,13),     //传真号码
          FieldItem('ZipCode',ftString,6),  //邮政编码
          FieldItem('ContAdd',ftString,40), //联络地址
          FieldItem('Memo',ftString,20)     //备注
      ]);                                   //创建通信录数据库
      TDB.CreateIndex('InfoCard','InfoCardIdx',[tiPrimary],['ADType','Name']); //索引
      TDB.Free;
      TTB:=TTinyTable.Create(Self);
      with TTB do
      begin
        if OpenDBSysInfo(TTB) then AppendRecord(['']); //插入登录密码，默认为无
        if OpenDBADTypes(TTB) then
       {========加入四类基本名片通信录分类========}
        begin
          AppendRecord(['朋友']);
          AppendRecord(['亲戚']);
          AppendRecord(['同学']);
          AppendRecord(['网友']);
        end;
      end;
      TTB.Free;
      MessageDlg(
      '************* Welcome *************'+#13+#13+
      '已成功新建空白数据库!'+#13+#13+
      '如果是初次使用，请先设置好[通信录分类],'+#13+#13+
      '具体的操作细节请参阅[使用帮助]。',mtInformation,[mbOK],0);
    except
      DeleteFile(DBName);
    end;
end;

procedure LABSShow(ShowName:string);
{显示某条记录内容}
begin
   with InfoCardFrm.TAB1 do
   begin
     Filtered := False;
     Locate('Name',Trim(ShowName),[]);
     InfoCardFrm.LabS01.Caption := FieldByName('AdType').AsString;
     InfoCardFrm.LabS02.Caption := FieldByName('Name').AsString;
     InfoCardFrm.LabS03.Caption := FieldValues['Mobile'];
     InfoCardFrm.LabS04.Caption := FieldValues['Email'];
     InfoCardFrm.LabS05.Caption := FieldValues['QQ'];
     InfoCardFrm.LabS06.Caption := FieldValues['OffTel'];
     InfoCardFrm.LabS07.Caption := FieldValues['HomeTel'];
     InfoCardFrm.LabS08.Caption := FieldValues['Fax'];
     InfoCardFrm.LabS09.Caption := FieldValues['ZipCode'];
     InfoCardFrm.LabS10.Caption := FieldValues['ContAdd'];
     InfoCardFrm.LabS11.Caption := FieldValues['Memo'];
    end;
end;
{===================清除右侧显示记录的内容===================}
procedure ClearRightContent;
begin
  with InfoCardFrm do
  begin
    Labs01.Caption := '';
    Labs02.Caption := '';
    Labs03.Caption := '';
    Labs04.Caption := '';
    Labs05.Caption := '';
    Labs06.Caption := '';
    Labs07.Caption := '';
    Labs08.Caption := '';
    Labs09.Caption := '';
    Labs10.Caption := '';
    Labs11.Caption := '';
  end;
end;
{=================刷新TreeView====================}
procedure TInfoCardFrm.TVRefresh(var TV:TTreeview);
var
  RootList: TStringList;
  TmpNode: TTreeNode;
  Pstr: ^string;
  I: Integer;
begin
  RootList := TStringList.Create;
  if OpenDBADTypes(InfoCardFrm.TAB2) then
     while not InfoCardFrm.TAB2.eof do
        begin
          RootList.Append(Trim(InfoCardFrm.TAB2.FieldValues['TypeName']));
          InfoCardFrm.TAB2.Next;
        end
  else showmessage('打不开ADTypes表!');  //以上读取Treeview的第一层内容
  New(Pstr);
  TV.Items.Clear;
  TV.Items.BeginUpdate;
  if OpenDBInfoCard(InfoCardFrm.TAB1) then
  begin
    InfoCardFrm.TAB1.Filtered := False;
    StatusBar1.Panels[0].Text := '记录数:'+IntToStr(InfoCardFrm.TAB1.RecordCount);
    for I := 0 to RootList.Count - 1 do
      begin