{threadNotes}
Re:还是无聊，再发一个垃圾
全部代码program AutoSpeakInGame; uses
Forms,
MainFormUnit in 'MainFormUnit.pas' {Form1}; {$R *.res} begin
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end. unit MainFormUnit; interface uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls, ComCtrls, jpeg, XPMan; type
TForm1 = class(TForm)
MemoTalking: TMemo;
ButtonStart: TButton;
ButtonSave: TButton;
Image1: TImage;
StatusBar1: TStatusBar;
ButtonLoad: TButton;
ButtonClear: TButton;
Timer1: TTimer;
ButtonStop: TButton;
XPManifest1: TXPManifest;
procedure ButtonClearClick(Sender: TObject);
procedure ButtonSaveClick(Sender: TObject);
procedure ButtonLoadClick(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure ButtonStartClick(Sender: TObject);
procedure ButtonStopClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
private
{ Private declarations }
public
{ Public declarations }
end; var
Form1: TForm1; implementation {$R *.dfm} procedure TForm1.ButtonClearClick(Sender: TObject);
begin
MemoTalking.Clear;
end; procedure TForm1.ButtonSaveClick(Sender: TObject);
begin
MemoTalking.Lines.SaveToFile(ExtractFilePath(Application.ExeName) + '自动留言.txt');
end; procedure TForm1.ButtonLoadClick(Sender: TObject);
begin
if FileExists(ExtractFilePath(Application.ExeName) + '自动留言.txt') then
MemoTalking.Lines.LoadFromFile(ExtractFilePath(Application.ExeName) + '自动留言.txt')
else
ShowMessage('未找到保存在本机上的留言文件');
end;
//-----------------------------------------
// 得到大话2主窗口
function getDaHuaHWND : HWND;
var
XY2Handle: HWND;
szText: array[0..254] of char;
begin
Result := 0;
XY2Handle:= FindWindow(PChar('WSWINDOW'), nil);
if XY2Handle = 0 then exit
else
begin
GetWindowText(XY2Handle, @szText, 255);
if Trim(szText) = '大话西游 II 聊天窗口' then
XY2Handle := GetWindow(XY2Handle, GW_OWNER);
end;
Result := XY2Handle;
end;
//----------------------
// 发送键盘消息
procedure SendKey(const FightKey : Char; isMenu : Boolean = True);
begin
keybd_event(VK_MENU,mapvirtualkey(VK_MENU,0),keyeventf_keyup,GetMessageExtraInfo());
sleep(10);
if isMenu then
begin
keybd_event(VK_MENU,mapvirtualkey(VK_MENU,0),0,GetMessageExtraInfo());
sleep(10);
end;
keybd_event(Byte(FightKey),mapvirtualkey(Byte(FightKey),0),0,GetMessageExtraInfo());
sleep(10);
keybd_event(Byte(FightKey),mapvirtualkey(Byte(FightKey),0),keyeventf_keyup,GetMessageExtraInfo());
sleep(10);
keybd_event(VK_MENU,mapvirtualkey(VK_MENU,0),keyeventf_keyup,GetMessageExtraInfo());
Sleep(400 div 4);
end;
//--------------------------
// 在游戏里面留言
procedure SpeakInGame(Words : string);
var
i : integer;
myWord : word;
tmpInt : integer;
Xy2Handle : HWND;
begin
Xy2Handle := getDaHuaHWND;
SetForegroundWindow(Xy2Handle);
tmpInt := Length(Words);
i := 0;
repeat
if IsDBCSLeadByte(Byte(Words[i])) = True then //是否是中文前半部分
begin
myWord := Word(Words[i])
shl 8 + Word(Words[i + 1]);
Inc(i, 2)
end
else
begin
myWord := Word(Words[i]);
Inc(i, 1)
end;
SendMessage(Xy2Handle, WM_IME_CHAR, myWord, 0);
Until i > tmpInt;
SendKey(#13, False);
end; procedure TForm1.Timer1Timer(Sender: TObject);
begin
if Timer1.tag > MemoTalking.Lines.Count - 1 then
Timer1.tag := 0;
if MemoTalking.Lines.Count > 0 then
SpeakInGame(MemoTalking.Lines.Strings[Timer1.tag]);
Timer1.tag := Timer1.tag + 1;
end; procedure TForm1.ButtonStartClick(Sender: TObject);
begin
if MemoTalking.Lines.Count > 0 then
begin
SetForegroundWindow(getDaHuaHWND);
Timer1.Enabled := True;
end
else
ShowMessage('请先填写好需要的留言内容！');
end; procedure TForm1.ButtonStopClick(Sender: TObject);
begin
Timer1.Enabled := False;
end; procedure TForm1.FormCreate(Sender: TObject);
begin
if FileExists(ExtractFilePath(Application.ExeName) + '自动留言.txt') then
MemoTalking.Lines.LoadFromFile(ExtractFilePath(Application.ExeName) + '自动留言.txt');
end; procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button = Mbleft then
begin
ReleaseCapture;
SendMessage(Handle, WM_NCLBUTTONDOWN, HTCAPTION, 0);
end;
end; end.
| 
还是无聊，再发一个垃圾
本主题包含附件: 
