aboutunit.pas

Delphi编写的通讯录

      strm := tmemorystream.Create ;
      try
        image1.Picture.Graphic.SaveToStream(strm);
        adotable1.Edit ;
        strm.Position :=0;
        tblobfield(adotable1.FieldByName('照片')).LoadFromStream(strm);

        //如需直接由文件保存可采用如下注释行
        //TBlobField(adotable1.FieldByName('照片')).LoadFromFile(OpenPictureDialog1.FileName);
        //以下记录保存到数据库的图像格式

        if uppercase(ext) = '.BMP' then
          adotable1.FieldByName('isbmp').Value := 1 //BMP型图像数据
        else if (uppercase(ext) = '.JPG') OR ( uppercase(ext) = '.JPEG') Then
          adotable1.FieldByName('isbmp').Value := 0; //JPEG型图像数据

        adotable1.Post ;
        IfPhoto:=true;
      finally
        strm.Free ; //笔者发现如strm采用tblobstream类，程序运行到该语句会出现问题
      end;
    end;
end;
procedure TMainForm.AddNewRecordClick(Sender: TObject);
var Sel:integer;
begin
  Sel:=MessageBox(0,'要添加一条新记录吗？','Http://free.6to23.com/tender0801',
                  MB_YESNO+MB_ICONWARNING);

  if Sel=IDYES then
    begin
      AddNewRecord.Enabled:=false;
      SaveNewData.Enabled:=true;
      BtModification.Enabled:=false;
      BtSaveModified.Enabled:=false;
      BtDelData.Enabled:=false;
      SelectPhoto.Enabled:=true;
      PhotoSave.Enabled:=true;
      IfReadOnlyAndColor(false,clWindow);
      BackStart;
    end
  else
    begin
      AddNewRecord.Enabled:=true;
      SaveNewData.Enabled:=false;
      BtSaveModified.Enabled:=false;
      SelectPhoto.Enabled:=false;
      PhotoSave.Enabled:=false;
      BackStart;
      IfReadOnlyAndColor(true,clMedGray);
      dataShow;
      BtDelAndBtModified;
    end;

end;

procedure TMainForm.SaveNewDataClick(Sender: TObject);
var Sel:integer;
begin
  if (edtName.Text<>'') and (CBRelationShip.Text<>'') then
    begin
      Sel:=MessageBox(0,'要保存新记录吗？','Http://free.6to23.com/tender0801',
                      MB_YESNO+MB_ICONWARNING);
      if Sel=IDYES then
        begin
          ADOTable1.Append;
          DataSaveTo;
          PhotoSaveClick(nil);
          if IfPhoto=false then
            ADOTable1.Post;
          BtDelAndBtModified;
          AddNewRecordClick(nil);
          TotalRecord:=TotalRecord+1;
        end
      else
        begin
          BackStart;
          BtDelAndBtModified;
          AddNewRecordClick(nil);
        end;
    end
  else
    MessageBox(0,'名字，关系，不能为空','Http://free.6to23.com/tender0801',
                  MB_OK+MB_ICONWARNING);

end;


procedure TMainForm.DBGrid1DblClick(Sender: TObject);
begin
  datashow;
end;

procedure TMainForm.BtDelDataClick(Sender: TObject);
var Sel:Integer;
begin
  Sel:=MessageBox(0,'要删除当前记录吗？','Http://free.6to23.com/tender0801',
                  MB_YESNO+MB_ICONWARNING);

  if Sel=IDYES then
    begin
      ADOTable1.Delete;
      DBGrid1DblClick(nil);
      TotalRecord:=TotalRecord-1;
      RSTotalRecord:=RSTotalRecord-1;
    end;

  BtDelAndBtModified
end;

procedure TMainForm.BtModificationClick(Sender: TObject);
var Sel:Integer;
begin
  Sel:=MessageBox(0,'要修改当前记录吗？','Http://free.6to23.com/tender0801',
                  MB_YESNO+MB_ICONWARNING);
  if Sel=IDYES then
    begin
      AddNewRecord.Enabled:=false;
      SaveNewData.Enabled:=false;
      BtModification.Enabled:=false;
      BtSaveModified.Enabled:=true;
      BtDelData.Enabled:=false;
      SelectPhoto.Enabled:=true;
      PhotoSave.Enabled:=true;
      Datashow;
      IfReadOnlyAndColor(false,clWindow);
    end
  else
    begin
      AddNewRecord.Enabled:=true;
      SaveNewData.Enabled:=false;
      BtModification.Enabled:=true;
      BtSaveModified.Enabled:=false;
      BtDelData.Enabled:=true;
      SelectPhoto.Enabled:=false;
      PhotoSave.Enabled:=false;
      IfReadOnlyAndColor(true,clMedGray);
      BackStart;
      DBGrid1DblClick(nil);
    end;

end;


procedure TMainForm.BtSaveModifiedClick(Sender: TObject);
var Sel:Integer;
begin
  Sel:=MessageBox(0,'要保存修改的记录吗？','Http://free.6to23.com/tender0801',
                  MB_YESNO+MB_ICONWARNING);
  if Sel=IDYES then
    begin
      AddNewRecord.Enabled:=true;
      SaveNewData.Enabled:=false;
      BtModification.Enabled:=true;
      BtSaveModified.Enabled:=false;
      BtDelData.Enabled:=true;
      SelectPhoto.Enabled:=false;
      PhotoSave.Enabled:=false;
      ADOTable1.Edit;
      DataSaveTo;
      PhotoSaveClick(nil);

      if IfPhoto=false then
        ADOTable1.Post;

      IfReadOnlyAndColor(true,clMedGray);
    end
  else
    begin
      AddNewRecord.Enabled:=true;
      SaveNewData.Enabled:=false;
      BtModification.Enabled:=true;
      BtSaveModified.Enabled:=false;
      BtDelData.Enabled:=true;
      SelectPhoto.Enabled:=false;
      PhotoSave.Enabled:=false;
      IfReadOnlyAndColor(true,clMedGray);
      DBGrid1DblClick(nil);
    end;
end;


procedure TMainForm.BtPriorClick(Sender: TObject);
begin
  ADOTable1.Prior;
  DBGrid1DblClick(nil);
end;

procedure TMainForm.BtFirstClick(Sender: TObject);
begin
  ADOTable1.First;
  DBGrid1DblClick(nil);
end;

procedure TMainForm.BtNextClick(Sender: TObject);
begin
  adoTable1.Next;
  DBGrid1DblClick(nil);
end;

procedure TMainForm.BtLastClick(Sender: TObject);
begin
  adotable1.Last;
  DBGrid1DblClick(nil);
end;

procedure TMainForm.BTAddNewRelationClick(Sender: TObject);
var
  i:integer;
  s:string;
  b:boolean;
begin
  b:=true;
  s:=InputBox('通讯录', '请输入新的关系名：', '');

  for i:=0 to CBRelationShip.Items.Count-1 do
    begin
      if CBRelationShip.Items.Strings[i]=s then
        begin
          b:=false;
          showmessage('关系已经存在');
          break;
        end;
    end;

  if (b=true) and (s<>'')then
    begin
      CBRelationShip.Items.Append(s);
      if ADOTable2.Active=true then
        ADOTable2.Close;
      ADOTable2.SQL.Clear;
      ADOTable2.SQL.Add('select * from RS');
      ADOTable2.Prepared;
      ADOTable2.Open;
      ADOTable2.Append;
      ADOTable2.FieldByName('关系名').AsString:=s;
      ADOTable2.Post;
      TreeView1.Items.Add(nil,s);
    end;



end;

procedure TMainForm.Button1Click(Sender: TObject);
var
  s:string;
  i:integer;
  j:integer;
begin
  s:=InputBox('通讯录', '输入要删除的关系名：', '');

  for i:=0 to CBRelationShip.Items.Count-1 do
    begin
      if CBRelationShip.Items.Strings[i]=s then
        begin
          CBRelationShip.Items.Delete(i);
          if ADOTable2.Active=true then
            ADOTable2.Close;
          ADOTable2.SQL.Clear;
          ADOTable2.SQL.Add('select * from RS');
          ADOTable2.Prepared;
          ADOTable2.Open;

          for j:=0 to i-1 do
            begin
              ADOTable2.Next;
            end;
          ADOTable2.Delete;
          break;
        end;
    end;
   treeview1.Items.Clear;
   treeviewList;


end;

