Русская справка по Delphi 5
Мастерская Delphi программирования.
Главная Мастерская Архив Ссылки Отдых Для гостей  
Назад Секреты VCL Секреты API Секреты ActiveX      

unit main;

interface

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

type
  TForm1 = class(TForm)
    Agent1: TAgent;
    Panel1: TPanel;
    OpenDialog1: TOpenDialog;
    ToolBar1: TToolBar;
    StatusBar1: TStatusBar;
    ToolButton1: TToolButton;
    Memo1: TMemo;
    GroupBox1: TGroupBox;
    Button1: TButton;
    Edit1: TEdit;
    Edit2: TEdit;
    ListBox1: TListBox;
    GroupBox2: TGroupBox;
    ToolButton3: TToolButton;
    Label1: TLabel;
    Label2: TLabel;
    Button3: TButton;
    ToolButton4: TToolButton;
    procedure FormCreate(Sender: TObject);
    procedure ToolButton1Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure ListBox1Click(Sender: TObject);
    procedure Agent1Click(Sender: TObject; const CharacterID: WideString;
      Button, Shift, x, y: Smallint);
    procedure FormDestroy(Sender: TObject);
    procedure Agent1Command(Sender: TObject; const UserInput: IDispatch);
    procedure Edit1KeyPress(Sender: TObject; var Key: Char);
    procedure Edit2Click(Sender: TObject);
    procedure ToolButton3Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure ToolButton4Click(Sender: TObject);
  private
    { Private declarations }
   Req: IAgentCtlRequest;
   Character: IAgentCtlCharacterEx;
   AnimationNames: IAgentCtlAnimationNames;
   procedure AgentAnimationEnum;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

uses ActiveX;

procedure TForm1.FormCreate(Sender: TObject);
begin
 Agent1.Characters.Load('Char', 'merlin.acs');
 Character := Agent1.Characters.Character('Char') as IAgentCtlCharacterEx;
 AgentAnimationEnum;
 ToolButton1Click(Sender);
 Character.Commands.Add('Test', '&Test', 1, 1, True);
 Character.Commands.Add('Demo', '&Demo', 1, 1, True);

end;

procedure TForm1.ToolButton1Click(Sender: TObject);
var
 PanelPos : TPoint;
 Pos      : TPoint;
 X,Y      : Integer;
begin
 Character.Hide(100);
 PanelPos.x := Panel1.Left;
 PanelPos.Y := Panel1.Top;
 Pos := ClientToScreen(PanelPos);
 Memo1.Lines.Clear;
{ Показать опсиание персонажа }
 Memo1.Lines.Add(Character.Description);
 Memo1.Lines.Add('Version ' + Character.Get_Version);
{ задать координаты }
 X := Pos.X+Panel1.Width DIV 2  - Character.Width DIV 2;
 Y := Pos.y+Panel1.Height DIV 2 - Character.Height DIV 2;

 Character.Left := X;
 Character.Top  := Y;
 Req := Character.Show(0);


// Character.Commands.Add('Test', '&Test', 1, 1, True);
// Character.Commands.Add('Demo', '&Demo', 1, 1, True);
end;

procedure TForm1.Button1Click(Sender: TObject);
var X,Y: Integer;
begin
try
 X := StrToInt(Edit1.Text);
 Y := StrToInt(Edit2.Text);
 Character.MoveTo(X,Y,1);
except
 Toolbutton1click(nil);
end;
end;

procedure TForm1.AgentAnimationEnum;
var AEnum: IEnumVariant;
    Fetch: Cardinal;
    V: OleVariant;
begin
 AnimationNames := Character.AnimationNames;
 AEnum := AnimationNames.Enum as IEnumVariant;
 AEnum.Reset;
 ListBox1.Items.Clear;
Repeat
 AEnum.Next(1,V,Fetch);
  If VarToStr(V) <> EmptyStr Then
   ListBox1.Items.Add(V);
until Fetch=0;

end;

procedure TForm1.ListBox1Click(Sender: TObject);
begin
 ListBox1.Hint := ListBox1.Items[Listbox1.ItemIndex];
 Req := Character.Play(WideString(ListBox1.Items[Listbox1.ItemIndex]));
end;

procedure TForm1.Agent1Click(Sender: TObject;
  const CharacterID: WideString; Button, Shift, x, y: Smallint);
begin
try
 Character.Stop(Req);
finally
 Req := Character.Play('RestPose');
end;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
Agent1.Characters.Unload('Char');
end;

procedure TForm1.Agent1Command(Sender: TObject;
  const UserInput: IDispatch);
var
 Cmd : IAgentCtlUserInput;
begin
 Cmd := UserInput as IAgentCtlUserInput;
 If Cmd.Name = 'Test' Then
 begin
  Character.Speak('Вызвали команду Test','');
  req := Character.Play('Processing');
 end;
 If Cmd.Name = 'Demo' Then
 begin
  req := Character.Play('DoMagic1');
  Character.Speak('Вызвали команду Demo','');
  req := Character.Play('DoMagic2');
  Req := Character.Play('RestPose');
 end;
end;

procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
if not(Key in ['0'..'9']) then Key := #0;
end;

procedure TForm1.Edit2Click(Sender: TObject);
begin
 (Sender as Tedit).SelectAll;
end;

procedure TForm1.ToolButton3Click(Sender: TObject);
var
 PanelPos : TPoint;
 Pos      : TPoint;
 X,Y      : Integer;
begin
 PanelPos.x := Panel1.Left;
 PanelPos.Y := Panel1.Top;
 Pos := ClientToScreen(PanelPos);
 X := Pos.X+Panel1.Width DIV 2  - Character.Width DIV 2;
 Y := Pos.y+Panel1.Height DIV 2 - Character.Height DIV 2;
 Character.MoveTo(X,Y,1);
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
 Character.Play('Think');
 Character.Think('И что от меня хотят?');
end;

procedure TForm1.ToolButton4Click(Sender: TObject);
begin
 Character.Hide(0);
end;

end.

Главная Мастерская Архив Ссылки Отдых Для гостей  
Назад Секреты VCL Секреты API Секреты ActiveX      
Дизайн и программирование - Valler© ,2000,2001.
http://www.valler.narod.ru
Используются технологии uCoz