⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 fcontact.pas

📁 siMail, siMail, siMail, siMail
💻 PAS
📖 第 1 页 / 共 2 页
字号:
      txtCustom1.Text := Personal.CustomField1;
      txtCustom2.Text := Personal.CustomField2;
      txtCustom3.Text := Personal.CustomField3;
      txtCustom4.Text := Personal.CustomField4;

      txtCustomLabel1.Text := Personal.CustomFieldLabel1;
      txtCustomLabel2.Text := Personal.CustomFieldLabel2;
      txtCustomLabel3.Text := Personal.CustomFieldLabel3;
      txtCustomLabel4.Text := Personal.CustomFieldLabel4;

      lstChat.Clear;
      for i :=0 to Personal.Chats.Count - 1 do begin
        with PTreeChat(lstChat.GetNodeData(lstChat.AddChild(nil)))^ do begin
          app := Personal.Chats.Chats[i].Application;
          id := Personal.Chats.Chats[i].ID;
        end;
      end;
      //work tab
      txtWorkCompany.Text := Work.CompanyName;
      txtWorkJobTitle.Text := Work.JobTitle;
      txtWorkDepartment.Text := Work.Department;
      txtWorkTelephone.Text := Work.Telephone;
      txtWorkExtension.Text := Work.Extension;
      txtWorkMobile.Text := Work.Mobile;
      txtWorkFax.Text := Work.Fax;
      txtWorkPager.Text := Work.Pager;
      txtWorkStreet.Lines.Text := Work.Street;
      txtWorkZIP.Text := Work.ZIP;
      txtWorkState.Text := Work.State;
      txtWorkCountry.Text := Work.Country;
      txtWorkHomepage.Text := Work.Homepage;

      //home tab
      txtHomeTelephone.Text := Home.Telephone;
      txtHomeExtension.Text := Home.Extension;
      txtHomeMobile.Text := Home.Mobile;
      txtHomeFax.Text := Home.Fax;
      txtHomePager.Text := Home.Pager;
      txtHomeStreet.Lines.Text := Home.Street;
      txtHomeZIP.Text := Home.ZIP;
      txtHomeState.Text := Home.State;
      txtHomeCountry.Text := Home.Country;
      txtHomeHomepage.Text := Home.Homepage;

      //notes tab
      txtNotes.Lines.Text := Notes;

    end;
  end;
end;

procedure TfrmContact.SavePerson;
var i: Integer;
var Node: PVirtualNode;
var cht: PTreeChat;
var uniqueFileName: String;
begin
  if FScheduleAsNew then begin
    FPerson := FAddressBook.Persons.Add;
  end;
  (FAddressBook.Collection as TAddressBooks).Dirty := True;
  with FPerson do begin
    //general tab
    Emails.Clear;
    for i := 0 to txtEmails.Lines.Count -1 do
      Emails.Add.Email := txtEmails.Lines[i];

    General.FirstName := Trim(txtFirstName.Text);
    General.MiddleName := Trim(txtMiddleName.Text);
    General.LastName := Trim(txtLastName.Text);
    General.NickName := Trim(txtNickname.Text);
    General.Gender := TGender(cmboxGender.ItemIndex);
    //image cleared?
    if deleteOldPicture then begin
      deleteOldPicture := False;
      if (General.PhotoName <> '') or (pictureFileName <> '') then begin
        DeleteFile((AddressBook.Collection as TAddressBooks).PicturesPath + General.PhotoName);
        General.PhotoName := '';
      end;
    end
    else if pictureFileName <> '' then begin //save file
      uniqueFileName := ExtractFileName(pictureFileName);
      //this should return unique file name
      uniqueFileName := General.FirstName + ' ' + General.MiddleName + ' ' + General.LastName +
        ' [' + IntToHex(GetTickCount,8) + '-' + IntToHex(Trunc(Random(MaxLongint)),8) + ']' +
        ExtractFileExt(uniqueFileName);
      uniqueFileName := TrimLeft(uniqueFileName);
      CopyFile(PChar(pictureFileName), PChar((AddressBook.Collection as TAddressBooks).PicturesPath +
        uniqueFileName), True);
      General.PhotoName := uniqueFileName;
    end;

    //personal tab
    if not dtBirthday.Checked then
      Personal.Birthday := 0
    else
      Personal.Birthday := dtBirthday.Date;

    if not dtAnniversary.Checked then
      Personal.Anniversary := 0
    else
      Personal.Anniversary := dtAnniversary.Date;

    Personal.CustomField1 := Trim(txtCustom1.Text);
    Personal.CustomField2 := Trim(txtCustom2.Text);
    Personal.CustomField3 := Trim(txtCustom3.Text);
    Personal.CustomField4 := Trim(txtCustom4.Text);

    Personal.CustomFieldLabel1 := Trim(txtCustomLabel1.Text);
    Personal.CustomFieldLabel2 := Trim(txtCustomLabel2.Text);
    Personal.CustomFieldLabel3 := Trim(txtCustomLabel3.Text);
    Personal.CustomFieldLabel4 := Trim(txtCustomLabel4.Text);
    //save chat IDs
    Personal.Chats.Clear;
    Node := lstChat.GetFirst;
    while (Node <> nil) do begin
      cht := PTreeChat(lstChat.GetNodeData(Node));
      Personal.Chats.Add(cht^.app, cht^.id);
      Node := lstChat.GetNext(Node);
    end;

    //work tab
    Work.CompanyName := Trim(txtWorkCompany.Text);
    Work.JobTitle := Trim(txtWorkJobTitle.Text);
    Work.Department := Trim(txtWorkDepartment.Text);
    Work.Telephone := Trim(txtWorkTelephone.Text);
    Work.Extension := Trim(txtWorkExtension.Text);
    Work.Mobile := Trim(txtWorkMobile.Text);
    Work.Fax := Trim(txtWorkFax.Text);
    Work.Pager := Trim(txtWorkPager.Text);
    Work.Street := Trim(txtWorkStreet.Lines.Text);
    Work.ZIP := Trim(txtWorkZIP.Text);
    Work.State := Trim(txtWorkState.Text);
    Work.Country := Trim(txtWorkCountry.Text);
    Work.Homepage := Trim(txtWorkHomepage.Text);

    //home tab
    Home.Telephone := Trim(txtHomeTelephone.Text);
    Home.Extension := Trim(txtHomeExtension.Text);
    Home.Mobile := Trim(txtHomeMobile.Text);
    Home.Fax := Trim(txtHomeFax.Text);
    Home.Pager := Trim(txtHomePager.Text);
    Home.Street := Trim(txtHomeStreet.Lines.Text);
    Home.ZIP := Trim(txtHomeZIP.Text);
    Home.State := Trim(txtHomeState.Text);
    Home.Country := Trim(txtHomeCountry.Text);
    Home.Homepage := Trim(txtHomeHomepage.Text);

    //notes tab
    Notes := Trim(txtNotes.Lines.Text);

  end;

  FScheduleAsNew := False;
end;

procedure TfrmContact.cmdOKClick(Sender: TObject);
begin
  //at least one must be entred
  if (Trim(txtFirstName.Text) = '') and (Trim(txtMiddleName.Text) = '') and
     (Trim(txtLastName.Text) = '') and (Trim(txtNickname.Text) = '') then begin
    MessageDlg(_('At least one of following fields shouldn''t be empty.' + #13#10 +
      'First Name, Middle Name, Last Name or Nick Name'), mtError, [mbOK], 0);
    Exit;
  end;
  //contact can not be without e-mail address
  emailListRemoveEmptyLines;
  if txtEmails.Lines.Count = 0 then begin
    MessageDlg(_('Please enter at least one of e-mail.'), mtError, [mbOK], 0);
    Exit;
  end;
  
  SavePerson;
  Self.Close;
end;

procedure TfrmContact.PageControl1Change(Sender: TObject);
begin
  if PageControl1.ActivePageIndex = 1 then begin //certificates
    emailListRemoveEmptyLines;
    cmboxEmail.Items.Assign(txtEmails.Lines);
  end;
end;

procedure TfrmContact.emailListRemoveEmptyLines;
var i: Integer;
begin
  for i := txtEmails.Lines.Count - 1 downto 0 do begin
    if txtEmails.Lines.Strings[i] = '' then
      txtEmails.Lines.Delete(i);
  end;
end;

procedure TfrmContact.actPersDeleteUpdate(Sender: TObject);
begin
  if lstChat.SelectedCount >= 1 then
    actPersDelete.Enabled := True
  else
    actPersDelete.Enabled := False;
end;

