📄 addressbook.pas
字号:
(*
# (C) Copyright 2003
# Miha Vrhovnik, miha.vrhovnik@guest.arnes.si
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License as
# published by the Free Software Foundation; either version 2 of
# the License, or (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston,
# MA 02111-1307 USA
#
# The Initial Developer of the Original Code is Miha Vrhovnik (Slovenia).
# Portions created by Miha Vrhovnik are Copyright (c)2000-2003.
# All Rights Reserved.
#==============================================================================
# Contributor(s):
#==============================================================================
# History: see whats new.txt from distribution package
#==============================================================================
*)
unit addressBook;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, VirtualTrees, gnugettext, StdCtrls, ExtCtrls, GPanel, Menus,
ActnList, ImgList, addrBk, defFldrs, ComCtrls, ToolWin, StrUtils,
TB2Item, TBX, TB2Dock, TB2Toolbar, TB2ToolWindow;
type TReloadBookMode = (rbmNewContact, rbmContactEdit, rbmFullReload);
type
TfrmAddressBook = class(TForm)
trAddressBook: TVirtualStringTree;
ActionList1: TActionList;
actNewContact: TAction;
actOpenAddressBook: TAction;
actDisplayOneGroup: TAction;
actDisplayAllGroups: TAction;
actEditContact: TAction;
actSendMail: TAction;
actDeleteContact: TAction;
actPrivateAddressBook: TAction;
actPublicAddressBook: TAction;
actAddressBooks: TAction;
actSendMailTo: TAction;
actSendMailCc: TAction;
actSendMailBcc: TAction;
popAddr: TTBXPopupMenu;
Sendmail1: TTBXItem;
N3: TTBXSeparatorItem;
Newaddress1: TTBXItem;
Editcontact1: TTBXItem;
DeleteContact1: TTBXItem;
N2: TTBXSeparatorItem;
Openaddressbook1: TTBXItem;
Newaddress2: TTBXSeparatorItem;
Displayonegroup1: TTBXItem;
Displayallgroups1: TTBXItem;
N1: TTBXSeparatorItem;
mnuBooks: TTBXSubmenuItem;
mnuGroups: TTBXSubmenuItem;
TBXItem1: TTBXItem;
mnuPrivate: TTBXSubmenuItem;
mnuPublic: TTBXSubmenuItem;
dckTop: TTBXDock;
tbCompose: TTBXToolbar;
TBXItem4: TTBXItem;
TBXItem3: TTBXItem;
TBXItem2: TTBXItem;
dckBottom: TTBXDock;
TBXToolWindow1: TTBXToolWindow;
lblContacts: TLabel;
Label1: TLabel;
TBXToolbar1: TTBXToolbar;
cmdShowMenu: TTBXItem;
procedure FormCreate(Sender: TObject);
procedure lblContactsClick(Sender: TObject);
procedure actNewContactExecute(Sender: TObject);
procedure trAddressBookGetImageIndex(Sender: TBaseVirtualTree;
Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex;
var Ghosted: Boolean; var ImageIndex: Integer);
procedure trAddressBookGetNodeDataSize(Sender: TBaseVirtualTree;
var NodeDataSize: Integer);
procedure trAddressBookGetPopupMenu(Sender: TBaseVirtualTree;
Node: PVirtualNode; Column: TColumnIndex; const P: TPoint;
var AskParent: Boolean; var PopupMenu: TPopupMenu);
procedure trAddressBookInitNode(Sender: TBaseVirtualTree; ParentNode,
Node: PVirtualNode; var InitialStates: TVirtualNodeInitStates);
procedure trAddressBookInitChildren(Sender: TBaseVirtualTree;
Node: PVirtualNode; var ChildCount: Cardinal);
procedure trAddressBookGetText(Sender: TBaseVirtualTree;
Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
var CellText: WideString);
procedure actEditContactExecute(Sender: TObject);
procedure actEditContactUpdate(Sender: TObject);
procedure actDeleteContactExecute(Sender: TObject);
procedure trAddressBookDblClick(Sender: TObject);
procedure actOpenAddressBookExecute(Sender: TObject);
procedure actNewContactUpdate(Sender: TObject);
procedure actPublicAddressBookUpdate(Sender: TObject);
procedure actPrivateAddressBookUpdate(Sender: TObject);
procedure actAddressBooksUpdate(Sender: TObject);
procedure actAddressBooksExecute(Sender: TObject);
procedure actPublicAddressBookExecute(Sender: TObject);
procedure actPrivateAddressBookExecute(Sender: TObject);
procedure trAddressBookCompareNodes(Sender: TBaseVirtualTree; Node1,
Node2: PVirtualNode; Column: TColumnIndex; var Result: Integer);
procedure trAddressBookPaintText(Sender: TBaseVirtualTree;
const TargetCanvas: TCanvas; Node: PVirtualNode;
Column: TColumnIndex; TextType: TVSTTextType);
procedure actSendMailExecute(Sender: TObject);
procedure actSendMailToExecute(Sender: TObject);
procedure trAddressBookExit(Sender: TObject);
procedure tbComposeDockChanged(Sender: TObject);
procedure cmdShowMenuClick(Sender: TObject);
private
FSelectedAddressBook: TAddressBook;
procedure mnuBookClick(Sender: TObject);
{ Private declarations }
public
{ Public declarations }
procedure LoadUserSettings;
procedure LoadBook(id: Integer; privateBook: Boolean = True);
procedure Books2Menues;
procedure ReloadBook(mode: TReloadBookMode);
function GetFullName(pers: TPerson): String;
procedure DeleteBookFromMenu(bkIdx: Integer; privatBk: Boolean);
procedure AddBookToMenu(bkIdx: Integer; privatBk: Boolean);
procedure UpdateBookInMenu(bkIdx: Integer; privatBk: Boolean);
procedure ClearAddressBookMenues;
function actDeleteContactF: Boolean;
property SelectedAddressBook: TAddressBook read FSelectedAddressBook;
end;
var
frmAddressBook: TfrmAddressBook;
implementation
uses fContact, mailBox, addrBk_frm, account, maillist, dImages;
{$R *.dfm}
type TAddrType = (atGroup, atContact, atEmail);
//tree type data
type TTreeAddrBk = record
id: TAddrType;
obj: Pointer;
default: Boolean; //used only if id = atEmail
end;
type PTreeAddrBk = ^TTreeAddrBk;
const cMenuPrivateBook = -2;
const cMenuPublicBook = -1;
const cMenuPrivateGroup = -2;
const cMenuPublicGroup = -1;
procedure TfrmAddressBook.FormCreate(Sender: TObject);
begin
trAddressBook.Align := alClient;
end;
procedure TfrmAddressBook.lblContactsClick(Sender: TObject);
begin
popAddr.Popup(Mouse.CursorPos.X, Mouse.CursorPos.Y);
end;
procedure TfrmAddressBook.actNewContactExecute(Sender: TObject);
begin
frmContact.ScheduleAsNew := True;
frmContact.AddressBook := FSelectedAddressBook;
frmContact.ShowModal;
trAddressBook.RootNodeCount := FSelectedAddressBook.Persons.Count;
if FSelectedAddressBook = frmAddrBk.SelectedAddressBook then
frmAddrBk.ReloadBook(rbmNewContact);
end;
procedure TfrmAddressBook.LoadBook(id: Integer; privateBook: Boolean);
begin
if frmMailbox.Profile = nil then exit;
trAddressBook.Clear;
if id < 0 then begin
trAddressBook.Clear;
FSelectedAddressBook := nil;
lblContacts.Caption := '';
Label1.Visible := True;
Exit;
end;
Label1.Visible := False;
if privateBook then begin
FSelectedAddressBook := frmMailbox.Profile.AddressBook.AddressBooks[id];
lblContacts.Caption := FSelectedAddressBook.BookName + _(' - [Private]');
end
else begin
FSelectedAddressBook := frmMailbox.PublicAddressBook.AddressBooks[id];
lblContacts.Caption := FSelectedAddressBook.BookName + _(' - [Public]');
end;
trAddressBook.RootNodeCount := FSelectedAddressBook.Persons.Count;
end;
procedure TfrmAddressBook.trAddressBookGetImageIndex(
Sender: TBaseVirtualTree; Node: PVirtualNode; Kind: TVTImageKind;
Column: TColumnIndex; var Ghosted: Boolean; var ImageIndex: Integer);
begin
//return correct folder image
with PTreeAddrBk((Sender as TVirtualStringTree).GetNodeData(Node))^ do begin
if (Kind in [ikNormal, ikSelected]) then
ImageIndex := Integer(id) + 4;
end;
end;
procedure TfrmAddressBook.trAddressBookGetNodeDataSize(
Sender: TBaseVirtualTree; var NodeDataSize: Integer);
begin
NodeDataSize := sizeOf(TTreeAddrBk);
end;
procedure TfrmAddressBook.trAddressBookGetPopupMenu(
Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex;
const P: TPoint; var AskParent: Boolean; var PopupMenu: TPopupMenu);
begin
trAddressBook.SetFocus;
PopupMenu := popAddr;
end;
procedure TfrmAddressBook.trAddressBookInitNode(Sender: TBaseVirtualTree;
ParentNode, Node: PVirtualNode; var InitialStates: TVirtualNodeInitStates);
var nd: PTreeAddrBk;
var pers: TPerson;
begin
nd := PTreeAddrBk((Sender as TVirtualStringTree).GetNodeData(Node));
if ParentNode = nil then begin
nd.id := atContact;
nd.obj := FSelectedAddressBook.Persons.Persons[Node.Index];
if FSelectedAddressBook.Persons.Persons[Node.Index].Emails.Count > 0 then
InitialStates := [ivsHasChildren];
nd.default := False;
end
else begin
pers := PTreeAddrBk((Sender as TVirtualStringTree).GetNodeData(ParentNode)).obj;
if pers <> nil then begin
nd.id := atEmail;
nd.obj := pers.Emails.Emails[Node.Index];
if Node.Index = 0 then
nd.default := True
else
nd.default := False;
end;
end;
end;
procedure TfrmAddressBook.trAddressBookInitChildren(
Sender: TBaseVirtualTree; Node: PVirtualNode; var ChildCount: Cardinal);
var nd: PTreeAddrBk;
begin
nd:=PTreeAddrBk((Sender as TVirtualStringTree).GetNodeData(Node));
if nd.id = atContact then
ChildCount := TPerson(nd.obj).Emails.Count;
end;
procedure TfrmAddressBook.trAddressBookGetText(Sender: TBaseVirtualTree;
Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
var CellText: WideString);
begin
with PTreeAddrBk((Sender as TVirtualStringTree).GetNodeData(Node))^ do begin
case id of
atContact: begin
CellText := GetFullName(TPerson(obj));
end;
atEmail: begin
CellText := TEmail(obj).Email;
end
end;
end;
end;
procedure TfrmAddressBook.actEditContactExecute(Sender: TObject);
var nd: PTreeAddrBk;
var reinitParent: Boolean;
begin
nd := trAddressBook.GetNodeData(trAddressBook.GetFirstSelected);
if nd.id = atEmail then begin
nd := trAddressBook.GetNodeData(trAddressBook.GetFirstSelected.Parent);
reinitParent :=True;
end
else
reinitParent :=False;
frmContact.ScheduleAsNew := False;
frmContact.AddressBook := FSelectedAddressBook;
frmContact.Person := TPerson(nd^.obj);
frmContact.ShowModal;
if reinitParent then
trAddressBook.ReinitChildren(trAddressBook.GetFirstSelected.Parent, True)
else
trAddressBook.ReinitChildren(trAddressBook.GetFirstSelected, True);
trAddressBook.Repaint;
ReloadBook(rbmContactEdit);
//update address book if necessary
if FSelectedAddressBook = frmAddrBk.SelectedAddressBook then
frmAddrBk.ReloadBook(rbmContactEdit);
end;
procedure TfrmAddressBook.actEditContactUpdate(Sender: TObject);
begin
if trAddressBook.SelectedCount > 0 then
(Sender as TAction).Enabled := True
else
(Sender as TAction).Enabled := False;
end;
procedure TfrmAddressBook.actDeleteContactExecute(Sender: TObject);
begin
actDeleteContactF;
end;
function TfrmAddressBook.actDeleteContactF: Boolean;
var Node: PVirtualNode;
var nd: PTreeAddrBk;
begin
Result := False;
if MessageDlg(_('Are you sure you want to delete selected contacts?'),
mtConfirmation, [mbYes, mbNo], 0) = mrYes then begin
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -