unit1.pas

一个很小的个人通讯录管理程序,ACCESS数据,要装XP控件,内符

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Menus, ComCtrls, ExtCtrls, ImgList, XPMenu, StdCtrls;

type
  TfMain = class(TForm)
    MainMenu1: TMainMenu;
    S1: TMenuItem;
    Q1: TMenuItem;
    T1: TMenuItem;
    T2: TMenuItem;
    U1: TMenuItem;
    TvUsr: TTreeView;
    U2: TMenuItem;
    D1: TMenuItem;
    StatusBar1: TStatusBar;
    Splitter1: TSplitter;
    Panel1: TPanel;
    ImageList1: TImageList;
    XPMenu1: TXPMenu;
    PopupMenu1: TPopupMenu;
    G1: TMenuItem;
    U3: TMenuItem;
    N1: TMenuItem;
    D2: TMenuItem;
    StaticText2: TStaticText;
    StaticText3: TStaticText;
    StaticText4: TStaticText;
    StaticText19: TStaticText;
    StaticText20: TStaticText;
    StaticText8: TStaticText;
    StaticText9: TStaticText;
    StaticText10: TStaticText;
    StaticText11: TStaticText;
    StaticText12: TStaticText;
    StaticText13: TStaticText;
    StaticText1: TStaticText;
    StaticText18: TStaticText;
    StaticText21: TStaticText;
    StaticText22: TStaticText;
    StaticText6: TStaticText;
    StaticText7: TStaticText;
    StaticText14: TStaticText;
    StaticText15: TStaticText;
    StaticText16: TStaticText;
    StaticText17: TStaticText;
    StaticText23: TStaticText;
    StaticText24: TStaticText;
    StaticText25: TStaticText;
    StaticText26: TStaticText;
    StaticText27: TStaticText;
    StaticText28: TStaticText;
    StaticText29: TStaticText;
    StaticText30: TStaticText;
    StaticText31: TStaticText;
    StaticText32: TStaticText;
    T3: TMenuItem;
    S2: TMenuItem;
    H1: TMenuItem;
    A1: TMenuItem;
    StaticText33: TStaticText;
    StaticText34: TStaticText;
    StaticText5: TStaticText;
    StaticText35: TStaticText;
    StaticText36: TStaticText;
    StaticText37: TStaticText;
    StaticText38: TStaticText;
    procedure Q1Click(Sender: TObject);
    procedure T2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure U2Click(Sender: TObject);
    procedure D1Click(Sender: TObject);
    procedure G1Click(Sender: TObject);
    procedure N1Click(Sender: TObject);
    procedure D2Click(Sender: TObject);
    procedure U1Click(Sender: TObject);
    procedure U3Click(Sender: TObject);
    procedure TvUsrChange(Sender: TObject; Node: TTreeNode);
    procedure A1Click(Sender: TObject);
    procedure S2Click(Sender: TObject);
  private
    //系统初始化
    procedure Init;
    //新增分类
    procedure AddGroup;
    //新增用户
    procedure AddUser;
    //修改分类或者用户
    procedure Edit;
    //删除分类或者用户
    procedure Delete;
    //清除右侧显示记录的内容
    procedure ClearRight;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  fMain: TfMain;

implementation

uses Unit2, Unit3, Unit4, Unit5, Unit6;

{$R *.dfm}

//新增分类
procedure TfMain.AddGroup;
var
  id:integer;
begin
  DM.qGroup.Close;
  with DM.qGroup do
  begin
    close;
    sql.Clear;
    //取当前分类表中最大的分类编号
    sql.Add('select max(groupid) as mid from GroupTbl');
    open;
    //如果当前分类表记录为空，则将当前增加的分类编号设为1
    if fieldbyname('mid').IsNull then
      id:=1
    else
      //如果有记录存在，则将当前增加的分类编号设为最大编号＋1
      id:=fieldbyname('mid').AsInteger+1;
    close;
    sql.Clear;
    sql.Add('select * from GroupTbl');
    open;
    //将分类表设为新增状态
    append;
    //给分类编号赋值
    fieldbyname('groupid').Value:=id;
    //调用分类管理模块，实现新增功能
    if not assigned(fGroupMnt) then
      fGroupMnt:=tfGroupMnt.Create(application);
    fGroupMnt.Caption:='新增分类';
    fGroupMnt.ShowModal;
  end;
  //系统初始化
  init;
end;

//系统初始化
procedure TfMain.Init;
var
  parTN,nowTN,childTN:TTreeNode;
  grpName,usrName:string;
  grpid:integer;
