如何把鼠标在屏幕上的操作录制下来呢? ( 积分: 300 )

  • 主题发起人 主题发起人 adam2000
  • 开始时间 开始时间
A

adam2000

Unregistered / Unconfirmed
GUEST, unregistred user!
做了个小程序,想加个功能,就是把鼠标在屏幕上的操作过程录制下来,然后保存为AVI一类的文件并可以回放,有相关的控件可用吗?
 
给个单元你把,用的时候引用单元里的函数就可以了。[:D]
unit HKProc;

interface

uses
forms,Windows,SysUtils,Messages,Dialogs;

var
hHotKeyNextHookProc:hHook=0;
hGetNextHookProc:hHook=0;
hPlayBackNextHookProc:hHook=0;
procSaveExit: Pointer;
Msg:TEventMsg;
WaitTime:DWord=0;
PlayNum:Integer=0;
{热键定义}
function KeyboardHookHandler(iCode: Integer;
wParam: WPARAM;
lParam: LPARAM): LResult;stdcall;
function EnableHotKeyHook: Bool;
function DisableHotKeyHook: Bool;
procedure HotKeyHookExit;
{获取消息}
function GetHookHandler(Code:integer;wParam:WPARAM;lParam:LPARAM):LResult;stdcall;
function GetMessage:Bool;
function StopGetMessage:Bool;
procedure GetHookExit;
{回放消息}
function PlayBackHookHandler(Code:integer;wParam:WPARAM;lParam:LPARAM):LResult;stdcall;
function PlayBackMessage:Bool;
function StopPlayBackMessage:Bool;
procedure PlayBackHookExit;

{获取消息}
procedure GetOneMsgFromPM;
//从当前录制的动作中读取一条消息
procedure GetOneMsgFromPM1;//从选择文件的动作中读取一条消息

implementation

uses mRecord;
////////////////////////////////////////////////////////////////////////////////
{
热键定义
}
function KeyboardHookHandler(iCode: Integer;wParam: WPARAM;lParam: LPARAM): lResult;stdcall;
const
_KeyPressMask = $80000000;
begin

Result := 0;
If iCode < 0 then
begin

Result := CallNextHookEx(hHotKeyNextHookProc, iCode, wParam, lParam);
Exit;
end;

if ((lParam and _KeyPressMask) = 0) and // 偵測 Ctrl + R 組合鍵
(GetKeyState(vk_Control) < 0) and (wParam = Ord('R')) then
begin

Form1.BtnRecord.OnClick(Form1.BtnRecord);
Result := 1;
end ;
end;



function EnableHotKeyHook: BOOL;
begin

Result := False;
if hHotKeyNextHookProc <> 0 then
Exit;
{ 挂上WH_KEYBOARD型的HOOK, 同时,传回值必须保留下來, 免得 HOOK 呼叫连接中断}
hHotKeyNextHookProc:=SetWindowsHookEx(WH_KEYBOARD, KeyboardHookHandler, HInstance, 0);
Result := hHotKeyNextHookProc <> 0;
end;


function DisableHotKeyHook: BOOL;
begin

if hHotKeyNextHookProc <> 0 then

begin

UnhookWindowshookEx(hHotKeyNextHookProc);
// 解除 Keyboard Hook
hHotKeyNextHookProc := 0;
MessageBeep(0);
MessageBeep(0);
end;

Result := hHotKeyNextHookProc = 0;
end;



procedure HotKeyHookExit;
begin

// 如果忘了解除 HOOK, 自動代理解除的動作
if hHotKeyNextHookProc <> 0 then
DisableHotKeyHook;
ExitProc := procSaveExit;
end;



////////////////////////////////////////////////////////////////////////////////
{
获取消息
}
function GetHookHandler(Code:integer;wParam:WPARAM;lParam:LPARAM):LResult;
stdcall;
begin

Result := 0;
if Code < 0 then
begin

Result := CallNextHookEx(hGetNextHookProc,Code,wParam,lParam);
Exit;
end;

