aboutunit.pas

Delphi编写的通讯录

unit AboutUnit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, ToolWin, Grids, DBGrids, ExtCtrls, StdCtrls, Menus,
  ImgList, DB, DBTables, ADODB, ExtDlgs, jpeg, shellapi;

type
  TMainForm = class(TForm)
    MainMenu1: TMainMenu;
    CACMenu: TMenuItem;
    AddNewRecord: TMenuItem;
    Help: TMenuItem;
    AboutMenu: TMenuItem;
    AddNewAccount: TMenuItem;
    ChangPwd: TMenuItem;
    DelAccount: TMenuItem;
    ChangePurview: TMenuItem;
    DataPanel: TPanel;
    Label1: TLabel;
    Label2: TLabel;
    edtName: TEdit;
    CBSex: TComboBox;
    Label3: TLabel;
    CBStar: TComboBox;
    Label4: TLabel;
    edtBirthday: TDateTimePicker;
    Label5: TLabel;
    CBRelationShip: TComboBox;
    BTAddNewRelation: TButton;
    Label6: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    Label9: TLabel;
    edtMobile: TEdit;
    edtHome: TEdit;
    Label10: TLabel;
    Label11: TLabel;
    Label12: TLabel;
    Label13: TLabel;
    edtQQNO: TEdit;
    edtNickName: TEdit;
    edtHouse: TEdit;
    edtWeb: TEdit;
    edtEmail: TEdit;
    Memo1: TMemo;
    GoToWeb: TButton;
    SendEmial: TButton;
    PhotoPanel: TPanel;
    Panel2: TPanel;
    Image1: TImage;
    Panel1: TPanel;
    SBAR: TStatusBar;
    DataShowPanel: TPanel;
    DBGrid1: TDBGrid;
    TreeView1: TTreeView;
    BtModification: TButton;
    BtSaveModified: TButton;
    BtDelData: TButton;
    BtFirst: TButton;
    BtPrior: TButton;
    BtNext: TButton;
    BtLast: TButton;
    SelectPhoto: TButton;
    DataSource1: TDataSource;
    ImageList1: TImageList;
    ADOTable1: TADOQuery;
    PhotoSave: TButton;
    FindMenu: TMenuItem;
    OpenPictureDialog1: TOpenPictureDialog;
    SaveNewData: TMenuItem;
    Button1: TButton;
    ADOTable2: TADOQuery;
    Timer1: TTimer;
    E1: TMenuItem;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormCreate(Sender: TObject);
    procedure SelectPhotoClick(Sender: TObject);
    procedure PhotoSaveClick(Sender: TObject);
    procedure AddNewRecordClick(Sender: TObject);
    procedure SaveNewDataClick(Sender: TObject);
    procedure DBGrid1DblClick(Sender: TObject);
    procedure BtDelDataClick(Sender: TObject);
    procedure BtModificationClick(Sender: TObject);
    procedure BtSaveModifiedClick(Sender: TObject);
    procedure BtPriorClick(Sender: TObject);
    procedure BtFirstClick(Sender: TObject);
    procedure BtNextClick(Sender: TObject);
    procedure BtLastClick(Sender: TObject);
    procedure BTAddNewRelationClick(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure FindMenuClick(Sender: TObject);
    procedure TreeView1DblClick(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure AddNewAccountClick(Sender: TObject);
    procedure ChangePurviewClick(Sender: TObject);
    procedure DelAccountClick(Sender: TObject);
    procedure ChangPwdClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure E1Click(Sender: TObject);
    procedure GoToWebClick(Sender: TObject);
    procedure SendEmialClick(Sender: TObject);
    procedure HelpClick(Sender: TObject);
    procedure AboutMenuClick(Sender: TObject);
  private
    { Private declarations }
    TotalRecord:Integer;  //数据库记录总数；

    RSTotalRecord:integer;

    IfPhoto:boolean;

    Procedure BackStart;                                  //返回初始状态

    Procedure IfReadOnlyAndColor(b:boolean; c:Tcolor);    //设置

    Procedure DataShow;    //文本框中显示当前记录的个信息

    Procedure DataSaveTo; //把数据存入数据库

    Procedure TreeViewList; //树图节点显示

    Procedure BtDelAndBtModified; //删除按钮和修改记录按钮的状态
  public
    { Public declarations }
  end;

var
  MainForm: TMainForm;

implementation

uses LoginUnit, AddAccountUnit, ChangePurviewFormUnit, DelAccountUnit,
  ChangePwdUnit, MainUnit;

{$R *.dfm}
//-------------------------------自定义函数区----------------------------------//

Procedure TMainForm.BtDelAndBtModified;
begin
  if RSTotalRecord=0 then
    begin
      BtDelData.Enabled:=false;
      BtModification.Enabled:=false;
    end
  else
    begin
      BtDelData.Enabled:=true;
      BtModification.Enabled:=true;
    end;
end;
Procedure TmainForm.TreeViewList;
begin
  ADOTable2.Close;
  ADOTable2.SQL.Clear;
  ADOTable2.SQL.Add('select * from RS');
  ADOTable2.Prepared;
  ADOTable2.Open;
  TreeView1.Items.AddFirst(nil,'全部记录');
  while not ADOTable2.Eof do
    begin
      TreeView1.Items.Add(nil,AdoTable2.FieldValues['关系名']);
      ADOTable2.Next;
    end
end;
Procedure TMainForm.DataSaveTo;
begin
  ADOTable1.FieldByName('姓名').AsString:=edtName.Text;
  ADOTable1.FieldByName('性别').AsString:=CBSex.Text;
  ADOTable1.FieldByName('关系').AsString:=CBRelationShip.Text;
  ADOTable1.FieldByName('星座').AsString:=CBStar.Text;
  ADOTable1.FieldByName('生日').AsString:=DateToStr(edtbirthday.Date);
  ADOTable1.FieldByName('手机').AsString:=edtMobile.Text;
  ADOTable1.FieldByName('QQ').AsString:=edtQQNO.Text;
  ADOTable1.FieldByName('家庭电话').AsString:=edtHome.Text;
  ADOTable1.FieldByName('昵称').AsString:=edtNickName.Text;
  ADOTable1.FieldByName('家庭住址').AsString:=edtHouse.Text;
  ADOTable1.FieldByName('个人网站').AsString:=edtWeb.Text;
  ADOTable1.FieldByName('电子邮件').AsString:=edtEmail.Text;
  ADOTable1.FieldByName('备忘录').AsString:=memo1.Text;
end;

Procedure TmainForm.BackStart;
  var i: integer;
begin

  for i := 0 to MainForm.ComponentCount -1 do
  begin
    if MainForm.Components[i] is TEdit then        //如果是Edit控件
      TEdit(MainForm.Components[i]).Text :='';     //清除其中的内容
  end;

  CBSex.Text:='';
  CBStar.Text:='';
  CBRelationShip.Text:='';

end;

Procedure TmainForm.IfReadOnlyAndColor( b:boolean; c:Tcolor );
begin
  //设置是否为只读
  edtName.ReadOnly:=b;
  edtMobile.ReadOnly:=b;
  edtHome.ReadOnly:=b;
  edtHouse.ReadOnly:=b;
  edtWeb.ReadOnly:=b;
  edtEmail.ReadOnly:=b;
  edtQQNO.ReadOnly:=b;
  edtNickName.ReadOnly:=b;
  memo1.ReadOnly:=b;
  {edtBirthday.Enabled:=not b;
  CBRelationShip.Enabled:=not b;
  CBStar.Enabled:=not b;
  CBSex.Enabled:=not b;}

  //颜色定义
  edtName.Color:=c;
  edtMobile.Color:=c;
  edtHome.Color:=c;
  edtHouse.Color:=c;
  edtWeb.Color:=c;
  edtEmail.Color:=c;
  edtQQNO.Color:=c;
  edtNickName.Color:=c;
  memo1.Color:=c;
  edtBirthday.Color:=c;
  CBRelationShip.Color:=c;
  CBStar.Color:=c;
  CBSex.Color:=c;
end;

Procedure TMAINfORM.DataShow;
var
  strm:tadoblobstream;
  jpegimage:tjpegimage;
  bitmap:tbitmap;
begin
if ADOTable1.FieldValues['姓名']=NULL then
    edtName.Text:=''
  else
    edtName.Text:=ADOTable1.FieldValues['姓名'];

  if ADOTable1.FieldValues['性别']=NULL then
    CBsex.Text:=''
  else
    CBsex.Text:=ADOTable1.FieldValues['性别'];

  if ADOTable1.FieldValues['关系']=NULL then
    CBRelationShip.Text:=''
  else
    CBRelationShip.Text:=ADOTable1.FieldValues['关系'];

  if ADOTable1.FieldValues['生日']=NULL then
    edtBirthday.Date:=now
  else
    edtBirthday.Date:=ADOTable1.FieldValues['生日'];

  if ADOTable1.FieldValues['星座']=NULL then
    CBStar.Text:=''
  else
    CBStar.Text:=ADOTable1.FieldValues['星座'];

  if ADOTable1.FieldValues['手机']=NULL then
    edtmobile.Text:=''
  else
    edtmobile.Text:=ADOTable1.FieldValues['手机'];

  if ADOTable1.FieldValues['QQ']=NULL then
    edtQQNo.Text:=''
  else
    edtQQNo.Text:=ADOTable1.FieldValues['QQ'];

  if ADOTable1.FieldValues['家庭电话']=NULL then
    edtHome.Text:=''
  else
    edtHome.Text:=ADOTable1.FieldValues['家庭电话'];

  if ADOTable1.FieldValues['昵称']=NULL then
    edtNickName.Text:=''
  else
    edtNickName.Text:=ADOTable1.FieldValues['昵称'];

  if ADOTable1.FieldValues['家庭住址']=NULL then
    edtHouse.Text:=''
  else
    edtHouse.Text:=ADOTable1.FieldValues['家庭住址'];

  if ADOTable1.FieldValues['个人网站']=NULL then
    edtWeb.Text:=''
  else
    edtWeb.Text:=ADOTable1.FieldValues['个人网站'];

  if ADOTable1.FieldValues['电子邮件']=NULL then
    edtEmail.Text:=''
  else
    edtEmail.Text:=ADOTable1.FieldValues['电子邮件'];

  if ADOTable1.FieldValues['备忘录']=NULL then
    memo1.Text:=''
  else
    memo1.Text:=ADOTable1.FieldValues['备忘录'];

  strm := tadoblobstream.Create(tblobfield(adotable1.fieldbyname('照片')),bmread);
  try //try1
    strm.position :=0;
    image1.Picture.Graphic := nil; //清除图像
    // BMP、JPEG两种图像数据必需分别处理

    if adotable1.fieldbyname('isbmp').asstring ='1' then //BMP型图像数据
      begin //begin11
        bitmap := tbitmap.Create ;

        try //try11
          bitmap.LoadFromStream(strm);
          image1.Picture.Graphic := bitmap;
        finally
          bitmap.Free;
        end; //end try11

      end //end begin11

    else if adotable1.fieldbyname('isbmp').asstring ='0' then //JPEG型图像数据
      begin //begin12

        jpegimage := tjpegimage.Create ;

        try //try12
          jpegimage.LoadFromStream(strm);
          image1.Picture.Graphic := jpegimage;
        finally
          jpegimage.Free ;
        end; //end try12

      end; //end begin12
  finally
    strm.Free ;
  end; //end try1

end;
//-----------------------------------------------------------------------------

procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  loginform.close;
end;

procedure TMainForm.FormCreate(Sender: TObject);
var filename:string;
begin

  BackStart;
  IfReadOnlyAndColor(true,clMedGray);
  filename:=ExtractFilePath(ParamStr(0)) + '\MDB\AddressBook.mdb';

  if ADOTable1.Active=true then
    ADOTable1.Close;

  if FileExists(filename) then
    begin
      ADOTable1.ConnectionString:='Provider=Microsoft.Jet.OLEDB.4.0;Data Source='
      +filename+';Persist Security Info=false;jet OLEDB:Database Password=02091;';

      ADOTable2.ConnectionString:='Provider=Microsoft.Jet.OLEDB.4.0;Data Source='
      +filename+';Persist Security Info=false;jet OLEDB:Database Password=02091;';

      ADOTable2.SQL.Clear;
      ADOTable2.SQL.Add('select * from RS');
      ADOTable2.Prepared;
      ADOTable2.Open;

      while not ADOTable2.Eof do
        begin
          CBRelationShip.Items.Append(ADOTable2.FieldValues['关系名']);
          ADOTable2.Next;
        end;

      if ADOTable1.Active=true then
        ADOTable1.Close;
        ADOTable1.SQL.Clear;
        ADOTable1.SQL.Add('select * from Msg');
        ADOTable1.Prepared;
        ADOTable1.Open;

      datashow;
      TotalRecord:=ADOTable1.RecordCount;
      RStotalRecord:=TotalRecord;
      SelectPhoto.Enabled:=false;
      PhotoSave.Enabled:=false;
      if RStotalRecord=0 then
        begin
          BtDelData.Enabled:=False;
          SaveNewData.Enabled:=false;
          BtModification.Enabled:=false;
          BtSaveModified.Enabled:=false;
        end
      else
        begin
          BtDelData.Enabled:=True;
          SaveNewData.Enabled:=false;
          BtModification.Enabled:=True;
          BtSaveModified.Enabled:=false;
        end
    end
  else
    begin
      ShowMessage('数据库文件找不到！系统自动退出');
      close;
    end;

  TreeViewList;


end;

procedure TMainForm.SelectPhotoClick(Sender: TObject);
begin
  if openpicturedialog1.Execute then
    image1.Picture.LoadFromFile(openpicturedialog1.FileName );
end;

procedure TMainForm.PhotoSaveClick(Sender: TObject);
var
  strm:tmemorystream;
  ext:string;
begin
  IfPhoto:=false;
  if image1.picture.Graphic <> nil then //避免image1中无图像保存出错
    begin
      ext:=extractfileext(openpicturedialog1.FileName ); //取出文件的扩展名