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

📄 addressbook.pas

📁 siMail, siMail, siMail, siMail
💻 PAS
📖 第 1 页 / 共 2 页
字号:
(*
# (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 + -