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

📄 addrbk_frm.pas

📁 siMail, siMail, siMail, siMail
💻 PAS
📖 第 1 页 / 共 3 页
字号:
    1: begin
      if obj.Emails.Count > 0 then begin
        CellText := obj.Emails.Emails[0].Email;
        for i := 1 to obj.Emails.Count - 1 do
          CellText := CellText + ', ' + obj.Emails.Emails[i].Email;
      end;
    end;
    2: CellText := obj.Work.CompanyName;
    end;
  end;
end;

procedure TfrmAddrBk.txtQuickFindEnter(Sender: TObject);
begin
  if txtQuickFind.Text = _('Quick find') then
    txtQuickFind.Text := '';
end;

procedure TfrmAddrBk.actContactEditUpdate(Sender: TObject);
begin
  if lstContacts.SelectedCount = 1 then
    actContactEdit.Enabled := True
  else
    actContactEdit.Enabled := False;
end;

procedure TfrmAddrBk.actContactEditExecute(Sender: TObject);
begin
  frmContact.ScheduleAsNew := False;
  frmContact.AddressBook := FSelectedAddressBook;
  frmContact.Person := PTreeContacts(lstContacts.GetNodeData(lstContacts.GetFirstSelected))^.obj;
  frmContact.ShowModal;

  //current address book's lstContacts needs only repaint routine
  lstContacts.Repaint;
  //update address book if necessary
  if FSelectedAddressBook = frmAddressBook.SelectedAddressBook then
    frmAddressBook.ReloadBook(rbmContactEdit);

end;

procedure TfrmAddrBk.lstContactsDblClick(Sender: TObject);
begin
  actContactEdit.Execute;
end;

procedure TfrmAddrBk.lstContactsGetPopupMenu(Sender: TBaseVirtualTree;
  Node: PVirtualNode; Column: TColumnIndex; const P: TPoint;
  var AskParent: Boolean; var PopupMenu: TPopupMenu);
begin
  if Node <> nil then
    PopupMenu := popList;
end;

procedure TfrmAddrBk.actSelectAllExecute(Sender: TObject);
begin
  lstContacts.SelectAll(False);
end;

procedure TfrmAddrBk.actSelectUnselectAllExecute(Sender: TObject);
var Node: PVirtualNode;
begin
  Node := lstContacts.GetFirstSelected;

  while (Node <> nil) do begin
    lstContacts.Selected[Node] := False;
    Node := lstContacts.GetNextSelected(Node);
  end;
end;

procedure TfrmAddrBk.actSelectInvertSelectionExecute(Sender: TObject);
var Node: PVirtualNode;
begin
  Node := lstContacts.GetFirst;

  while (Node <> nil) do begin
    lstContacts.Selected[Node] := not lstContacts.Selected[Node];
    Node := lstContacts.GetNext(Node);
  end;
end;

procedure TfrmAddrBk.actContactDeleteUpdate(Sender: TObject);
begin
  if lstContacts.SelectedCount > 0 then
    actContactDelete.Enabled := True
  else
    actContactDelete.Enabled := False;
end;

procedure TfrmAddrBk.actContactDeleteExecute(Sender: TObject);
var Node: PVirtualNode;
begin
  if MessageDlg(_('Are you sure you want to delete selected contacts?'),
     mtConfirmation, [mbYes, mbNo], 0) = mrYes then begin

    lstContacts.BeginUpdate;
    Node := lstContacts.GetFirstSelected;
    while (Node <> nil) do begin
      PTreeContacts(lstContacts.GetNodeData(Node))^.obj.Delete;
      lstContacts.DeleteNode(Node);
      Node := lstContacts.GetFirstSelected;
    end;
    lstContacts.EndUpdate;
    (FSelectedAddressBook.Collection as TAddressBooks).Dirty := True;

    //update address book if necessary
    if FSelectedAddressBook = frmAddressBook.SelectedAddressBook then
      frmAddressBook.ReloadBook(rbmFullReload);
  end;
end;

procedure TfrmAddrBk.lstContactsInitNode(Sender: TBaseVirtualTree;
  ParentNode, Node: PVirtualNode; var InitialStates: TVirtualNodeInitStates);
begin
  PTreeContacts((Sender as TVirtualStringTree).GetNodeData(Node))^.obj := FSelectedAddressBook.Persons.Persons[Node.Index];
end;

procedure TfrmAddrBk.ReloadBook(mode: TReloadBookMode);
begin
  case mode of
  rbmNewContact: lstContacts.RootNodeCount := FSelectedAddressBook.Persons.Count;
  rbmContactEdit: lstContacts.Repaint;
  else begin
    lstContacts.Clear;
    lstContacts.RootNodeCount := FSelectedAddressBook.Persons.Count;
  end
  end;
end;

procedure TfrmAddrBk.SaveAddressBook;
begin
  Screen.Cursor := crHourGlass;
  frmMailbox.Profile.AddressBook.Save;
  frmMailbox.PublicAddressBook.Save;
  Screen.Cursor := crDefault;
end;

procedure TfrmAddrBk.FormDestroy(Sender: TObject);
begin
  SaveAddressBook;
end;

procedure TfrmAddrBk.lstToDblClick(Sender: TObject);
begin
  (Sender as TListBox).Items.Delete((Sender as TListBox).ItemIndex);
end;

procedure TfrmAddrBk.trBooksPaintText(Sender: TBaseVirtualTree;
  const TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex;
  TextType: TVSTTextType);
begin
  //default e--mail is written in bold
  if PTreeAddrBk(Sender.GetNodeData(Node))^.default then
    TargetCanvas.Font.Style := TargetCanvas.Font.Style + [fsBold]
  else
    TargetCanvas.Font.Style := TargetCanvas.Font.Style - [fsBold];
end;

procedure TfrmAddrBk.trBooksCompareNodes(Sender: TBaseVirtualTree; Node1,
  Node2: PVirtualNode; Column: TColumnIndex; var Result: Integer);
var nd1, nd2: PTreeAddrBk;
begin
  nd1 := Sender.GetNodeData(Node1);
  nd2 := Sender.GetNodeData(Node2);

  if nd1.id = nd2.id then begin
    case nd1.id of
    abtPrivate, abtPublic: Result := CompareText(TAddressBook(nd1.obj).BookName,
        TAddressBook(nd2.obj).BookName);
    abtContact: Result := CompareText(frmAddressBook.GetFullName(TPerson(nd1.obj)),
        frmAddressBook.GetFullName(TPerson(nd2.obj)));
    abtEmail: Result := CompareText(TEmail(nd1.obj).Email, TEmail(nd2.obj).Email);
    end;
  end
  else
    Result := 0; //nodes are equal

end;

procedure TfrmAddrBk.FormConstrainedResize(Sender: TObject; var MinWidth,
  MinHeight, MaxWidth, MaxHeight: Integer);
begin
  MinWidth := 640;
  MinHeight := 480;

  if Mode = abkSelect then begin
    MaxWidth := MinWidth;
    MaxHeight := MinHeight;
  end;
end;

procedure TfrmAddrBk.cmdCancelClick(Sender: TObject);
begin
  FCancled := True;
  Self.Close;
end;

procedure TfrmAddrBk.lstToDragOver(Sender, Source: TObject; X, Y: Integer;
  State: TDragState; var Accept: Boolean);
begin
  if (Source = trBooks) and (Source <> Sender) and (Source is TListBox) then
    Accept := True;
end;

procedure TfrmAddrBk.trBooksDragAllowed(Sender: TBaseVirtualTree;
  Node: PVirtualNode; Column: TColumnIndex; var Allowed: Boolean);
begin
  case PTreeAddrBk(Sender.GetNodeData(Node))^.id of
  abtGroup, abtContact, abtEmail: Allowed := True;
  else Allowed := False;
  end;
end;

procedure TfrmAddrBk.lstToDragDrop(Sender, Source: TObject; X, Y: Integer);
var Node: PVirtualNode;
var nd: PTreeAddrBk;
var i: Integer;
begin
  if Source = trBooks then begin
    Node := trBooks.GetFirstSelected;
    while Node <> nil do begin
      nd := PTreeAddrBk(trBooks.GetNodeData(Node));
      //if node type is email then we need parent for frendly contact name
      if nd.id = abtEmail then begin
        (Sender as TListBox).Items.Add('"' + frmAddressBook.GetFullName(PTreeAddrBk(trBooks.GetNodeData(Node.Parent))^.obj)
          + '"' + ' <' + TEmail(nd.obj).Email + '>');
      end
      else if nd.id = abtContact then begin
        (Sender as TListBox).Items.Add('"' + frmAddressBook.GetFullName(TPerson(nd.obj)) 
        + '"' + ' <' + TPerson(nd.obj).Emails.Emails[0].Email + '>');
      end;
      Node := trBooks.GetNextSelected(Node);
    end;
  end
  else if Sender <> Source then begin
    //drag and drop between list boxes
    for i := (Source as TListBox).Items.Count - 1 downto 0 do begin
      if (Source as TListBox).Selected[i] then begin
        (Sender as TListBox).Items.Add((Source as TListBox).Items.Strings[i]);
        (Source as TListBox).Items.Delete(i);
      end;
  end;
  end;
end;

procedure TfrmAddrBk.imgTrashDragOver(Sender, Source: TObject; X, Y: Integer;
  State: TDragState; var Accept: Boolean);
begin
  if Source is TListBox then
    Accept := True;
end;

procedure TfrmAddrBk.imgTrashDragDrop(Sender, Source: TObject; X, Y: Integer);
var i: Integer;
begin
  if Source is TListBox then begin
    for i := (Source as TListBox).Items.Count - 1 downto 0 do begin
      if (Source as TListBox).Selected[i] then
        (Source as TListBox).Items.Delete(i);
    end;
  end;
end;

procedure TfrmAddrBk.pnlButtonsResize(Sender: TObject);
begin
  imgTrash.Left := pnlButtons.Width - (imgTrash.Width * 2);
end;

procedure TfrmAddrBk.cmdOKClick(Sender: TObject);
begin
  FCancled := False;
  Self.Close;
end;

procedure TfrmAddrBk.lstContactsDragAllowed(Sender: TBaseVirtualTree;
  Node: PVirtualNode; Column: TColumnIndex; var Allowed: Boolean);
begin
  Allowed := True;
end;

procedure TfrmAddrBk.trBooksDragOver(Sender: TBaseVirtualTree;
  Source: TObject; Shift: TShiftState; State: TDragState; Pt: TPoint;
  Mode: TDropMode; var Effect: Integer; var Accept: Boolean);
var nd: PTreeAddrBk;
var Node: PVirtualNode;
begin
  //if source is lstContacts and target is not current address book then allow drop
  if Source = lstContacts then begin
    Node := Sender.GetNodeAt(Pt.x, Pt.y);
    if Node = nil then
      Exit;

    nd := Sender.GetNodeData(Node);
    if ((nd.id = abtPublic) or (nd.id = abtPrivate) or (nd.id = abtGroup))
       and (nd.obj <> FSelectedAddressBook) then Accept := True;
  end;
end;

procedure TfrmAddrBk.trBooksDragDrop(Sender: TBaseVirtualTree;
  Source: TObject; DataObject: IDataObject; Formats: TFormatArray;
  Shift: TShiftState; Pt: TPoint; var Effect: Integer; Mode: TDropMode);
var nd: PTreeAddrBk;
var Node: PVirtualNode;
begin
  //if source is lstContacts and target is not current address book then allow drop
  if Source = lstContacts then begin
    Node := Sender.GetNodeAt(Pt.x, Pt.y);
    if Node = nil then
      Exit;

    nd := Sender.GetNodeData(Node);
   //move contacts from one addr bk to other
    if ((nd.id = abtPublic) or (nd.id = abtPrivate)) and
       (nd.obj <> FSelectedAddressBook) then begin

      moveContacts(TAddressBook(nd.obj));
    end;
  end;

end;

procedure TfrmAddrBk.moveContacts(destAddrBk: TAddressBook);
var i: Integer;
var msg: TMemoryStream;
var Node: PVirtualNode;
var nd: PTreeContacts;
var p: TPerson;
begin
  //move contact
  Node := lstContacts.GetFirstSelected;
  lstContacts.BeginUpdate;
  while (Node <> nil) do begin
    nd := lstContacts.GetNodeData(Node);
    p := destAddrBk.Persons.Add;
    p.Assign(nd.obj);
    nd.obj.Delete;
    lstContacts.DeleteNode(Node);
    Node := lstContacts.GetFirstSelected;
  end;
  (FSelectedAddressBook.Collection as TAddressBooks).Dirty := True;
  (destAddrBk.Collection as TAddressBooks).Dirty := True;
  lstContacts.EndUpdate;
  lstContacts.Repaint;

  if (FSelectedAddressBook = frmAddressBook.SelectedAddressBook) or
     (destAddrBk = frmAddressBook.SelectedAddressBook) then
    frmAddressBook.ReloadBook(rbmFullReload);

end;

procedure TfrmAddrBk.lstContactsHeaderClick(Sender: TVTHeader;
  Column: TColumnIndex; Button: TMouseButton; Shift: TShiftState; X,
  Y: Integer);
begin
  //if same column then just reverse sorting
  if Sender.SortColumn = Column then begin
    if Sender.SortDirection = sdAscending then
      Sender.SortDirection := sdDescending
    else Sender.SortDirection := sdAscending;
  end
  else Sender.SortColumn := Column;
end;

procedure TfrmAddrBk.FormResize(Sender: TObject);
begin
  sb.Panels[0].Size := sb.Width;
end;

procedure TfrmAddrBk.actFileSavePrivateExecute(Sender: TObject);
begin
  frmMailbox.Profile.AddressBook.Save;
end;

procedure TfrmAddrBk.actFileSavePublicExecute(Sender: TObject);
begin
  frmMailbox.PublicAddressBook.Save;
end;

procedure TfrmAddrBk.actToExecute(Sender: TObject);
begin
  lstToDragDrop(lstTo, trBooks, 10, 10);
end;

procedure TfrmAddrBk.actCCExecute(Sender: TObject);
begin
  lstToDragDrop(lstCC, trBooks, 10, 10);
end;

procedure TfrmAddrBk.actBCCExecute(Sender: TObject);
begin
  lstToDragDrop(lstBCC, trBooks, 10, 10);
end;

procedure TfrmAddrBk.trBooksDblClick(Sender: TObject);
begin
  if Mode = abkSelect then begin
    if (ssShift in KeyboardStateToShiftState) and (ssAlt in KeyboardStateToShiftState) then
     lstToDragDrop(lstBCC, trBooks, 10, 10)
    else if ssAlt in KeyboardStateToShiftState then
      lstToDragDrop(lstCC, trBooks, 10, 10)
    else
      lstToDragDrop(lstTo, trBooks, 10, 10);
  end;
end;

end.

⌨️ 快捷键说明

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