msg:=pEventMsg(lParam)^;
//读取响应过后的一条消息
if ((msg.message>=WM_MOUSEFIRST)and(msg.message<=WM_MOUSELAST))
or((msg.message>=WM_KEYFIRST)and (msg.message<=WM_KEYLAST))then
begin

if ((msg.message=$0101)and(msg.paramL=$011B)and(msg.paramH =$0001)) //如果是ESCAPe键,
or((msg.message=$0100)and(msg.paramL =$011B)and(msg.paramH=$0001)) then
begin
//则退出记录过程(脱钩)
Form1.BtnStopRec.OnClick(Form1.BtnStopRec);
Exit;
end;

MessageStr:=MessageStr+'$'+IntToHex(msg.message,4)+'$'+IntToHex(msg.paramL,4)+'$'+
IntToHex(msg.paramH,4)+'$'+IntToHex(msg.time,12)+#13#10;
inc(Msgcount);
end;

end;




function GetMessage:Bool;
begin

Result := False;
if hGetNextHookProc <> 0 then
Exit;
{挂上WH_JOURNALRECORD型的HOOK, 同时,传回值必须保留下來, 免得 HOOK 呼叫连接中断}
hGetNextHookProc:=SetWindowsHookEx(WH_JOURNALRECORD,GetHookHandler,HInstance,0);
Result := hGetNextHookProc <> 0;

end;


function StopGetMessage:Bool;
begin

if hGetNextHookProc <> 0 then

begin

UnhookWindowshookEx(hGetNextHookProc);
// 解除 Mouse Hook
hGetNextHookProc := 0;
end;

Result := hGetNextHookProc = 0;
end;


procedure GetHookExit;
begin

if hGetNextHookProc <> 0 then
StopGetMessage;
ExitProc := procSaveExit;
end;


/////////////////////////////////////////////////////////////////////////////////
{
回放消息
}

function PlayBackHookHandler(Code:integer;wParam:WPARAM;lParam:LPARAM):LResult;stdcall;
begin

case Code of
HC_SKIP:begin
//从消息列表中提取下一个消息,如果到了数组最后 ,就脱钩
if not Form1.CBPlayBack.Checked then
GetOneMsgFromPM//从当前录制的数组中读取一条消息
else
GetOneMsgFromPM1;//从选择文件的动作中读取一条消息
Result:=0;
end;

HC_GETNEXT:begin
//正确填充wparam/lparam的值,以使消息能够得到正确的回放。
//此时不能脱钩。返回值表明Windows应当在多少时间内回放消息。
Sleep(WaitTime);
Msg.time:=GetTickCount;
PEventMsg(lParam)^:=Msg;
Result:=0;//返回0表立即处理
end;

else
//否则就调用挂钩连中的下一个挂钩
Result:=CallNextHookEx(hPlayBackNextHookProc,Code,wParam,lParam);
end;

end;

function PlayBackMessage:Bool;
begin

Result:=False;
if hPlayBackNextHookProc <> 0 then
Exit;
{挂上WH_JOURNALPlayBack型的HOOK, 同时,传回值必须保留下來, 免得 HOOK 呼叫连接中断}
hPlayBackNextHookProc:=SetWindowsHookEx(WH_JOURNALPLAYBACK,PlayBackHookHandler,HInstance,0);
Result := hPlayBackNextHookProc <> 0;
end;

function StopPlayBackMessage:Bool;
begin

if hPlayBackNextHookProc <> 0 then
begin

UnhookWindowshookEx(hPlayBackNextHookProc);
// 解除 Mouse Hook
hPlayBackNextHookProc := 0;
end;

PLayNum:=0;
Result:=hPlayBackNextHookProc = 0;
end;

procedure PlayBackHookExit;
begin

if hPlayBackNextHookProc <> 0 then
StopPlayBackMessage;
ExitProc := procSaveExit;
end;





////////////////////////////////////////////////////////////////////////////////
procedure GetOneMsgFromPM;
begin

if PlayNum>=MsgCount then
begin

Form1.StopPlayBack;
end else
begin

Msg:=PM[PlayNum];
if PlayNum=0 then
WaitTime:=0 else
WaitTime:=PM[PLayNum].Time-PM[PLayNum-1].Time;
end;

inc(PLayNum);
end;



procedure GetOneMsgFromPM1;
begin

if PlayNum>=ArrayCount then
begin

Form1.StopPlayBack;
end else
begin

Msg:=PM1[PLayNum];
if PlayNum=0 then
WaitTime:=0 else
WaitTime:=PM1[PLayNum].Time-PM1[PLayNum-1].Time;
end;

Inc(PlayNum);
end;



end.
 
关键问题还是没能解决啊。自己顶~
 
你要屏幕录象机呀[:)]
 
是啊,就是把屏幕录制下来,这么久了都没什么回复,想散分都不行~~~~~~~~
 
Delphi用Hook实现鼠标和键盘事件的记录,回放


unit Unit1;

interface

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

type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
Button3: TButton;
Edit1: TEdit;
Button4: TButton;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;


var
Form1: TForm1;

EventArr:array[0..1000]of EVENTMSG;
EventLog:Integer;
PlayLog:Integer;
hHook,hPlay:Integer;
recOK:Integer;
canPlay:Integer;
bDelay:Bool;
implementation

{$R *.DFM}
Function PlayProc(iCode:Integer;wParam:wParam;lParam:lParam):LRESULT;stdcall;
begin

canPlay:=1;
Result:=0;

if iCode < 0 then
//必须将消息传递到消息链的下一个接受单元
Result := CallNextHookEx(hPlay,iCode,wParam,lParam)
else
if iCode = HC_SYSMODALON then

canPlay:=0
else
if iCode = HC_SYSMODALOFF then

canPlay:=1
else
if ((canPlay =1 )and(iCode=HC_GETNEXT)) then
begin

if bDelay then
begin

bDelay:=False;
Result:=50;
end;

pEventMSG(lParam)^:=EventArr[PlayLog];
end
else
if ((canPlay = 1)and(iCode = HC_SKIP))then
begin

bDelay := True;
PlayLog:=PlayLog+1;
end;

if PlayLog>=EventLog then
begin

UNHookWindowsHookEx(hPlay);
end;

end;


function HookProc(iCode:Integer;wParam:wParam;lParam:lParam):LRESULT;stdcall;
begin

recOK:=1;
Result:=0;

if iCode < 0 then

Result := CallNextHookEx(hHook,iCode,wParam,lParam)
else
if iCode = HC_SYSMODALON then

recOK:=0
else
if iCode = HC_SYSMODALOFF then

recOK:=1
else
if ((recOK>0) and (iCode = HC_ACTION)) then
begin

EventArr[EventLog]:=pEventMSG(lParam)^;
EventLog:=EventLog+1;

if EventLog>=1000 then
begin

UnHookWindowsHookEx(hHook);
end;

end;

end;


procedure TForm1.FormCreate(Sender: TObject);
begin

Button1.Caption:='纪录';
Button2.Caption:='停止';
Button3.Caption:='回放';
Button4.Caption:='范例';
Button2.Enabled:=False;
Button3.Enabled:=False;
end;


procedure TForm1.Button1Click(Sender: TObject);
begin

EventLog:=0;
//建立键盘鼠标操作消息纪录链
hHook:=SetwindowsHookEx(WH_JOURNALRECORD,HookProc,HInstance,0);
Button2.Enabled:=True;
Button1.Enabled:=False;
end;


procedure TForm1.Button2Click(Sender: TObject);
begin

UnHookWindowsHookEx(hHook);
hHook:=0;

Button1.Enabled:=True;
Button2.Enabled:=False;
Button3.Enabled:=True;
end;


procedure TForm1.Button3Click(Sender: TObject);
begin

PlayLog:=0;
//建立键盘鼠标操作消息纪录回放链
hPlay:=SetwindowsHookEx(WH_JOURNALPLAYBACK,PlayProc,
HInstance,0);

Button3.Enabled:=False;
end;


end.
 
to : xubin4456

uses mRecord;
漏了。

Form1.BtnRecord.OnClick(Form1.BtnRecord);里面是什么代码。
能不能给份完整的?谢谢了。
 
www.ysza.com
屏幕录像机
 
多人接受答案了。
 
后退
顶部