begin
  //获得所有的分类
  with DM.qGroup do
  begin
    close;
    sql.Clear;
    sql.Add('select * from GroupTbl order by GroupId');
    try
      open;
    except
      showmessage('数据库出错![分类表]');
      exit;
    end;
  end;
  //增加TreeView控件的各个节点
  with TVusr.Items do
  begin
    clear;
    //增加根节点
    parTN:=Add(nil,'通讯录');
    //设置根节点的位置标志
    parTN.SelectedIndex:=0;
    //设置根节点的图像标志
    parTN.ImageIndex:=0;
    while not DM.qGroup.Eof do
    begin
      grpname:=DM.qGroup.fieldbyname('groupname').AsString;
      grpId:=DM.qGroup.fieldbyname('groupid').AsInteger;
      //将各个分类名称作为第一级节点
      nowTN:=Addchild(parTN,grpname);
      //设置第一级节点的位置标志
      nowTN.SelectedIndex:=1;
      //设置第一级节点的图像标志
      nowTN.ImageIndex:=1;
      //根据分类编号在名片表中查找对应的名片信息
      DM.qLinkMan.Close;
      DM.qLinkMan.SQL.Clear;
      DM.qLinkMan.SQL.add(
        'select * from LinkMan where GroupID='+inttostr(grpId));
      try
        DM.qLinkMan.open;
      except
        showmessage('数据库出错![名片表]');
        exit;
      end;
      DM.qLinkMan.First;
      while not DM.qLinkMan.eof do
      begin
        UsrName:=DM.qLinkMan.fieldbyname('Name_Cn').AsString;
        //将属于该分类的各个名片作为第二级节点
        ChildTN:=AddChild(nowTN,usrname);
        //设置第二级节点的位置标志
        ChildTN.SelectedIndex:=2;
        //设置第二级节点的图像标志
        ChildTN.ImageIndex:=2;
        DM.qLinkMan.Next;
      end;
      DM.qGroup.next;
    end;
  end;
  DM.qGroup.close;
  DM.qLinkMan.close;
  //清除右侧显示记录的内容
  ClearRight;
  //展开根节点下的第一级节点
  parTN.Expand(False);
end;

procedure TfMain.Q1Click(Sender: TObject);
begin
  Close;
end;

procedure TfMain.T2Click(Sender: TObject);
begin
  AddGroup;
end;

procedure TfMain.FormCreate(Sender: TObject);
begin
  Init;
end;

//修改分类或者名片信息
procedure TfMain.Edit;
var
  id:string;
begin
  //获得当前选择的对象名称
  id:=TVusr.Selected.Text;
  case tvusr.Selected.SelectedIndex of
  1:
  //如果选择的是分类
  begin
    //根据选择的分类名称，在分类表中定位到该条记录
    with DM.qGroup do
    begin
      close;
      sql.Clear;
      sql.Add('select * from grouptbl where groupname='''+id+'''');
      open;
      //将分类表设为编辑状态
      edit;
    end;
    //调用分类管理模块，实现修改功能
    if not assigned(fGroupMnt) then
      fGroupMnt:=tfGroupMnt.Create(application);
    fGroupMnt.Caption:='修改分类';
    fGroupMnt.ShowModal;
  end;
  2:
  //如果选择的是名片
  begin
    //根据选择的姓名，在名片表中定位到该条记录
    with DM.qLinkMan do
    begin
      close;
      sql.clear;
      sql.Add('select * from LinkMan where Name_Cn='''+id+'''');
      open;
      //将名片表设为编辑状态
      edit;
    end;
    //调用名片管理模块，实现修改功能
    if not assigned(fUserMnt) then
      fUserMnt:=tfUserMnt.Create(application);
    fUserMnt.Caption:='修改名片信息';
    fUserMnt.DBComboBox1.ItemIndex:=fUserMnt.DBComboBox1.Items.IndexOf(DM.qLinkMan.fieldbyname('GroupId').AsString);
    fUserMnt.ComboBox1.ItemIndex:=fUserMnt.DBComboBox1.ItemIndex;
    fUserMnt.ShowModal;
  end;
  end;
  init;

end;

procedure TfMain.U2Click(Sender: TObject);
begin
  Edit;
end;

//删除分类或者名片
procedure TfMain.Delete;
var
  id:string;
begin
  //获得当前选择的对象名称
  id:=TVusr.Selected.Text;
  case tvusr.Selected.SelectedIndex of
  1:
  //如果选择的是分类
  begin
    //提示是否删除
    if MessageDlg('若删除该分类，将会将该分类所属的名片都删除！确定要删除该分类吗？',mtConfirmation,
    [mbYes, mbNo],0) = mrYes then
    begin
      //根据选择的分类名称，在分类表中获得对应的分类编号
      with DM.qGroup do
      begin
        close;
        sql.Clear;
        sql.Add('select groupid from GroupTbl where groupname='''+id+'''');
        try
          open;
        except
          showmessage('打开分类表错误！');
          exit;
        end;
      end;
      with DM.qLinkMan do
      begin
        close;
        sql.Clear;
        //在分类表中删除指定的分类记录
        sql.Add('delete from GroupTbl where groupname='''+id+'''');
        try
          ExecSql;
          close;
          sql.Clear;
          //在名片表中删除属于该分类的所有名片的信息
          sql.Add(' delete from LinkMan where groupid='+inttostr(DM.qGroup['groupid']));
          ExecSql;
          ShowMessage('删除分类['+id+']成功！');
        except
          ShowMessage('删除分类['+id+']错误！');
          exit;
        end;
      end;
    end;  
  end;
  2:
  //如果选择的是名片
  begin
    //提示是否删除
    if MessageDlg('确定要删除该名片吗？',mtConfirmation,
    [mbYes, mbNo],0) = mrYes then
    begin
      with DM.qLinkMan do
      begin
        close;
        sql.clear;
        //删在名片表中删除指定的名片信息
        sql.Add('delete from LinkMan where Name_Cn='''+id+'''');
        try
          ExecSql;
          ShowMessage('删除['+id+']名片成功！');
        except
          ShowMessage('删除['+id+']名片错误！');
          exit;
        end;
      end;
    end;
  end;
  end;
  //初始化
  init;
end;

procedure TfMain.D1Click(Sender: TObject);
begin
  Delete;
end;

procedure TfMain.G1Click(Sender: TObject);
begin
  AddGroup;
end;

procedure TfMain.N1Click(Sender: TObject);
begin
  Edit;
end;

procedure TfMain.D2Click(Sender: TObject);
begin
  Delete;
end;

//增加名片
procedure TfMain.AddUser;
begin
  with DM.qLinkMan do
  begin
    close;
    sql.Clear;
    sql.Add('select * from LinkMan');
    open;
    //将名片表设为新增状态
    append;
    //调用名片管理模块，实现新增功能
    if not assigned(fUserMnt) then
      fUserMnt:=tfUserMnt.Create(application);
    fUserMnt.Caption:='新增名片信息';
    fUserMnt.ShowModal;
  end;
  //系统初始化
  init;
end;

procedure TfMain.U1Click(Sender: TObject);
begin
  AddUser;
end;

procedure TfMain.U3Click(Sender: TObject);
begin
  AddUser;
end;

//TreeView移动或点击姓名时浏览资料
procedure TfMain.TvUsrChange(Sender: TObject; Node: TTreeNode);
var
  id:string;
begin
  //获得当前选择的对象名称
  id:=TVusr.Selected.Text;
  //在状态栏中显示选择的对象名称
  StatusBar1.Panels[0].Text:='当前选择:'+id;
  case tvusr.Selected.SelectedIndex of
  0,1:
  //如果不是选择名片，那么清除右侧显示记录的内容
  begin
    ClearRight;
  end;
  2:
  //如果选择名片，则根据选定的姓名在数据库中获得该名片对应的相关信息
  begin
    with DM.qLinkMan do
    begin
      Close;
      sql.Clear;
      sql.Add('select a.*,b.GroupName from LinkMan a,GroupTbl b ');
      sql.Add(' where a.groupID=b.GroupID and a.Name_Cn='''+id+'''');
      Open;
      //在右侧显示指定的名片相关信息
      StaticText6.Caption:=fieldbyname('groupname').AsString;
      StaticText7.Caption:=fieldbyname('Name_Cn').AsString;
      StaticText14.Caption:=fieldbyname('Name_En').AsString;
      StaticText15.Caption:=fieldbyname('Sex').AsString;
      StaticText16.Caption:=fieldbyname('Corp').AsString;
      StaticText5.Caption:=fieldbyname('Position').AsString;
      StaticText17.Caption:=fieldbyname('OfficePhone').AsString;
      StaticText23.Caption:=fieldbyname('Fax').AsString;
      StaticText24.Caption:=fieldbyname('Post').AsString;
      StaticText25.Caption:=fieldbyname('Address').AsString;
      StaticText26.Caption:=fieldbyname('MobilePhone').AsString;
      StaticText27.Caption:=fieldbyname('Email').AsString;
      StaticText28.Caption:=fieldbyname('HomePhone').AsString;
      StaticText29.Caption:=fieldbyname('URL').AsString;
      StaticText30.Caption:=fieldbyname('OICQ').AsString;
      StaticText31.Caption:=fieldbyname('ICQ').AsString;
      StaticText32.Caption:=fieldbyname('MSN').AsString;
      StaticText36.Caption:=fieldbyname('Birthday').AsString;
      StaticText38.Caption:=fieldbyname('GraduateSchool').AsString;
    end;
  end;
  end;
end;

procedure TfMain.ClearRight;
begin
  StaticText6.Caption:='';
  StaticText7.Caption:='';
  StaticText14.Caption:='';
  StaticText15.Caption:='';
  StaticText16.Caption:='';
  StaticText5.Caption:='';
  StaticText17.Caption:='';
  StaticText23.Caption:='';
  StaticText24.Caption:='';
  StaticText25.Caption:='';
  StaticText26.Caption:='';
  StaticText27.Caption:='';
  StaticText28.Caption:='';
  StaticText29.Caption:='';
  StaticText30.Caption:='';
  StaticText31.Caption:='';
  StaticText32.Caption:='';
  StaticText36.Caption:='';
  StaticText38.Caption:='';
end;

procedure TfMain.A1Click(Sender: TObject);
begin
  if AboutBox=nil then
    AboutBox:=tAboutBox.Create(application);
  AboutBox.ShowModal;
end;

procedure TfMain.S2Click(Sender: TObject);
begin
  if fSearch=nil then
    fSearch:=tfSearch.Create(application);
  fSearch.show;
end;

end.