procedure TfrmContact.lstChatGetNodeDataSize(Sender: TBaseVirtualTree;
  var NodeDataSize: Integer);
begin
  NodeDataSize := sizeOf(TTreeChat);
end;

procedure TfrmContact.lstChatClick(Sender: TObject);
var Node: PVirtualNode;
var p: TPoint;
begin
  p := Mouse.CursorPos;
  p := lstChat.ScreenToClient(p);
  Node := lstChat.GetNodeAt(p.X, p.Y);
  if Node <> nil then
    lstChat.EditNode(Node, lstChat.FocusedColumn)
end;

procedure TfrmContact.lstChatCreateEditor(Sender: TBaseVirtualTree;
  Node: PVirtualNode; Column: TColumnIndex; out EditLink: IVTEditLink);
begin
  case Column of
    1: editorChat.LinkComboEditor(EditLink, PTreeChat(
        (Sender as TVirtualStringTree).GetNodeData(Node))^.app);
    2: editorChat.LinkEditor(EditLink, PTreeChat(
        (Sender as TVirtualStringTree).GetNodeData(Node))^.id);
  end;
end;

procedure TfrmContact.lstChatEditing(Sender: TBaseVirtualTree;
  Node: PVirtualNode; Column: TColumnIndex; var Allowed: Boolean);
begin
  if Column > 0 then
    Allowed := True
  else
    Allowed := False;
end;

procedure TfrmContact.lstChatEdited(Sender: TBaseVirtualTree;
  Node: PVirtualNode; Column: TColumnIndex);
begin
  case Column of
    1:
      PTreeChat((Sender as TVirtualStringTree).GetNodeData(Node))^.app := cmboxChatApp.Text;
    2:
      PTreeChat((Sender as TVirtualStringTree).GetNodeData(Node))^.id := txtChatId.Text;
  end;
end;

procedure TfrmContact.lstChatGetText(Sender: TBaseVirtualTree;
  Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
  var CellText: WideString);
begin
    //return each column's text
  with PTreeChat((Sender as TVirtualStringTree).GetNodeData(Node))^ do begin
    case Column of
      1:
        CellText := app;
      2:
        CellText := id;
    end;
  end;
end;

procedure TfrmContact.actPersNewExecute(Sender: TObject);
begin
  with PTreeChat(lstChat.GetNodeData(lstChat.AddChild(nil)))^ do begin
    app := '';
    id := '';
  end;
end;

procedure TfrmContact.actPersDeleteExecute(Sender: TObject);
begin
  if lstChat.SelectedCount = 0 then exit;

  lstChat.DeleteNode(lstChat.GetFirstSelected);
end;

procedure TfrmContact.lstChatAfterCellPaint(Sender: TBaseVirtualTree;
  TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; CellRect: TRect);
begin
  if Column <> 0 then exit;

    // Simulate a fixed column by filling the main column with an edge similar to that of TCustomGrid.
  with TargetCanvas do begin
    if toShowVertGridLines in lstChat.TreeOptions.PaintOptions then
      Inc(CellRect.Right);
    if toShowHorzGridLines in lstChat.TreeOptions.PaintOptions then
      Inc(CellRect.Bottom);

    DrawEdge(Handle, CellRect, BDR_RAISEDINNER, BF_RECT or BF_MIDDLE);
    if Node = Sender.FocusedNode then
      ilChat.Draw(TargetCanvas, CellRect.Left, CellRect.Top, 0);
  end;
end;

procedure TfrmContact.cmdPictureClick(Sender: TObject);
begin
  if diOpenPicture.Execute then begin
    pictureFileName := diOpenPicture.FileName;
    imgPerson.Bitmap.LoadFromFile(pictureFileName);
  end;
end;

procedure TfrmContact.lblClearPictureClick(Sender: TObject);
begin
  pictureFileName := '';
  deleteOldPicture := True;
  imgPerson.Bitmap := imgAuthor.Bitmap;
end;

procedure TfrmContact.FormCreate(Sender: TObject);
begin
  //form: Contact, control: &Gender:
  cmboxGender.Items.Text := _('Unspecified' + #13#10 +
                              'Male' + #13#10 +
                              'Female');

  //form: Contact, control: Chat applications
  cmboxChatApp.Items.Text := _('ICQ' + #13#10 +
                               'MSN' + #13#10 +
                               'Yahoo' + #13#10 +
                               'AIM' + #13#10 +
                               'Jabber');
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -