⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 unitmain.pas

📁 1
💻 PAS
字号:
unit UnitMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, CoolTrayIcon, OleCtrls, AgentObjects_TLB, Menus,UnitSocketThread,
  WinSock,Registry;

const
  WM_GETFROMREMOTE = WM_USER + 30;
type
  pDataBuf=^DataBuf;
  DataBuf=record
      buf:array[0..1023] of char;
      Next:pDataBuf;
      end;
  TMainForm = class(TForm)
    CoolTrayIcon1: TCoolTrayIcon;
    Agent1: TAgent;
    PopupMenu1: TPopupMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    Genie1: TMenuItem;
    Merlin1: TMenuItem;
    Peedy1: TMenuItem;
    Robby1: TMenuItem;
    N6: TMenuItem;
    IP1: TMenuItem;
    procedure CoolTrayIcon1Startup(Sender: TObject;
      var ShowMainForm: Boolean);
    procedure FormCreate(Sender: TObject);
    procedure Agent1DblClick(ASender: TObject;
      const CharacterID: WideString; Button, Shift, x, y: Smallint);
    procedure N1Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Genie1Click(Sender: TObject);
    procedure Merlin1Click(Sender: TObject);
    procedure Peedy1Click(Sender: TObject);
    procedure Robby1Click(Sender: TObject);
    procedure N3Click(Sender: TObject);
    procedure N6Click(Sender: TObject);
    procedure IP1Click(Sender: TObject);
    procedure Agent1Click(ASender: TObject; const CharacterID: WideString;
      Button, Shift, x, y: Smallint);
  private
    procedure WMGetFromRemote(var MyMessage:TMessage);message WM_GETFROMREMOTE;
    procedure InitAgent(name:string);
    procedure SendBuf(s:string);
    { Private declarations }
  public
    MyAgent:IagentCtlCharacterEx;
    CurrentAgentName:string;
    DesIP:TSockAddrIn;
    Transparent:integer;
    { Public declarations }
  end;

var
  MainForm: TMainForm;
  thread:SocketThread;
  pHeadData:pDataBuf;
  pRearData:pDataBuf;
implementation
uses
UnitTalk, UnitSetIP;
{$R *.dfm}

procedure TMainForm.CoolTrayIcon1Startup(Sender: TObject;
  var ShowMainForm: Boolean);
begin
ShowMainForm:=false;
end;

procedure TMainForm.FormCreate(Sender: TObject);
var
Screen:TScreen;
reg:TRegistry;
begin
reg:=TRegistry.Create;
reg.RootKey:=HKEY_LOCAL_MACHINE;
if reg.OpenKey('Software\DesktopChat',true) then
   begin
   if reg.ReadString('IP')='' then reg.WriteString('IP','127.0.0.1');
   if reg.ReadString('Port')='' then reg.WriteString('Port','5001');
   if reg.ReadString('Speech')='' then reg.WriteString('Speech','0');
   if reg.ReadString('Transparent')='' then reg.WriteString('Transparent','128');
   DesIP.sin_addr.S_addr:=inet_addr(pChar(reg.ReadString('IP')));
   DesIP.sin_port:=StrToInt(reg.ReadString('Port'));
   if reg.ReadString('Speech')='1' then N3.Checked:=true
      else N3.Checked:=false;
   Transparent:=StrToInt(reg.ReadString('Transparent'));
   end;
reg.CloseKey;
reg.Destroy;
//初始化监听线程
thread:=SocketThread.Create(true);
thread.Priority:=tpLower;
thread.Port:=DesIP.sin_port;
thread.Resume;
//初始化参数
if Peedy1.Checked=true then CurrentAgentName:='Peedy'
   else if Genie1.Checked=true then CurrentAgentName:='Genie'
      else if Merlin1.Checked=true then CurrentAgentName:='Merlin'
         else if Robby1.Checked=true then CurrentAgentName:='Robby';
self.InitAgent(CurrentAgentName);
//初始化数据队列
pHeadData:=nil;
pRearData:=nil;
end;

procedure TMainForm.Agent1DblClick(ASender: TObject;
  const CharacterID: WideString; Button, Shift, x, y: Smallint);
begin
FormTalk:=TFormTalk.Create(Application);
FormTalk.SetTransparent(Transparent);
FormTalk.ShowModal;
if FormTalk.flag=true then
   begin
   SendBuf(FormTalk.Memo1.Text);
   end;
end;

procedure TMainForm.N1Click(Sender: TObject);
begin
Self.Close;
end;

procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction);
var
p:pDataBuf;
begin
MyAgent.StopAll('Play');
MyAgent.StopAll('Speak');
Agent1.Characters.Unload(CurrentAgentName);
thread.Terminate;
while pHeadData<>nil do
   begin
   p:=pHeadData;
   pHeadData:=pHeadData.Next;
   FreeMem(p);
   end;
pRearData:=nil;
end;

procedure TMainForm.WMGetFromRemote(var MyMessage:TMessage);
var
s,sorg:string;
p:pChar;
pfree:pDataBuf;
len,i:integer;
addr:TSockAddrIn;
begin
pfree:=pHeadData;
pHeadData:=pHeadData.Next;
sorg:=Copy(string(pfree.buf),1,1024);
FreeMem(pfree);
p:=pChar(sorg);
len:=Length(sorg);
MyAgent.StopAll('Play');
if len<>0 then
   begin
   MyAgent.Play('Read');
   addr.sin_addr.S_addr:=MyMessage.WParam;
   MyAgent.Speak('From '+string(Inet_ntoa(addr.sin_addr))+':','');
   end;
i:=0;
s:='';
while i<=len do
   begin
   if (p^<>char($D)) and(p^<>'') then
      begin
      s:=s+p^;
      inc(p,1);
      i:=i+1;
      end
      else if (p^=char($D)) or (p^='') then
         begin
         if s<>'' then
            begin
            MyAgent.Speak(s,'');
            end;
         s:='';
         inc(p,2);
         i:=i+2;
         end
   end;
end;

procedure TMainForm.Genie1Click(Sender: TObject);
begin
Genie1.Checked:=true;
Agent1.Characters.Unload(CurrentAgentName);
InitAgent('Genie');
end;

procedure TMainForm.Merlin1Click(Sender: TObject);
begin
Merlin1.Checked:=true;
Agent1.Characters.Unload(CurrentAgentName);
InitAgent('Merlin');
end;

procedure TMainForm.Peedy1Click(Sender: TObject);
begin
Peedy1.Checked:=true;
Agent1.Characters.Unload(CurrentAgentName);
InitAgent('Peedy');
end;

procedure TMainForm.Robby1Click(Sender: TObject);
begin
Robby1.Checked:=true;
Agent1.Characters.Unload(CurrentAgentName);
InitAgent('Robby');
end;

procedure TMainForm.InitAgent(name:string);
var
dir:array[0..1023] of char;
begin
CurrentAgentName:=name;
GetCurrentDirectory(1024,dir);
//载入助手
Agent1.Characters.Load(name,string(dir)+'\'+name+'.acs');
MyAgent:=Agent1.Characters.Character(name);
MyAgent.AutoPopupMenu:=true;
MyAgent.IdleOn:=true;
if N3.Checked=true then
   MyAgent.LanguageID:=$0409;//设定英语发音
MyAgent.Left:=Screen.Width-200;
MyAgent.Top:=100;
MyAgent.Show(0);
MyAgent.SoundEffectsOn:=true;
MyAgent.AutoPopupMenu:=false;
MyAgent.Balloon.FontSize:=10;
MyAgent.Balloon.FontName:='宋体';
MyAgent.Balloon.Style:=(MyAgent.Balloon.Style and ($0000FFF0)) or ($0A1E0005);
MyAgent.Speak('My Name is '+name,'');
end;

procedure TMainForm.N3Click(Sender: TObject);
var
reg:TRegistry;
begin
if N3.Checked=true then MyAgent.LanguageID:=$0409
   else MyAgent.LanguageID:=$0407;
reg:=TRegistry.Create;
reg.RootKey:=HKEY_LOCAL_MACHINE;
if reg.OpenKey('Software\DesktopChat',true) then
   begin
   if N3.Checked=true then reg.WriteString('Speech','1')
      else reg.WriteString('Speech','0');
   end;
reg.CloseKey;
end;

procedure TMainForm.N6Click(Sender: TObject);
begin
FormTalk:=TFormTalk.Create(Application);
FormTalk.SetTransparent(Transparent);
FormTalk.ShowModal;
if FormTalk.flag=true then
   begin
   SendBuf(FormTalk.Memo1.Text);
   end;
end;

procedure TMainForm.IP1Click(Sender: TObject);
var
reg:TRegistry;
begin
FormSetIP:=TFormSetIP.Create(Application);
FormSetIP.Edit2.Text:=IntToStr(DesIP.sin_port);
FormSetIP.Edit1.Text:=inet_ntoa(DesIP.sin_addr);
FormSetIP.TrackBar1.Position:=TransParent;
FormSetIP.ShowModal;
if FormSetIP.GetFlag=true then
   begin
   DesIP.sin_port:=StrtoInt(FormSetIP.Edit2.Text);
   DesIP.sin_addr.S_addr:=Inet_addr(pChar(FormSetIP.Edit1.Text));
   TransParent:=FormSetIP.TrackBar1.Position;
   reg:=TRegistry.Create;
   reg.RootKey:=HKEY_LOCAL_MACHINE;
   if reg.OpenKey('Software\DesktopChat',true) then
      begin
      reg.WriteString('IP',FormSetIP.Edit1.Text);
      reg.WriteString('Port',FormSetIP.Edit2.Text);
      reg.WriteString('Transparent',IntToStr(FormSetIP.TrackBar1.Position));
      end;
   reg.CloseKey;
   reg.Destroy;
   end;
end;

procedure TMainForm.Agent1Click(ASender: TObject;
  const CharacterID: WideString; Button, Shift, x, y: Smallint);
begin
if Button=2 then
   begin
   CoolTrayIcon1.PopupMenu.Popup(x,y);
   end;
end;

procedure TMainForm.SendBuf(s:string);
var
sock:TSocket;
addr:TSockAddr;
a:array[0..1023] of char;
begin
   sock:=Socket(AF_INET,SOCK_STREAM,IPPROTO_TCP);
   addr.sin_family:=AF_INET;
   addr.sin_port:=htons(DesIP.sin_port);
   addr.sin_addr.S_addr:=DesIP.sin_addr.S_addr;
   if connect(sock,addr,sizeof(addr))<>SOCKET_ERROR then
      begin
      StrpCopy(a,s);
      send(sock,a,1024,0);
      end
      else
         begin
         MyAgent.StopAll('Play');
         MyAgent.StopAll('Speak');
         MyAgent.Play('GetAttention');
         MyAgent.Speak('Sorry,I can''t tell the remote user!','');
         MyAgent.Speak('"'+copy(s,1,10)+'..."','');
         MyAgent.Speak(' ','');
         MyAgent.Speak(' ','');
         MyAgent.Speak(' ','');
         MyAgent.Play('GetAttentionReturn');
         end;
   closesocket(sock);
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -