eddial.pas

利用TAPI实现对普通电话线路的控制。注意：需要使用支持TAPI的语音调制解调器。

{*******************************************************}
{ EdDial V 1.00 - 04 Jun 1996 (freeware)                }
{ Dial a phone number using the win'95 dialer           }
{                                                       }
{ Olivier DEVUE                                         }
{ [e-mail]                                        }
{                                                       }
{*******************************************************}

unit EdDial;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Buttons, Menus;

  function tapiRequestMakeCall(lpszDestAddress, lpszAppName, lpszCalledParty, lpszComment: LPCSTR): DWORD; stdcall;
  
  { =========================== TCustomEditAndBtn ============================}
type
  TCustomEditAndBtn = class(TWinControl)
  private
    { D閏larations private }
    FButtonEnabled : boolean;
    FButtonHint: string;
    FSpeedButton: TSpeedButton;
    FEdit: TEdit;

    FOnButtonClick: TNotifyEvent;
    FOnButtonMouseDown: TMouseEvent;
    FOnButtonMouseMove: TMouseMoveEvent;
    FOnButtonMouseUp: TMouseEvent;
    FOnEnter: TNotifyEvent;
    FOnChange: TNotifyEvent;
    FOnExit: TNotifyEvent;
    FOnClick: TNotifyEvent;
    FOnDblClick: TNotifyEvent;
    FOnDragDrop: TDragDropEvent;
    FOnDragOver: TDragOverEvent;
    FOnEndDrag: TEndDragEvent;
    FOnKeyDown: TKeyEvent;
    FOnKeyPress: TKeyPressEvent;
    FOnKeyUp: TKeyEvent;
    FOnMouseDown: TMouseEvent;
    FOnMouseMove: TMouseMoveEvent;
    FOnMouseUp: TMouseEvent;
    FOnStartDrag: TStartDragEvent;

    FButtonShortCut: TShortCut;

    function GetAutoSelect : boolean;
    procedure SetAutoSelect(b: boolean);

    function GetButtonCaption : String;
    procedure SetButtonCaption(s: String);

    procedure SetButtonEnabled(b: boolean);

    function GetGlyph: TBitmap;
    procedure SetGlyph(b: TBitmap);

    function GetButtonHint : String;
    procedure SetButtonHint(s: String);

    function GetNumGlyphs: TNumGlyphs;
    procedure SetNumGlyphs(n: TNumGlyphs);

    function GetButtonVisible : boolean;
    procedure SetButtonVisible(b : boolean);

    function GetCharCase: TEditCharCase;
    procedure SetCharCase(c: TEditCharCase);

    function GetColor: TColor;
    procedure SetColor(c: TColor);

    function GetCtl3d: boolean;
    procedure SetCtl3d(b: boolean);

    function GetDragCursor: TCursor;
    procedure SetDragCursor(c: TCursor);

    function GetDragMode: TDragMode;
    procedure SetDragMode(d: TDragMode);

    function GetFont: TFont;
    procedure SetFont(f: TFont);

    function GetHideSelection: boolean;
    procedure SetHideSelection(b: boolean);

    function GetMaxLength: integer;
    procedure SetMaxLength(i: integer);

    function GetOEMConvert: boolean;
    procedure SetOEMConvert(b: boolean);

    function GetParentColor: boolean;
    procedure SetParentColor(b: boolean);

    function GetParentCtl3D: boolean;
    procedure SetParentCtl3D(b: boolean);

    function GetParentFont: boolean;
    procedure SetParentFont(b: boolean);

    function GetParentShowHint: boolean;
    procedure SetParentShowHint(b: boolean);

    function GetPasswordChar: char;
    procedure SetPasswordChar(c: char);

    function GetReadOnly: boolean;
    procedure SetReadOnly(b: boolean);

    function GetShowHint: boolean;
    procedure SetShowHint(b: boolean);

    function GetTabStop: boolean;
    procedure SetTabStop(b: boolean);

    function GetText : String;
    procedure SetText(s: String);

  protected
    { D閏larations protected }
    property AutoSelect: boolean read GetAutoSelect write SetAutoSelect;
    property ButtonCaption: string read GetButtonCaption write SetButtonCaption;
    property ButtonEnabled: boolean read FButtonEnabled write SetButtonEnabled;
    property ButtonGlyph: TBitmap read GetGlyph write SetGlyph;
    property ButtonHint: string read GetButtonHint write SetButtonHint;
    property ButtonNumGlyphs: TNumGlyphs read GetNumGlyphs write SetNumGlyphs;
    property ButtonShortCut: TShortCut read FButtonShortCut write FButtonShortCut;
    property ButtonVisible: boolean read GetButtonVisible write SetButtonVisible;
    property CharCase: TEditCharCase read GetCharCase write SetCharCase;
    property Color: TColor read GetColor write SetColor;
    property Ctl3d: boolean read GetCtl3d write SetCtl3d;
    property DragCursor: TCursor read GetDragCursor write SetDragCursor;
    property DragMode: TDragMode read GetDragMode write SetDragMode;
    property Enabled;
    property Font: TFont read GetFont write SetFont;
    property HideSelection: boolean read GetHideSelection write SetHideSelection;
    property MaxLength: integer read GetMaxLength write SetMaxLength;
    property OEMConvert: boolean read GetOEMConvert write SetOEMConvert;
    property ParentColor: boolean read GetParentColor write SetParentColor;
    property ParentCtl3D: boolean read GetParentCtl3D write SetParentCtl3D;
    property ParentFont: boolean read GetParentFont write SetParentFont;
    property ParentShowHint: boolean read GetParentShowHint write SetParentShowHint;
    property PasswordChar: char read GetPasswordChar write SetPasswordChar;
    property PopupMenu;
    property ReadOnly: boolean read GetReadOnly write SetReadOnly;
    property ShowHint: boolean read GetShowHint write SetShowHint;
    property TabOrder;
    property TabStop: boolean read GetTabStop write SetTabStop;
    property Text: string read GetText write SetText;
    property Visible;

    procedure ButtonClick(Sender : TObject); virtual;
    procedure ButtonMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); virtual;
    procedure ButtonMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); virtual;
    procedure ButtonMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); virtual;
    procedure Change(Sender : TObject); virtual;
    procedure Click(Sender : TObject); virtual;
    procedure DblClick(Sender : TObject); virtual;
    procedure DragDrop(Sender, Source: TObject; X, Y: Integer); virtual;
    procedure DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); virtual;
    procedure EndDrag(Sender, Target: TObject; X, Y: Integer); virtual;
    procedure Enter(Sender : TObject); virtual;
    procedure Exit(Sender : TObject); virtual;
    procedure KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); virtual;
    procedure KeyPress(Sender: TObject; var Key: Char); virtual;
    procedure KeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); virtual;
    procedure MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); virtual;
    procedure MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); virtual;
    procedure MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); virtual;
    procedure StartDrag(Sender: TObject; var DragObject: TDragObject); virtual;

    property OnButtonClick: TNotifyEvent read FOnButtonClick write FOnButtonClick;
    property OnButtonMouseDown: TMouseEvent read FOnButtonMouseDown write FOnButtonMouseDown;
    property OnButtonMouseMove: TMouseMoveEvent read FOnButtonMouseMove write FOnButtonMouseMove;
    property OnButtonMouseUp: TMouseEvent read FOnButtonMouseUp write FOnButtonMouseUp;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
    property OnClick: TNotifyEvent read FOnClick write FOnClick;
    property OnDblClick: TNotifyEvent read FOnDblClick write FOnDblClick;
    property OnDragDrop: TDragDropEvent read FOnDragDrop write FOnDragDrop;
    property OnDragOver: TDragOverEvent read FOnDragOver write FOnDragOver;
    property OnEndDrag: TEndDragEvent read FOnEndDrag write FOnEndDrag;
    property OnEnter: TNotifyEvent read FOnEnter write FOnEnter;
    property OnExit: TNotifyEvent read FOnExit write FOnExit;
    property OnKeyDown: TKeyEvent read FOnKeyDown write FOnKeyDown;
    property OnKeyPress: TKeyPressEvent read FOnKeyPress write FOnKeyPress;
    property OnKeyUp: TKeyEvent read FOnKeyUp write FOnKeyUp;
    property OnMouseDown: TMouseEvent read FOnMouseDown write FOnMouseDown;
    property OnMouseMove: TMouseMoveEvent read FOnMouseMove write FOnMouseMove;
    property OnMouseUp: TMouseEvent read FOnMouseUp write FOnMouseUp;
    property OnStartDrag: TStartDragEvent read FOnStartDrag write FOnStartDrag;

    procedure WMSize( var Message: TWMSize ); message WM_SIZE;
  public
    { D閏larations public }
    constructor Create( AOwner: TComponent ); override;
    destructor Destroy; override;
    procedure SetName(const NewName: TComponentName); override;
  end;

  { ============================== TEditAndBtn ===============================}

  TEditAndBtn = class(TCustomEditAndBtn)
  published
    { D閏larations published }
    property AutoSelect;
    property ButtonCaption;
    property ButtonEnabled;
    property ButtonGlyph;
    property ButtonHint;
    property ButtonNumGlyphs;
    property ButtonShortCut;
    property ButtonVisible;
    property CharCase;
    property Color;
    property Ctl3d;
    property DragCursor;
    property DragMode;
    property Enabled;
    property Font;
    property HideSelection;
    property MaxLength;
    property OEMConvert;
    property ParentColor;
    property ParentCtl3D;
    property ParentFont;
    property ParentShowHint;
    property PasswordChar;
    property PopupMenu;
    property ReadOnly;
    property ShowHint;
    property TabOrder;
    property TabStop;
    property Text;
    property Visible;

    property OnButtonClick;
    property OnButtonMouseDown;
    property OnButtonMouseMove;
    property OnButtonMouseUp;
    property OnChange;
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnStartDrag;
  end;

  TEditAndDialBtnKind = (dkCustom, dkStandard);
  TBeforeDialEvent = procedure (Sender : TObject; var CalledParty: string) of object;

  { ============================= TEditAndDial ===============================}

  TEditAndDial = class(TCustomEditAndBtn)
  private
    { D閏larations private }
    FButtonKind: TEditAndDialBtnKind;
    FBeforeDial: TBeforeDialEvent;
    FCalledParty: array [0..255] of char;    

    function GetKind: TEditAndDialBtnKind;
    procedure SetKind(Value: TEditAndDialBtnKind);

    function GetGlyph: TBitmap;
    procedure SetGlyph(b: TBitmap);
  published
    { D閏larations published }
    property AutoSelect;
    property ButtonEnabled;
    property ButtonGlyphDial: TBitmap read GetGlyph write SetGlyph;
    property ButtonKind: TEditAndDialBtnKind read GetKind write SetKind;
    property ButtonHint;
    property ButtonNumGlyphs;
    property ButtonShortCut;
    property ButtonVisible;
    property CharCase;
    property Color;
    property Ctl3d;
    property DragCursor;
    property DragMode;
    property Enabled;
    property Font;
    property HideSelection;
    property MaxLength;
    property OEMConvert;
    property ParentColor;
    property ParentCtl3D;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ReadOnly;
    property ShowHint;
    property TabOrder;
    property TabStop;
    property Text;
    property Visible;

    property BeforeDial: TBeforeDialEvent read FBeforeDial write FBeforeDial;
    property OnButtonMouseDown;
    property OnButtonMouseMove;
    property OnButtonMouseUp;
    property OnChange;
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnStartDrag;
  protected
    { D閏larations protected }
    procedure LoadDialBitmap; virtual;
    procedure EvBeforeDial(Sender : TObject; var CalledParty: string); virtual;
  public
    { D閏larations public }
    constructor Create( AOwner: TComponent ); override;
    destructor Destroy; override;
    procedure ButtonClick(Sender : TObject); override;
  end;

procedure Register;

implementation

{$R EDDIAL}

function tapiRequestMakeCall; external 'TAPI32.DLL' name 'tapiRequestMakeCall';

constructor TCustomEditAndBtn.Create( AOwner: TComponent );
begin
  inherited Create(AOwner);

  Width:=121;

  FEdit := TEdit.Create(self);
  FEdit.Visible := true;
  FEdit.Parent := Self;
  FEdit.Text:=Self.name;
  FEdit.Refresh;

  FEdit.OnChange:=Change;
  FEdit.OnClick:=Click;
  FEdit.OnDblClick:=DblClick;
  FEdit.OnDragDrop:=DragDrop;
  FEdit.OnDragOver:=DragOver;
  FEdit.OnEndDrag:=EndDrag;
  FEdit.OnEnter:=Enter;
  FEdit.OnExit:=Exit;
  FEdit.OnKeyDown:=KeyDown;
  FEdit.OnKeyPress:=KeyPress;
  FEdit.OnKeyUp:=KeyUp;
  FEdit.OnMouseDown:=MouseDown;
  FEdit.OnMouseMove:=MouseMove;
  FEdit.OnMouseUp:=MouseUp;
  FEdit.OnStartDrag:=StartDrag;

  FSpeedButton := TSpeedButton.Create(self);
  FSpeedButton.Visible := true;
  FSpeedButton.Parent := self;

  FSpeedButton.Refresh;
  FSpeedButton.OnClick:=ButtonClick;
  FSpeedButton.OnMouseDown:=ButtonMouseDown;
  FSpeedButton.OnMouseMove:=ButtonMouseMove;
  FSpeedButton.OnMouseUp:=ButtonMouseUp;
  FButtonEnabled:=true;
end;

procedure TCustomEditAndBtn.Change(Sender : TObject);
begin
  if Assigned(FOnChange) then
    FOnChange(self);
end;

procedure TCustomEditAndBtn.Click(Sender : TObject);
begin
  if Assigned(FOnClick) then
    FOnClick(self);
end;

procedure TCustomEditAndBtn.DblClick(Sender : TObject);
begin
  if Assigned(FOnDblClick) then
    FOnDblClick(self);
end;

procedure TCustomEditAndBtn.DragDrop(Sender, Source: TObject; X, Y: Integer);
begin
  if Assigned(FOnDragDrop) then
    FOnDragDrop(self,Source,X,Y);
end;

procedure TCustomEditAndBtn.DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean);
begin
  if Assigned(FOnDragOver) then
    FOnDragOver(self,Source,X,Y,State,Accept);
end;

procedure TCustomEditAndBtn.EndDrag(Sender, Target: TObject; X, Y: Integer);
begin
  if Assigned(FOnEndDrag) then
    FOnEndDrag(self,Target,X,Y);
end;

procedure TCustomEditAndBtn.Enter(Sender : TObject);
begin
  if Assigned(FOnEnter) then
    FOnEnter(self);
end;

procedure TCustomEditAndBtn.Exit(Sender : TObject);
begin
  if Assigned(FOnExit) then
    FOnExit(self);
end;

procedure TCustomEditAndBtn.KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
var
  skShift: TShiftState;