Chip 1999 January/Chip_1999-01_cd.bin/zkuste/delphi/QDB/VADDBOOK.ZIP/AB_Main.pas

Pascal/Delphi Source File | 1998-06-28 | 14.2 KB | 493 lines

{*****************************************************************************}
{                                                                             }
{                          Address Book Demo                                  }
{                                                                             }
{                     illustrating the use of the                             }
{                                                                             }
{            QDB v2.10 Visual Components for Delphi 1, 2, & 3                 }
{                                                                             }
{        Copyright (c) 1995, 1996, 1997, 1998, Robert R. Marsh, S.J.          }
{             & the British Province of the Society of Jesus                  }
{                                                                             }
{                                                                             }
{       You may use this demonstration application and modify it in           }
{       whatever way you choose. You may not, however, sell it for            }
{       profit unless the changes you have made are substantial (i.e.,        }
{       more than 50% new code), in which case I'd appreciate                 }
{       receiving a copy of your new work.                                    }
{                                                                             }
{       If you like Address Book and find yourself using it please            }
{       consider making a donation to your favorite charity.                  }
{                                                                             }
{    Users of Address Book must accept the following disclaimer of warranty:  }
{                                                                             }
{       Address Book is supplied as is. The author disclaims all warranties,  }
{       expressed or implied, including, without limitation, the              }
{       warranties of merchantability and of fitness for any purpose.         }
{       The author assumes no liability for damages, direct or                }
{       consequential, which may result from the use of Address Book.         }
{                                                                             }
{*****************************************************************************}

unit AB_Main;

interface

uses
{$IFDEF WIN32}Windows, {$ELSE}WinTypes, WinProcs, {$ENDIF}
  Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, QDBView, ExtCtrls, QDB, Buttons, Menus;

type
  TAB_Form = class(TForm)
    MainMenu: TMainMenu;
    FileMenu: TMenuItem;
    FileNewItem: TMenuItem;
    FileOpenItem: TMenuItem;
    FileCloseItem: TMenuItem;
    FileSaveItem: TMenuItem;
    N1: TMenuItem;
    FileExitItem: TMenuItem;
    SpeedBar: TPanel;
    FileOpenSButton: TSpeedButton;
    FileSaveSButton: TSpeedButton;
    FileExitSButton: TSpeedButton;
    FileNewSButton: TSpeedButton;
    FileCloseSButton: TSpeedButton;
    OpenDialog: TOpenDialog;
    SaveDialog: TSaveDialog;
    Panel1: TPanel;
    Label7: TLabel;
    KeyList: TListBox;
    FilterBox: TEdit;
    Label5: TLabel;
    StatusLine: TPanel;
    ButtonPanel: TPanel;
    Image: TImage;
    PostButton: TButton;
    InsertButton: TButton;
    AddressPanel: TPanel;
    Label1: TLabel;
    AddBox: TMemo;
    IsBusiness: TCheckBox;
    Label2: TLabel;
    HPhone: TEdit;
    Label3: TLabel;
    WPhone: TEdit;
    Label4: TLabel;
    FPhone: TEdit;
    Label6: TLabel;
    E_Mail: TEdit;
    Options1: TMenuItem;
    OptCaseItem: TMenuItem;
    OptCompressedItem: TMenuItem;
    OptEncryptedItem: TMenuItem;
    DeleteButton: TButton;
    N2: TMenuItem;
    ToolsMenu: TMenuItem;
    ToolsPackItem: TMenuItem;
    ToolsCompressItem: TMenuItem;
    ToolsExpandItem: TMenuItem;
    EditButton: TButton;
    CancelButton: TButton;
    Label8: TLabel;
    WebURL: TEdit;
    Label9: TLabel;
    OPhone: TEdit;
    Notes: TMemo;
    Label10: TLabel;
    Addresses: TQDBView;
    procedure FormCreate(Sender: TObject);
    procedure DisplayHint(Sender: TObject);
    procedure FileNew(Sender: TObject);
    procedure FileOpen(Sender: TObject);
    procedure FileSave(Sender: TObject);
    procedure FileClose(Sender: TObject);
    procedure FileExit(Sender: TObject);
    procedure PostButtonClick(Sender: TObject);
    procedure InsertButtonClick(Sender: TObject);
    procedure DeleteButtonClick(Sender: TObject);
    procedure KeyListClick(Sender: TObject);
    procedure OptCaseItemClick(Sender: TObject);
    procedure OptCompressedItemClick(Sender: TObject);
    procedure OptEncryptedItemClick(Sender: TObject);
    procedure AddressesDemandPassword(Sender: TObject; var Password: TPassword);
    procedure ToolsPackItemClick(Sender: TObject);
    procedure ToolsCompressItemClick(Sender: TObject);
    procedure ToolsExpandItemClick(Sender: TObject);
    procedure Options1Click(Sender: TObject);
    procedure AddressesWarnNoData(Sender: TObject);
    procedure AddressPanelKey(Sender: TObject; var key: TKey);
    procedure EditButtonClick(Sender: TObject);
    procedure CancelButtonClick(Sender: TObject);
    procedure AddressesFileAssigned(Sender: TObject);
    procedure FilterBoxChange(Sender: TObject);
  private
    procedure ActivateControls;
    procedure DeactivateControls;
    procedure UpdateAddressPanel;
    procedure UpdateControls;
  end;

var
  AB_Form: TAB_Form;

implementation

{$R *.DFM}

{ Utility routine to invert a name & put the surname first }
{ e.g. Robert R. Marsh, S.J. => Marsh, Robert R.           }
{ This is used by the AddressPanel OnKey event-handler.       }

function NameToKey(Name: string): string;

  { return first position of a char after position n }
  function PosCAfter(c: char; s: string; n: integer): integer;
  var
    i: integer;
  begin
    Result := 0;
    for i := n + 1 to Length(s) do
      if s[i] = c then
      begin
        Result := i;
        Break;
      end;
  end;

{$IFNDEF WIN32}
  procedure TrimLeft(var s: string);
  begin
    while s[1] = ' ' do Delete(s, 1, 1);
  end;

  procedure TrimRight(var s: string);
  begin
    while s[length(s)] = ' ' do delete(s, length(s), 1);
  end;
{$ENDIF}

var
  NewName: string;
  CommaPos: Byte;
  SpacePos: Byte;
  LastSpacePos: Byte;
begin
  NewName := Name;
  TrimLeft(NewName);
{ then remove anything after a comma, e.g. strip off the S.J.'s}
  CommaPos := PosCAfter(',', NewName, 0);
  if CommaPos <> 0 then
    NewName := Copy(NewName, 1, CommaPos - 1);
{ now strip off trailing spaces and see if anything is left }
  TrimRight(NewName);
  if Length(NewName) = 0 then
  begin
    Result := '';
    Exit;
  end;
{ finally, find the last space in the name and take it to delimit the surname }
  LastSpacePos := 1;
  SpacePos := 1;
  while SpacePos <> 0 do
  begin
    LastSpacePos := SpacePos;
    SpacePos := PosCAfter(' ', NewName, SpacePos);
  end;
{ then just invert the order }
  if LastSpacePos = 1 then
    Result := NewName
  else
    Result := Copy(NewName, LastSpacePos + 1, high(integer)) + ', ' + Copy(NewName, 1, LastSpacePos - 1);
end;

const
  BaseTitle = 'Address Book Demo';

procedure TAB_Form.FormCreate(Sender: TObject);
begin
  Application.OnHint := DisplayHint;
  AB_Form.Caption := BaseTitle;
  DeactivateControls;
end;

procedure TAB_Form.DisplayHint(Sender: TObject);
begin
  StatusLine.Caption := Application.Hint;
end;

procedure TAB_Form.FileNew(Sender: TObject);
var
  NewFileName: string;
begin
  if SaveDialog.Execute then
  begin
    NewFileName := SaveDialog.FileName;
    if FileExists(NewFileName) then
    begin
      Addresses.FileName := '';
      SysUtils.DeleteFile(NewFileName);
    end;
    Addresses.FileName := NewFileName;
    AB_Form.Caption := BaseTitle + ' - ' + ExtractFileName(Addresses.FileName);
    KeyList.Items.Clear;
    UpdateAddressPanel;
    ActivateControls;
  end;
end;

procedure TAB_Form.FileOpen(Sender: TObject);
begin
  if OpenDialog.Execute then
  begin
    Addresses.FileName := OpenDialog.FileName;
    OptCaseItem.Checked := Addresses.KeyCaseSensitive;
    Addresses.AssignKeyList(KeyList.Items);
    if KeyList.Items.Count > 0 then
    begin
      KeyList.ItemIndex := 0;
      UpdateAddressPanel;
    end;
    AB_Form.Caption := BaseTitle + ' - ' + ExtractFileName(Addresses.FileName);
    ActivateControls;
  end;
end;

procedure TAB_Form.FileSave(Sender: TObject);
begin
  if Addresses.Ready then Addresses.Save;
end;

procedure TAB_Form.FileClose(Sender: TObject);
begin
  if Addresses.Ready then
  begin
    Addresses.Save;
    Addresses.FileName := '';
    KeyList.Items.Clear;
    AB_Form.Caption := BaseTitle;
    DeactivateControls;
  end;
end;

procedure TAB_Form.FileExit(Sender: TObject);
begin
  if Addresses.Ready then
  begin
    Addresses.Save;
    Addresses.FileName := '';
  end;
  Close;
end;

procedure TAB_Form.ActivateControls;
begin
  PostButton.Enabled := true;
  CancelButton.Enabled := true;
  DeleteButton.Enabled := true;
  EditButton.Enabled := true;
  InsertButton.Enabled := true;
  UpdateControls;
  OptCaseItem.Enabled := true;
  OptCaseItem.Checked := Addresses.KeyCaseSensitive;
  OptEncryptedItem.Enabled := true;
end;

procedure TAB_Form.DeactivateControls;
begin
  PostButton.Enabled := false;
  CancelButton.Enabled := false;
  DeleteButton.Enabled := false;
  EditButton.Enabled := false;
  InsertButton.Enabled := false;
  OptCaseItem.Checked := false;
  OptCaseItem.Enabled := false;
  OptEncryptedItem.Enabled := false;
end;

procedure TAB_Form.UpdateControls;
begin
  InsertButton.Enabled := not Addresses.Editing;
  EditButton.Enabled := not Addresses.Editing;
  PostButton.Enabled := Addresses.Editing or Addresses.Inserting;
  DeleteButton.Enabled := (Addresses.Ready and (Addresses.Count > 0));
end;

procedure TAB_Form.UpdateAddressPanel;
var
  CurrentKey: TKey;
begin
{ Find which key is selected in the KeyList }
  if (KeyList.Items.Count > 0) and (KeyList.ItemIndex >= 0) then
    CurrentKey := KeyList.Items[KeyList.ItemIndex]
  else
    CurrentKey := '';
{ if the key is valid load the corresponding address }
  if Addresses.ExactMatch(CurrentKey) then
    Addresses.Refresh
  else
    Addresses.Clear;
end;

{ The QDBPanel.Post method needs this event handled to }
{ provide a key by which to store the panel item. Here }
{ we invert the name line of the address.              }

procedure TAB_Form.AddressPanelKey(Sender: TObject; var key: TKey);
begin
  if IsBusiness.Checked then
    key := AddBox.Lines[0]
  else
    key := NameToKey(AddBox.Lines[0]);
end;

procedure TAB_Form.AddressesDemandPassword(Sender: TObject;
  var Password: TPassword);
var
  NewPassword: string;
begin
  NewPassword := Password;
  if InputQuery('Addresses', 'Enter the password:', NewPassword) then
    Password := Copy(NewPassword, 1, SizeOf(TPassword))
  else
    Password := '';
end;

procedure TAB_Form.PostButtonClick(Sender: TObject);
begin
  Addresses.Post;
  UpdateControls;
  Addresses.AssignKeyList(KeyList.Items);
  KeyList.ItemIndex := KeyList.Items.IndexOf(Addresses.Key);
end;

procedure TAB_Form.InsertButtonClick(Sender: TObject);
begin
  Addresses.Insert;
  UpdateControls;
end;

procedure TAB_Form.CancelButtonClick(Sender: TObject);
begin
  Addresses.Cancel;
  UpdateControls;
end;

procedure TAB_Form.EditButtonClick(Sender: TObject);
begin
  Addresses.Edit;
  UpdateControls;
end;

procedure TAB_Form.DeleteButtonClick(Sender: TObject);
var
  ThisItem: integer;
  KeyToGo: string;
begin
  ThisItem := KeyList.ItemIndex;
  if ThisItem <> -1 then
  begin
    KeyToGo := KeyList.Items[ThisItem];
    if Addresses.ExactMatch(KeyToGo) then
    begin
      Addresses.Delete;
      UpdateControls;
      Addresses.AssignKeyList(KeyList.Items);
    end;
  end;
  if ThisItem >= KeyList.Items.Count then
  begin
    dec(ThisItem);
  end;
  KeyList.ItemIndex := ThisItem;
  UpdateAddressPanel;
end;

procedure TAB_Form.KeyListClick(Sender: TObject);
begin
  UpdateAddressPanel;
end;

procedure TAB_Form.OptCaseItemClick(Sender: TObject);
begin
  if Addresses.Ready then
  begin
    OptCaseItem.Checked := not OptCaseItem.Checked;
    Addresses.KeyCaseSensitive := OptCaseItem.Checked;
    Addresses.AssignKeyList(KeyList.Items);
  end;
end;

procedure TAB_Form.OptCompressedItemClick(Sender: TObject);
begin
  if Addresses.Ready then
  begin
    OptCompressedItem.Checked := not OptCompressedItem.Checked;
    Addresses.Compression := OptCaseItem.Checked;
  end;
end;

procedure TAB_Form.OptEncryptedItemClick(Sender: TObject);
var
  CurrentPassword: string;
begin
  CurrentPassword := Addresses.PassWord;
  CurrentPassword := InputBox('Addresses', 'Enter Password:', CurrentPassword);
  Addresses.PassWord := CurrentPassword;
end;

procedure TAB_Form.ToolsPackItemClick(Sender: TObject);
begin
  Addresses.Pack;
end;

procedure TAB_Form.ToolsCompressItemClick(Sender: TObject);
begin
  Addresses.Compress;
end;

procedure TAB_Form.ToolsExpandItemClick(Sender: TObject);
begin
  Addresses.Expand;
end;

procedure TAB_Form.Options1Click(Sender: TObject);
begin
  OptCompressedItem.Checked := Addresses.Compression;
end;

procedure TAB_Form.AddressesWarnNoData(Sender: TObject);
begin
{ This event-handler does nothing -- except suppress the }
{ exception which would occur in its absence.            }
{ Note that there has to be something here even if it's  }
{ only a comment.                                        }
end;

{ Whenever a new filename is set we check to see if it }
{ matches the panel's layout. An empty file gets       }
{ marked with the current layout.                      }

procedure TAB_Form.AddressesFileAssigned(Sender: TObject);
var
  NewFileName: string;
begin
  NewFileName := Addresses.FileName;
end;

procedure TAB_Form.FilterBoxChange(Sender: TObject);
begin
  try
    Addresses.Filter := FilterBox.Text;
    Addresses.AssignKeyList(KeyList.Items);
    UpdateAddressPanel;
  except
    ShowMessage('The filter expression is invalid');
  end;
end;

end.