{
 -------------------------------------------------------------------------
 Copyright (C) 1998-2003 Häger+Busch                   / >>>>>>>>> /-----
 Ingenieurbuero fuer Kommunikationslösungen           / <<<<<<<<< /
 ----------------------------------------------------/ >>>>>>>>> /
 All rights reserved.
                                                    http://www.commso.com

 Project     : hbTapi Components
 Modul       : Sample Transfer

 Description : This sample shows how to transfer a call to another party
               and how to build a conference call.

 History     : [-] Fixed [+] Added [*] Improved

 01/01/03   Creation
}
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, hbTAPI, hbTapiUtils, Tapi, ComCtrls;

type
  TForm1 = class(TForm)
    TapiLine1: TTapiLine;
    GroupBox1: TGroupBox;
    ComboBoxDevice: TComboBox;
    CheckBoxActive: TCheckBox;
    Label1: TLabel;
    GroupBox2: TGroupBox;
    ButtonDrop: TButton;
    ButtonHoldUnhold: TButton;
    ButtonTransferSwapHold: TButton;
    Label7: TLabel;
    EditCallPhoneNumber: TEdit;
    LabelAddressPrimary: TLabel;
    EditCallParameterAddress: TEdit;
    ButtonDial: TButton;
    ButtonTransfer: TButton;
    Button4: TButton;
    ButtonTransferDial: TButton;
    ButtonSetupConf: TButton;
    Button2: TButton;
    ButtonTransferDialConf: TButton;
    ButtonTransferDialTransfer: TButton;
    ButtonSetupConfDial: TButton;
    ButtonSetupConfDialconf: TButton;
    ListView1: TListView;
    ButtonAnswer: TButton;
    procedure CheckBoxActiveClick(Sender: TObject);
    procedure ComboBoxDeviceChange(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure DoMakeCall(Sender: TObject);
    procedure DoSetupTransferAndDial(Sender: TObject);
    procedure DoSwapHold(Sender: TObject);
    procedure ButtonSetupConfClick(Sender: TObject);
    procedure TapiLine1CallState(Sender: TTapiLine; Call: TTapiCall;
      CallState: Cardinal);
    procedure TapiLine1CallDeallocate(Sender: TTapiLine; Call: TTapiCall);
    procedure TapiLine1NewCall(Sender: TTapiLine; Call: TTapiCall);
    procedure DoDropCall(Sender: TObject);
    procedure HoldUnholdCall(Sender: TObject);
    procedure DoDial(Sender: TObject);
    procedure DeSetupTransfer(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure DoTransferCall(Sender: TObject);
    procedure DoBuildConf(Sender: TObject);
    procedure DoSetupConf(Sender: TObject);
    procedure ButtonAnswerClick(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button11Click(Sender: TObject);
    procedure ButtonTransferDialConfClick(Sender: TObject);
    procedure TapiLine1Connected(Sender: TTapiLine; Call: TTapiCall);
    procedure ButtonTransferDialTransferClick(Sender: TObject);
    procedure DoSetupConferenceAndDial(Sender: TObject);
    procedure ButtonSetupConfDialconfClick(Sender: TObject);
    procedure TapiLine1MediaMode(Sender: TTapiLine; Call: TTapiCall);
    procedure TapiLine1TapiReinit(Sender: TObject);
    procedure TapiLine1DeviceRemove(Sender: TObject);
    procedure TapiLine1DeviceClose(Sender: TObject);
  private
    function GetCall: TTapiCall;
    procedure UpdateCalls;
  public
    { Public declarations }
  end;

var Form1:        TForm1;

implementation

{$R *.DFM}

procedure TForm1.CheckBoxActiveClick(Sender: TObject);
begin
  if not CheckBoxActive.Checked then
    begin
      if TapiLine1.Active then
        TapiLine1.Active := False
    end
  else
    begin
      if not TapiLine1.Active then
        TapiLine1.Active := True;
    end;
end;

procedure TForm1.ComboBoxDeviceChange(Sender: TObject);
begin
  if TapiLine1.Active then
  begin
    CheckBoxActive.Checked := False;
    TapiLine1.Active := FALSE;
  end;
  TapiLine1.DeviceID := ComboBoxDevice.ItemIndex;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  ComboBoxDevice.Items := TapiLine1.DeviceList;
  if ComboBoxDevice.Items.Count > 0 then
    ComboBoxDevice.Text := ComboBoxDevice.Items[0];
  ComboBoxDevice.ItemIndex := 0;
  ComboBoxDeviceChange(ComboBoxDevice);
end;

procedure TForm1.UpdateCalls;
var i: integer; li: TListItem; c: TTapiCall;
begin
  with TapiLine1 do
  begin
    if ListView1.Selected <> nil then
      c := TTapiCall(ListView1.Selected.Data)
    else
      c := nil;
    for i:= 0 to Calls.Count-1 do
    begin
      if i < ListView1.Items.Count then
        li := ListView1.Items[i]
      else
        li := ListView1.Items.Add;
      while li.SubItems.Count < 5 do
        li.SubItems.Add('');

      li.Caption     := Format('%8.8x',[Calls[i].Handle]);
      li.Data := Calls[i];
      if Calls[i].IsOutgoing then
        li.SubItems[0] := Calls[i].CalledID.Address
      else
        li.SubItems[0] := Calls[i].CallerID.Address;
      li.SubItems[1] := Calls[i].StateText;
      li.SubItems[3] := Calls[i].MediaModeText;
    end;
    while ListView1.Items.Count > Calls.Count do
      ListView1.Items[ListView1.Items.Count-1].Delete;
    for i := 0 to ListView1.Items.Count -1 do
    begin
      if ListView1.Items[i].Data = c then
      begin
        ListView1.Selected := ListView1.Items[i];
      end;
    end;
    if (ListView1.Selected = nil) and (ListView1.Items.Count > 0) then
      ListView1.Selected := ListView1.Items[0];
  end;
end;

function TForm1.GetCall: TTapiCall;
begin
  result := nil;
  if TapiLine1.Calls.Count > 0 then
  begin
    if ListView1.Selected <> nil then
      result := TTapiCall(ListView1.Selected.Data);
    if TapiLine1.Calls.IndexOf(result) = -1 then
      result := nil;
  end;
end;

procedure TForm1.DoMakeCall(Sender: TObject);
var cp: TTapiCallParams;
begin
  // here we use the TTapiCallParams object instead of TTapiLine.CallParams
  cp := TTapiCallParams.Create;
  try
    cp.AddressMode  := LINEADDRESSMODE_DIALABLEADDR;
    cp.OrigAddress  := 'Address 0';
    cp.MediaMode    := LINEMEDIAMODE_INTERACTIVEVOICE;
    cp.Flags        := 0;
    cp.TargetAddress:= '4711';
    TapiLine1.MakeCall(EditCallPhoneNumber.Text, 0, cp.TapiData);
  finally
    cp.Free;
  end;
end;

procedure TForm1.DoDial(Sender: TObject);
var c: TTapiCall;
begin
  c := GetCall;
  TapiLine1.CallParams.AddressID := StrToIntDef(EditCallParameterAddress.Text, 0);
  if c <> nil then
    c.Dial(EditCallPhoneNumber.Text);
end;

procedure TForm1.DoSetupTransferAndDial(Sender: TObject);
var c1, c2: TTapiCall;
begin
  c1 := GetCall;
  if c1 = nil then exit;

  TapiLine1.CallParams.AddressID := StrToIntDef(EditCallParameterAddress.Text, 0);
  try
    c2 := c1.SetupTransfer;
    c2.Dial(EditCallPhoneNumber.Text);
  except
    on ETapiError do
      MessageDlg('SetupTransfer failed!', mtError, [mbOK], 0);
  end;
end;

procedure TForm1.DoSwapHold(Sender: TObject);
var i: integer; c1, c2: TTapiCall;
begin
  c1:= GetCall;
  if c1 = nil then exit;
  c2:= nil;
  for i := 0 to TapiLine1.Calls.Count -1 do
  begin
    if (TapiLine1.Calls[i] <> c1) and
       ((c1.IsConnected and TapiLine1.Calls[i].IsHeld) or (c1.IsHeld and TapiLine1.Calls[i].IsConnected)) then
    begin
      c2 := TapiLine1.Calls[i];
    end;
  end;
  if (c2 <> nil) then
  begin
    if c1.IsConnected then
      c1.SwapHold(c2)
    else
      c2.SwapHold(c1);
  end;
end;

procedure TForm1.ButtonSetupConfClick(Sender: TObject);
var i: integer; c1, c2: TTapiCall;
begin
  c1:= GetCall;
  if (c1 = nil) or (not c1.IsHeld) then exit;
  c2:= nil;
  for i := 0 to TapiLine1.Calls.Count -1 do
  begin
    if (TapiLine1.Calls[i] <> c1) and (not TapiLine1.Calls[i].IsHeld) then
      c2 := TapiLine1.Calls[i];
  end;
  if (c2 <> nil) then
  begin
    c1.CompleteTransfer(c2, True);
  end;
end;


procedure TForm1.TapiLine1CallState(Sender: TTapiLine; Call: TTapiCall;
  CallState: Cardinal);
begin
  UpdateCalls;
end;

procedure TForm1.TapiLine1CallDeallocate(Sender: TTapiLine;
  Call: TTapiCall);
begin
  UpdateCalls;
end;

procedure TForm1.TapiLine1NewCall(Sender: TTapiLine; Call: TTapiCall);
begin
  UpdateCalls;
end;

procedure TForm1.DoDropCall(Sender: TObject);
var c: TTapiCall;
begin
  c := GetCall;
  if c = nil then exit;
  c.Drop;
end;

procedure TForm1.HoldUnholdCall(Sender: TObject);
var c: TTapiCall;
begin
  c := GetCall;
  if c = nil then exit;
  if c.IsHeld then
    c.Unhold
  else
    c.Hold;
end;

procedure TForm1.DeSetupTransfer(Sender: TObject);
var c1: TTapiCall;
begin
  c1 := GetCall;
  if c1 = nil then exit;
  TapiLine1.CallParams.AddressID := StrToIntDef(EditCallParameterAddress.Text, 0);
  try
    c1.SetupTransfer;
  except
    on ETapiError do
      MessageDlg('SetupTransfer failed!', mtError, [mbOK], 0);
  end;
end;

procedure TForm1.Button4Click(Sender: TObject);
var c1: TTapiCall;
begin
  c1 := GetCall;
  if c1 = nil then exit;
  TapiLine1.CallParams.AddressID := StrToIntDef(EditCallParameterAddress.Text, 0);

  try
    c1.Dial(EditCallPhoneNumber.Text);
  except
    on ETapiError do
      MessageDlg('Dial failed!', mtError, [mbOK], 0);
  end;
end;

procedure TForm1.DoTransferCall(Sender: TObject);
var i: integer; c1, c2: TTapiCall;
begin
  c1:= GetCall;
  if (c1 = nil) or (not c1.IsHeld) then exit;
  c2:= nil;
  for i := 0 to TapiLine1.Calls.Count -1 do
  begin
    if (TapiLine1.Calls[i] <> c1) and (not TapiLine1.Calls[i].IsHeld) then
      c2 := TapiLine1.Calls[i];
  end;
  if (c2 <> nil) then
  begin
    c1.CompleteTransfer(c2, False);
  end;
end;

procedure TForm1.DoBuildConf(Sender: TObject);
var i: integer; c1, c2: TTapiCall;
begin
  c1:= GetCall;
  if (c1 = nil) or (not c1.IsHeld) then exit;
  c2:= nil;
  for i := 0 to TapiLine1.Calls.Count -1 do
  begin
    if (TapiLine1.Calls[i] <> c1) and (not TapiLine1.Calls[i].IsHeld) then
      c2 := TapiLine1.Calls[i];
  end;
  if (c2 <> nil) then
  begin
    c1.CompleteTransfer(c2, True);
  end;
end;

procedure TForm1.DoSetupConf(Sender: TObject);
var c1, c2, c3: TTapiCall;
begin
  c1:= GetCall;
  if (c1 = nil) then exit;
  TapiLine1.CallParams.AddressID := StrToIntDef(EditCallParameterAddress.Text, 0);

  try
    c1.SetupConference(c2, c3);
  except
    on ETapiError do
      MessageDlg('SetupConference failed!', mtError, [mbOK], 0);
  end;
end;

procedure TForm1.ButtonAnswerClick(Sender: TObject);
var c: TTapiCall;
begin
  c := GetCall;
  if c = nil then exit;
  c.Answer;
end;

procedure TForm1.Button2Click(Sender: TObject);
var c: TTapiCall;
begin
  c := GetCall;
  if c = nil then exit;
  c.Owner := not c.Owner;
  UpdateCalls;
end;

procedure TForm1.Button11Click(Sender: TObject);
begin
  TapiLine1.Unpark(0, '0');
end;

procedure TForm1.ButtonTransferDialConfClick(Sender: TObject);
var c1, c2: TTapiCall;
begin
  c1 := GetCall;
  if c1 = nil then exit;

  TapiLine1.CallParams.AddressID := StrToIntDef(EditCallParameterAddress.Text, 0);

  try
    c2 := c1.SetupTransfer;
    c2.Dial(EditCallPhoneNumber.Text);
    c2.Notes['Action'] := 'Conference';
    c2.Notes['PrimaryCall'] := Format('%d', [Integer(c1)]);
  except
    on ETapiError do
      MessageDlg('SetupTransfer failed!', mtError, [mbOK], 0);
  end;
end;

procedure TForm1.TapiLine1Connected(Sender: TTapiLine; Call: TTapiCall);
var PrimaryCall, ConfCall: TTapiCall;
begin
  PrimaryCall := TTapiCall(StrToIntDef(Call.Notes['PrimaryCall'],0));
  ConfCall    := TTapiCall(StrToIntDef(Call.Notes['ConfCall'],0));
  Call.Notes['PrimaryCall'] := '';
  Call.Notes['ConfCall'] := '';
  if TapiLine1.Calls.IndexOf(PrimaryCall) = -1 then exit;
  if Call.Notes['Action'] = 'Conference' then
  begin
    PrimaryCall.CompleteTransfer(Call, True);
  end
  else if Call.Notes['Action'] = 'Transfer' then
  begin
    PrimaryCall.CompleteTransfer(Call, False);
  end
  else if Call.Notes['Action'] = 'BuildConference' then
  begin
    Call.AddToConference(ConfCall);
  end;
end;

procedure TForm1.ButtonTransferDialTransferClick(Sender: TObject);
var c1, c2: TTapiCall;
begin
  c1 := GetCall;
  if c1 = nil then exit;
  TapiLine1.CallParams.AddressID := StrToIntDef(EditCallParameterAddress.Text, 0);

  try
    c2 := c1.SetupTransfer;
    c2.Dial(EditCallPhoneNumber.Text);
    c2.Notes['Action'] := 'Transfer';
    c2.Notes['PrimaryCall'] := IntToStr(Integer(c1));
  except
    on ETapiError do
      MessageDlg('SetupTransfer failed!', mtError, [mbOK], 0);
  end;
end;

procedure TForm1.DoSetupConferenceAndDial(Sender: TObject);
var c1, c2, c3: TTapiCall;
begin
  c1:= GetCall;
  if (c1 = nil) then exit;
  TapiLine1.CallParams.AddressID := StrToIntDef(EditCallParameterAddress.Text, 0);

  try
    c1.SetupConference(c2, c3);
    c3.Dial(EditCallPhoneNumber.Text);
  except
    on ETapiError do
      MessageDlg('SetupConference failed!', mtError, [mbOK], 0);
  end;
end;

procedure TForm1.ButtonSetupConfDialconfClick(Sender: TObject);
var Call, ConfCall, ConsultCall: TTapiCall;
begin
  Call := GetCall;
  if (Call = nil) then exit;
  TapiLine1.CallParams.AddressID := StrToIntDef(EditCallParameterAddress.Text, 0);

  try
    Call.SetupConference(ConfCall, ConsultCall);
    ConsultCall.Dial(EditCallPhoneNumber.Text);
    ConsultCall.Notes['Action'] := 'BuildConference';
    ConsultCall.Notes['PrimaryCall'] := IntToStr(Integer(Call));
    ConsultCall.Notes['ConfCall'] := IntToStr(Integer(ConfCall));
  except
    on ETapiError do
      MessageDlg('SetupConference and Dial failed!', mtError, [mbOK], 0);
  end;
end;

procedure TForm1.TapiLine1MediaMode(Sender: TTapiLine; Call: TTapiCall);
begin
  MessageDlg('The Media Mode has changed!', mtInformation, [mbOK], 0);
end;

procedure TForm1.TapiLine1TapiReinit(Sender: TObject);
begin
  MessageDlg('You should restart the application!', mtWarning, [mbOK], 0);
end;

procedure TForm1.TapiLine1DeviceRemove(Sender: TObject);
begin
  MessageDlg('The line device has been removed!', mtWarning, [mbOK], 0);
  CheckBoxActive.Checked := False;
end;

procedure TForm1.TapiLine1DeviceClose(Sender: TObject);
begin
  MessageDlg('The line device has been closed!', mtWarning, [mbOK], 0);
  CheckBoxActive.Checked := False;
end;

end.


