mainform.pas

详细讲述如何用delphi进行com编程

unit MainForm;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ComCtrls, ExtCtrls, StdCtrls, OleCtrls, ActiveX, AgentObjects_TLB;

const
  WM_SHOWAGENT = WM_USER + 1;
  AGENT = 'genie';
  AGENTPATH = 'C:\WinNT\MSAgent\Chars\genie.acs';

  RequestCompleted = 0;
  RequestFailed = 1;
  RequestPending = 2;
  RequestInterrupted = 3;
  RequestInProgress = 4;

  NeverShown = 0;
  UserHidSpeech = 1;
  UserShowed = 2;
  ProgramHid = 3;
  ProgramShowed = 4;
  OtherProgramHid = 5;
  OtherProgramShowed = 6;
  UserHidMenu = 7;

  LeftButton = 1;
  RightButton = 2;
  MiddleButton = 4;

type
  TForm1 = class(TForm)
    Agent1: TAgent;
    grpAnimation: TGroupBox;
    cbAnimations: TComboBox;
    btnPlay: TButton;
    btnStopLast: TButton;
    grpMovement: TGroupBox;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    XPos: TEdit;
    YPos: TEdit;
    btnMove: TButton;
    btnGesture: TButton;
    Speed: TEdit;
    grpSpeech: TGroupBox;
    Memo1: TMemo;
    btnSpeak: TButton;
    grpSpecial: TGroupBox;
    btnHide: TButton;
    btnShow: TButton;
    btnStopAll: TButton;
    Bevel1: TBevel;
    StatusBar1: TStatusBar;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure btnPlayClick(Sender: TObject);
    procedure btnStopLastClick(Sender: TObject);
    procedure btnSpeakClick(Sender: TObject);
    procedure btnMoveClick(Sender: TObject);
    procedure btnGestureClick(Sender: TObject);
    procedure btnHideClick(Sender: TObject);
    procedure btnShowClick(Sender: TObject);
    procedure btnStopAllClick(Sender: TObject);
    procedure Agent1Bookmark(Sender: TObject; BookmarkID: Integer);
    procedure Agent1DblClick(Sender: TObject;
      const CharacterID: WideString; Button, Shift, x, y: Smallint);
    procedure Agent1DragComplete(Sender: TObject;
      const CharacterID: WideString; Button, Shift, x, y: Smallint);
    procedure Agent1HideShow(Sender: TObject; const CharacterID: WideString;
      Cause: Smallint);
  private
    { Private declarations }
    Character: IAgentCtlCharacterEx;
    FRequest: IAgentCtlRequest;
    procedure WaitFor(Request: IAgentCtlRequest);
    procedure WMShowAgent(var Message: TMessage); message WM_SHOWAGENT;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.WaitFor(Request: IAgentCtlRequest);
var
  Status: LongInt;
begin
  repeat
    Application.ProcessMessages;
    Status := Request.Get_Status;
  until (Status <> RequestPending) and (Status <> RequestInProgress);
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  Animations: IAgentCtlAnimationNames;
  Enum: IEnumVariant;
  V: OleVariant;
  Fetched: Cardinal;
begin
  Character := nil;
  FRequest := nil;

  Agent1.Connected := True;

  Agent1.Characters.Load(AGENT, AGENTPATH);
  Character := Agent1.Characters.Character(AGENT);

  Animations := Character.AnimationNames;
  Enum := Animations.Enum as IEnumVariant;
  while Enum.Next(1, V, Fetched) = S_OK do
    cbAnimations.Items.Add(V);

  cbAnimations.ItemIndex := 0;
end;

procedure TForm1.FormDestroy(Sender: TObject);
var
  Request: IAgentCtlRequest;
begin
  if Character <> nil then begin
    Character.StopAll('');

    Request := Character.Hide(False);
    WaitFor(Request);

    Agent1.Characters.Unload(AGENT);
  end;

  Agent1.Connected := False;
end;

procedure TForm1.WMShowAgent(var Message: TMessage);
var
  pt: TPoint;
begin
  pt.x := Bevel1.Left;
  pt.y := Bevel1.Top;
  pt := ClientToScreen(pt);
  Character.MoveTo(pt.x, pt.y, 0);

  Character.Show(False);
  Character.Play('Announce');
  Character.Speak('Hello.  I am an agent.', '');
  Character.Play('RestPose');
end;

procedure TForm1.FormShow(Sender: TObject);
begin
  PostMessage(Handle, WM_SHOWAGENT, 0, 0);
end;

// Animation

procedure TForm1.btnPlayClick(Sender: TObject);
var
  Status: LongInt;
begin
  // If we're already playing something, stop it
  if FRequest <> nil then begin
    Status := FRequest.Get_Status;
    if (Status = 2) or (Status = 4) then
      Character.Stop(FRequest);
  end;

  FRequest := Character.Play(cbAnimations.Text);
end;

procedure TForm1.btnStopLastClick(Sender: TObject);
begin
  if FRequest <> nil then
    Character.Stop(FRequest);
end;

// Speech

procedure TForm1.btnSpeakClick(Sender: TObject);
begin
  Character.Speak(Memo1.Text, '');
end;

// Movement

procedure TForm1.btnMoveClick(Sender: TObject);
begin
  Character.MoveTo(StrToInt(XPos.Text), StrToInt(YPos.Text), StrToInt(Speed.Text));
end;

procedure TForm1.btnGestureClick(Sender: TObject);
begin
  Character.GestureAt(StrToInt(XPos.Text), StrToInt(YPos.Text));
end;

// Special

procedure TForm1.btnHideClick(Sender: TObject);
begin
  Character.Hide(False);
end;

procedure TForm1.btnShowClick(Sender: TObject);
begin
  Character.Show(False);
end;

procedure TForm1.btnStopAllClick(Sender: TObject);
begin
  Character.StopAll('');
end;

// Event handlers

procedure TForm1.Agent1Bookmark(Sender: TObject; BookmarkID: Integer);
begin
  StatusBar1.SimpleText := 'Triggered bookmark ' + IntToStr(BookmarkID);
end;

procedure TForm1.Agent1DblClick(Sender: TObject;
  const CharacterID: WideString; Button, Shift, x, y: Smallint);
begin
  if Button = LeftButton then
    StatusBar1.SimpleText := 'The user double-clicked on ' + CharacterID;
end;

procedure TForm1.Agent1DragComplete(Sender: TObject;
  const CharacterID: WideString; Button, Shift, x, y: Smallint);
begin
  StatusBar1.SimpleText := Format('The user moved %s to %d, %d', [CharacterID, x, y]);
end;

procedure TForm1.Agent1HideShow(Sender: TObject; const CharacterID: WideString;
  Cause: Smallint);
begin
  case Cause of
    NeverShown:
      StatusBar1.SimpleText := 'Nobody ever showed ' + CharacterID;
    UserHidSpeech:
      StatusBar1.SimpleText := 'The user hid ' + CharacterID + ' via spoken command';
    UserShowed:
      StatusBar1.SimpleText := 'The user showed ' + CharacterID;
    ProgramHid:
      StatusBar1.SimpleText := 'The program hid ' + CharacterID;
    ProgramShowed:
      StatusBar1.SimpleText := 'The program showed ' + CharacterID;
    OtherProgramHid:
      StatusBar1.SimpleText := 'Another program hid ' + CharacterID;
    OtherProgramShowed:
      StatusBar1.SimpleText := 'Another program showed ' + CharacterID;
    UserHidMenu:
      StatusBar1.SimpleText := 'The user hid ' + CharacterID + ' via menu';
    else
      StatusBar1.SimpleText := 'Unknown show/hide status for ' + CharacterID;
  end;
end;

end.