procedure TMainForm.FindMenuClick(Sender: TObject);
var s,s1:string;
begin
  s:=InputBox('通讯录', '输入要查找的方式：', '');

  s1:=InputBox('通讯录', '输入要查找的内容：', '');

  if (s<>'') and (s1<>'') and (s<>'生日') and (s='姓名') or (s='昵称') or (s='QQ')
      or (s='手机') or (s='家庭电话') then
    begin
      if ADOTable1.Active=true then
        ADOTable1.Close;
      ADOTable1.SQL.Clear;
      ADOTable1.SQL.Text:='select * from Msg where '+s+'='''+s1+'''';
      ADOTable1.Prepared;
      ADOTable1.Open;
      if ADOTable1.RecordCount=0 then
        showmessage('你所要查的记录不存在！');
    end
  else
    begin
      showmessage('查找方式不对！');
    end;


end;

procedure TMainForm.TreeView1DblClick(Sender: TObject);
var
  i:integer;
  s:string;
begin
  i:=treeView1.Selected.Index;
  s:=treeView1.Selected.Text;
  ADOTable1.Close;
  ADOTable1.SQL.Clear;
  if i=0 then
    ADOTable1.SQL.Add('select * from Msg')
  else
    begin
      s:='select * from Msg Where 关系='''+s+'''';
      ADOTable1.SQL.Add(s);
    end;
  ADOTable1.Prepared;
  ADOTable1.Open;
  RSTotalRecord:=AdoTable1.RecordCount;


    if (RSTotalRecord<>0) and (LoginForm.Edit1.Text='管理员') then
    begin
      BtDelData.Enabled:=true;
      BtModification.Enabled:=true;
    end
  else
    begin
      BtDelData.Enabled:=false;
      BtModification.Enabled:=false;
    end;
end;

procedure TMainForm.Timer1Timer(Sender: TObject);
begin
  Sbar.Panels.Items[1].Text:=IntToStr(totalRecord);
end;

procedure TMainForm.AddNewAccountClick(Sender: TObject);
begin
  AddAccountForm.Show;

end;

procedure TMainForm.ChangePurviewClick(Sender: TObject);
begin
  ChangePurViewFrorm.Show;
end;

procedure TMainForm.DelAccountClick(Sender: TObject);
begin
  DelAccountForm.Show;
end;

procedure TMainForm.ChangPwdClick(Sender: TObject);
begin
  ChangePwdForm.Show;
end;

procedure TMainForm.FormShow(Sender: TObject);
begin

  if trim(LoginForm.QLogin.FieldValues['Purview'])='管理员' then
    begin
      ChangePwdForm.DBGrid1.Visible:=true;
      ChangePwdForm.DBGrid1.Enabled:=true;
      AddNewAccount.Enabled:=true;
      ChangePurview.Enabled:=true;
      DelAccount.Enabled:=true;
      AddNewRecord.Enabled:=true;
      BtModification.Enabled:=true;
      BtDelData.Enabled:=true;
      BTAddNewRelation.Enabled:=true;
      Button1.Enabled:=true;

    end
  else
    begin
      AddNewRecord.Enabled:=false;
      BtModification.Enabled:=false;
      BtDelData.Enabled:=false;
      BTAddNewRelation.Enabled:=false;
      Button1.Enabled:=false;
      ChangePwdForm.DBGrid1.Visible:=false;
      ChangePwdForm.DBGrid1.Enabled:=false;
      AddNewAccount.Enabled:=false;
      ChangePurview.Enabled:=false;
      DelAccount.Enabled:=false;
    end;

  LoginForm.QLogin.Close;

end;

procedure TMainForm.E1Click(Sender: TObject);
begin
  close;
end;

procedure TMainForm.GoToWebClick(Sender: TObject);
begin
ShellExecute(Handle, 'open', pchar(edtWeb.Text), nil, nil, SW_SHOW);
end;

procedure TMainForm.SendEmialClick(Sender: TObject);
begin
ShellExecute(Handle, 'open', PChar('mailto:' + edtEmail.Text + '?subject='), nil, nil, SW_SHOW);
end;

procedure TMainForm.HelpClick(Sender: TObject);
var HelpFileName:string;
begin
  Helpfilename:=ExtractFilePath(ParamStr(0)) + '帮助.txt';
  if FileExists(Helpfilename) then
    ShellExecute(handle,'Open', '/帮助.txt', NIL,NIL,SW_SHOWNORMAL)
  else
    showmessage('帮助文件找不到！');
end;

procedure TMainForm.AboutMenuClick(Sender: TObject);
begin
  aboutform.Show;
end;

end.