麻子兄进来帮我看看为什么回调函数不起作用？ ( 积分: 100 )

http://www.delphibbs.com/delphibbs/dispq.asp?lid=3264346
原文在这里，根据上面修改SendKeyEx.pas如下：
unit SendKeyEx;

interface

uses Windows, Messages, SysUtils;

type
PSendPerCharCallback = ^TSendPerCharBackProc;
TSendPerCharBackproc = procedure (SndIndex: Integer);

function SendText(const S: string): Integer
overload;
function SendText(const S: string
TargetWindow: HWND): Integer
overload;
function SendText(const S: string
TargetControl: HWND;
CallBackProc: PSendPerCharCallback): Integer
overload;

implementation

function SendText(const S: string): Integer;
var
hWindow: HWND;
begin
hWindow := GetForegroundWindow()
// 当前窗口
if IsWindow(hWindow) then
Result := SendText(S, hWindow)
else
Result := -1;
end;

function SendText(const S: string
TargetWindow: HWND): Integer;
var
hControl: HWND;
ThreadID: DWord;
begin
ThreadID := GetWindowThreadProcessId(TargetWindow, nil)
// 窗口对应线程
AttachThreadInput(GetCurrentThreadId(), ThreadID, True)
// 共享输入队列
try
hControl := GetFocus
// 焦点控件
Result := SendText(S, hControl, nil);
finally
AttachThreadInput(GetCurrentThreadId(), ThreadID, False)
// 取消共享
end;
end;

function SendText(const S: string
TargetControl: HWND;
CallBackProc: PSendPerCharCallback): Integer;
begin
Result := 1;
while (Result <= Length(S)) do // 处理每个字符
begin
if (ByteType(S, Result) = mbSingleByte) then // 英文
SendMessage(TargetControl, WM_IME_CHAR, Integer(S[Result]), 0)
else
begin // 汉字
SendMessage(TargetControl, WM_IME_CHAR,
MakeWord(Byte(S[Result + 1]), Byte(S[Result])), 0);
Result := Result + 1;
end;
Result := Result + 1;
if CallBackProc <> nil then
begin
TSendPerCharBackProc(CallBackProc)(Result);
end;
end;
end;

调用代码如下：
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComCtrls;

type
TForm1 = class(TForm)
Button1: TButton;
edt1: TMemo;
ListView1: TListView;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

uses SendKeyEx;
procedure TForm1.Button1Click(Sender: TObject);


procedure SendK(Idx: Integer);
begin
Beep;
//Sleep(1000);
end;

begin
edt1.SetFocus;
SendText('中国人们共和国万岁！I''am a chinese. I love china very much!', edt1.Handle,
Pointer(@SendK));

end;
如果上面那据sleep被注释，好像整个发送过程结束后（好像还要等上1、2秒），才能听到一声beep；如果加上sleep后，就可以听到连续的声音了。这是为什么？我可不可以在我的回调函数中不使用sleep实现在回调操作完成后再执行字符发送呢？请麻子兄指教！

http://www.delphibbs.com/delphibbs/dispq.asp?lid=3264346
原文在这里，根据上面修改SendKeyEx.pas如下：
unit SendKeyEx;

interface

uses Windows, Messages, SysUtils;

type
PSendPerCharCallback = ^TSendPerCharBackProc;
TSendPerCharBackproc = procedure (SndIndex: Integer);

function SendText(const S: string): Integer
overload;
function SendText(const S: string
TargetWindow: HWND): Integer
overload;
function SendText(const S: string
TargetControl: HWND;
CallBackProc: PSendPerCharCallback): Integer
overload;

implementation

function SendText(const S: string): Integer;
var
hWindow: HWND;
begin
hWindow := GetForegroundWindow()
// 当前窗口
if IsWindow(hWindow) then
Result := SendText(S, hWindow)
else
Result := -1;
end;

function SendText(const S: string
TargetWindow: HWND): Integer;
var
hControl: HWND;
ThreadID: DWord;
begin
ThreadID := GetWindowThreadProcessId(TargetWindow, nil)
// 窗口对应线程
AttachThreadInput(GetCurrentThreadId(), ThreadID, True)
// 共享输入队列
try
hControl := GetFocus
// 焦点控件
Result := SendText(S, hControl, nil);
finally
AttachThreadInput(GetCurrentThreadId(), ThreadID, False)
// 取消共享
end;
end;

function SendText(const S: string
TargetControl: HWND;
CallBackProc: PSendPerCharCallback): Integer;
begin
Result := 1;
while (Result <= Length(S)) do // 处理每个字符
begin
if (ByteType(S, Result) = mbSingleByte) then // 英文
SendMessage(TargetControl, WM_IME_CHAR, Integer(S[Result]), 0)
else
begin // 汉字
SendMessage(TargetControl, WM_IME_CHAR,
MakeWord(Byte(S[Result + 1]), Byte(S[Result])), 0);
Result := Result + 1;
end;
Result := Result + 1;
if CallBackProc <> nil then
begin
TSendPerCharBackProc(CallBackProc)(Result);
end;
end;
end;

调用代码如下：
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComCtrls;

type
TForm1 = class(TForm)
Button1: TButton;
edt1: TMemo;
ListView1: TListView;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

uses SendKeyEx;
procedure TForm1.Button1Click(Sender: TObject);


procedure SendK(Idx: Integer);
begin
Beep;
//Sleep(1000);
end;

begin
edt1.SetFocus;
SendText('中国人们共和国万岁！I''am a chinese. I love china very much!', edt1.Handle,
Pointer(@SendK));

end;
如果上面那据sleep被注释，好像整个发送过程结束后（好像还要等上1、2秒），才能听到一声beep；如果加上sleep后，就可以听到连续的声音了。这是为什么？我可不可以在我的回调函数中不使用sleep实现在回调操作完成后再执行字符发送呢？请麻子兄指教！

procedure TForm1.Button1Click(Sender: TObject);
var
i: Integer;
begin
for i := 0 to 100 do
begin
MessageBeep(0);
//Sleep(100);
end;
end;

这段代码也有类似的情况, 不清楚为什么, 可能本次的Beep会取消上次的Beep吧..

After queuing the sound, the MessageBeep function returns control to the calling function and plays the sound asynchronously.

看来确实是Beep的问题了。呵呵。接受答案了。