📄 addrbk_frm.pas
字号:
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 + -