📄 main.pas
字号:
{
//*********************************************************
// Kaersoft 卡尔软件
// *************************************
// http://www.kaer.cn/default.aspx
// Email:Sdwhxyr@YEAH.NET
// QQ:54076683
// Delphi 6.0 PASS
// 调测：JPYC
//**********************************************************
程序功能
***************************************************
* 个人通信录(V1.0) *
* 程序设计：周小军 chowsg@21cn.com *
* 设计环境：Delphi 6.0+TinyDB 2.9 *
* 如在Delphi下编译，需另外下载TinyDB控件组支持 *
* TinyDB下载网址：tinydb.yeah.net *
* 界面控件使用了Xpmenu，在网上很易找到的 *
* 2003年6月 *
***************************************************
//**********************************************************
}
unit Main;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Menus, XPMenu, StdCtrls, ComCtrls, ExtCtrls, ToolWin, DB, TinyDB,
DBCtrls, ImgList,ShellAPI;
const
DBPassWord='HELLO'; //在TinyDB中打开数据库的密码
type
TFrmMain = 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;
PopQuit: TMenuItem;
EditSearch: TEdit;
N1: TMenuItem;
N2: TMenuItem;
N3: TMenuItem;
N4: TMenuItem;
function DBOpen_SysInfo(var Tab:TTinyTable):boolean;
function DBOpen_AdTypes(var Tab:TTinyTable):boolean;
function DBOpen_ADBK(var Tab: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 PopQuitClick(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
DBName:string; //数据库名称
LogPass:string; //系统登录密码，从数据库SysInfo表中读取
Logined:boolean; //系统是否已经登录
{ Public declarations }
end;
var
FrmMain: TFrmMain;
implementation
uses Login, SetPass, Input, SetADType, AboutMe, Help;
{$R *.dfm}
function TFrmMain.DBOpen_SysInfo(var Tab:TTinyTable):boolean;
{打开数据库中SysInfo表的函数}
begin
try
Tab.Close;
Tab.DatabaseName:=FrmMain.DBName;
Tab.TableName:='SysInfo';
Tab.Password:=DBPassWord;
Tab.Open;
Result:=True;
except
Result:=False;
end;
end;
function TFrmMain.DBOpen_ADTypes(var Tab:TTinyTable):boolean;
{打开数据库中AdTypes表的函数}
begin
try
Tab.Close;
Tab.DatabaseName:=FrmMain.DBName;
Tab.TableName:='AdTypes';
Tab.Password:=DBPassWord;
Tab.Open;
Result:=True;
except
Result:=False;
end;
end;
function TFrmMain.DBOpen_ADBK(var Tab:TTinyTable):boolean;
{打开数据库中ADBK表的函数}
begin
try
Tab.Close;
Tab.DatabaseName:=FrmMain.DBName;
Tab.TableName:='ADBK';
Tab.IndexName:='ADBIdx';
Tab.Password:=DBPassWord;
Tab.Open;
Result:=True;
except
Result:=False;
end;
end;
procedure TFrmMain.CreateDB(sender:Tobject);
{生成空白数据库}
var
TDB:TTinyDataBase; //TinyDB控件
TTB:TTinyTable; //TinyDB控件
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('ADBK',[
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('ADBK','ADBIdx',[tiPrimary],['ADType','Name']); //索引
TDB.Free;
TTB:=TTinyTable.Create(self);
with TTB do
begin
if DBOpen_SysInfo(TTB) then AppendRecord(['']); //插入登录密码，默认为无
if DBOpen_ADTypes(TTB) then
begin
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 FrmMain.TAB1 do
begin
Filtered:=False;
Locate('Name',Trim(ShowName),[]);
FrmMain.LabS01.Caption:=FieldByName('AdType').AsString;
FrmMain.LabS02.Caption:=FieldByName('Name').AsString;
FrmMain.LabS03.Caption:=FieldValues['Mobile'];
FrmMain.LabS04.Caption:=FieldValues['Email'];
FrmMain.LabS05.Caption:=FieldValues['QQ'];
FrmMain.LabS06.Caption:=FieldValues['OffTel'];
FrmMain.LabS07.Caption:=FieldValues['HomeTel'];
FrmMain.LabS08.Caption:=FieldValues['Fax'];
FrmMain.LabS09.Caption:=FieldValues['ZipCode'];
FrmMain.LabS10.Caption:=FieldValues['ContAdd'];
FrmMain.LabS11.Caption:=FieldValues['Memo'];
end;
end;
procedure LABSClear;
{清除右侧显示记录的内容}
begin
with FrmMain 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;
procedure TFrmMain.TVRefresh(var TV:TTreeview);
{刷新TreeView}
var
RootList:Tstringlist;
TmpNode:TTreeNode;
Pstr:^string;
i:integer;
begin
RootList:=TstringList.Create;
if DBOpen_ADTypes(FrmMain.TAB2) then
while not FrmMain.TAB2.eof do
begin
RootList.Append(Trim(FrmMain.TAB2.FieldValues['TypeName']));
FrmMain.TAB2.Next;
end
else showmessage('打不开ADTypes表!'); //以上读取Treeview的第一层内容
New(Pstr);
TV.Items.Clear;
TV.Items.BeginUpdate;
if DBOpen_ADBK(FrmMain.TAB1) then
begin
FrmMain.TAB1.Filtered:=False;
StatusBar1.Panels[0].Text:='记录数:'+IntToStr(FrmMain.TAB1.RecordCount);
for i:=0 to RootList.Count-1 do
begin
TmpNode:=TV.Items.AddObject(nil,RootList[i],pstr);
with FrmMain.TAB1 do
begin
Filtered:=False;
Filter:='ADType='+''''+RootList[i]+'''';
Filtered:=True;
First;
while not eof do
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -