📄 unitmain.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 + -