如何实现用鼠标全屏指定窗体、指定区域抓图?(200分)

  • 主题发起人 主题发起人 blude
  • 开始时间 开始时间
B

blude

Unregistered / Unconfirmed
GUEST, unregistred user!
想实现抓取指定窗体内的自定义大小区域的图片。
比如,我开个视频文件在播放器里播放,我用鼠标左键点视频的播放窗口内容,我抓取整个播放窗口保存成图片,或者我能指定以鼠标点击的坐标为中心,抓取长宽300像素(就是说可以自定义尺寸)的区域,保存成图片。我不要那种把整个屏幕截下来然后再来处理的那种。谁有办法?
 
区域抓取屏幕好办,就是抓取视频不好办,视频是持续动态的,用普通的拷屏方法都不能取得视频的图像(拷下来的是好像是一片黑的,如何抓取视频图像我也不会)。附上以鼠标为区域中心屏幕拷贝200*200大小的图到Image控件上的源码。
var
Form1: TForm1;
IsCapture:Boolean; // 设置全局鼠标捕获标志

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
if Not(IsCapture) then
begin
// 开始区域抓图,先最小化自己的窗口。
SetCapture(Handle);
ShowWindow(Handle,SW_MINIMIZE);
IsCapture := TRUE;
end;
end;

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var Bitmap:TBitmap;
Rect1:TRect;
Point:TPoint;
Canvas:TCanvas;
begin
// 如果是点击鼠标右键,则取消抓图
if (Shift = [ssRight]) and (IsCapture) then
begin
IsCapture := FALSE;
ShowWindow(Handle,SW_RESTORE);
SetForegroundWindow(Handle);
ReleaseCapture;
// 如果是点击鼠标左键,则开始抓图
end else if (Shift = [ssLeft]) and (IsCapture) then
begin
IsCapture := FALSE;
Bitmap := TBitmap.Create;
Canvas := TCanvas.Create;
try
// 获取当前鼠标座标,并计算出以鼠标为中心的区域大小(这里是200*200的大小)
GetCursorPos(Point);
if Point.X > 100 then
Rect1.Left := Point.X - 100
else
Rect1.Left := Point.X;
if Point.Y > 100 then
Rect1.Top := Point.Y - 100
else
Rect1.Top := Point.Y;
Rect1.Right := Rect1.Left + 200;
Rect1.Bottom := Rect1.Top + 200;
Canvas.Handle := GetDc(0);
Bitmap.Width := 200;
Bitmap.Height := 200;
// 区域抓取图像
Bitmap.Canvas.CopyRect(Rect(0,0,200,200),Canvas,Rect1);
Image1.Picture.Bitmap.Assign(Bitmap);
finally
ReleaseCapture;
ShowWindow(Handle,SW_RESTORE);
SetForegroundWindow(Handle);
ReleaseDC(0,Canvas.Handle);
Bitmap.Free;
Canvas.Free;
end;
end;
end;
 
哈,又是你来接我的分,能不能结合上次你给的那个代码,好好修改一下。
有QQ吗?QQ上聊。我的qq: 767310839
上次的问题:如何获得指定窗口中鼠标的单击坐标?
比如,在记事本里任意位置单击鼠标,如何知道鼠标在记事本中的坐标,或者屏幕坐标。是不是要用到HOOK?

是用要到Hook
// 全局Dll鼠标钩子
library Project2;

{ Important note about DLL memory management: ShareMem must be the
first unit in your library's USES clause AND your project's (select
Project-View Source) USES clause if your DLL exports any procedures or
functions that pass strings as parameters or function results. This
applies to all strings passed to and from your DLL--even those that
are nested in records and classes. ShareMem is the interface unit to
the BORLNDMM.DLL shared memory manager, which must be deployed along
with your DLL. To avoid using BORLNDMM.DLL, pass string information
using PChar or ShortString parameters. }

uses
windows,
messages;

{$R *.res}

const
USER_WM_MOUSEDOWN = WM_USER + 1000;

var g_hHook:HHOOK;

Function MouseProc(nCode:DWORD; Wparam:LongWord; LParam:LongWord):LResult; stdcall;
var hMyWindow:HWND;
begin
Result := 0;
CallNextHookEx(g_hHook,nCode,Wparam,Lparam);
if Wparam = WM_LBUTTONDOWN then
begin
hMyWindow := FindWindow(nil,'Form1');
if hMyWindow <> 0 then
PostMessage(hMyWindow,USER_WM_MOUSEDOWN,0,0);
end;
end;

Function OnHook():LResult;
begin
g_hHook := SetWindowsHookEx(WH_MOUSE,@MouseProc,hInstance,0);
Result := g_hHook;
end;

Function UnHook():Boolean;
begin
Result := FALSE;
if g_hHook <> 0 then
begin
Result := UnHookWindowsHookEx(g_hHook);
g_hHook := 0;
end;
end;

exports
OnHook,
UnHook;

begin
end.

// Demo演示程序
unit Unit1;

interface

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

const
USER_WM_MOUSEDOWN = WM_USER + 1000;

type
TForm1 = class(TForm)
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Button1: TButton;
Button2: TButton;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
procedure UserWmMouseDown(var Msg:TMessage); message USER_WM_MOUSEDOWN;
{ Private declarations }
public
{ Public declarations }
end;

Function OnHook:LResult; external 'Project2.dll';
Function UnHook:Boolean; external 'Project2.dll';

var
Form1: TForm1;

implementation

{$R *.dfm}

{ TForm1 }

procedure TForm1.UserWmMouseDown(var Msg: TMessage);
var Point:TPoint;
hWindow:HWND;
begin
GetCursorPos(Point);
{ 显示Screen屏幕座标 }
Label3.Caption := Format('X: %u - Y: %u',[Point.X,Point.Y]);
hWindow := WindowFromPoint(Point);
windows.ScreenToClient(hWindow,point);
// 显示窗口座标
{ 注:窗口座标是相对于鼠标所指向的子窗口的座标。
如鼠标是指向某个窗口的Toolbar控件,那窗口座标就是相对于Toolbar控件的}
Label4.Caption := Format('X: %u - Y: %u',[Point.X,Point.Y]);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
SetWindowPos(handle,HWND_TOPMOST,0,0,0,0,SWP_NOMOVE OR SWP_NOSIZE);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
OnHook();
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
UnHook();
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
UnHook();
end;

end.
 
// QQ是有,不过我很少上QQ的,加了也作用不大[:)]。不太清楚你的意思,所以便改成了如下:
// Hook Dll不用改了。直接改Demo就行了。
//红色为添加部分。
unit Unit1;

interface

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

const
USER_WM_MOUSEDOWN = WM_USER + 1000;

type
TForm1 = class(TForm)
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Button1: TButton;
Button2: TButton;
[red]Image1: TImage;[/red]
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
[red]procedure FormMouseDown(Sender: TObject; Button: TMouseButton;[/red]
Shift: TShiftState; X, Y: Integer);
private
procedure UserWmMouseDown(var Msg:TMessage); message USER_WM_MOUSEDOWN;
{ Private declarations }
public
{ Public declarations }
end;

Function OnHook:LResult; external 'Project2.dll';
Function UnHook:Boolean; external 'Project2.dll';

var
Form1: TForm1;
[red]IsCapture:Boolean; // 设置全局鼠标捕获标志[/red]


implementation

{$R *.dfm}

{ TForm1 }

procedure TForm1.UserWmMouseDown(var Msg: TMessage);
var Point:TPoint;
hWindow:HWND;
begin
GetCursorPos(Point);
{ 显示Screen屏幕座标 }
Label3.Caption := Format('X: %u - Y: %u',[Point.X,Point.Y]);
hWindow := WindowFromPoint(Point);
windows.ScreenToClient(hWindow,point);
// 显示窗口座标
{ 注:窗口座标是相对于鼠标所指向的子窗口的座标。
如鼠标是指向某个窗口的Toolbar控件,那窗口座标就是相对于Toolbar控件的}
Label4.Caption := Format('X: %u - Y: %u',[Point.X,Point.Y]);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
SetWindowPos(handle,HWND_TOPMOST,0,0,0,0,SWP_NOMOVE OR SWP_NOSIZE);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
OnHook();
[red]if Not(IsCapture) then
begin
// 开始区域抓图,先最小化自己的窗口。
SetCapture(Handle);
ShowWindow(Handle,SW_MINIMIZE);
IsCapture := TRUE;
end;[/red]
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
UnHook();
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
UnHook();
end;
[red]
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var Bitmap:TBitmap;
Rect1:TRect;
Point:TPoint;
Canvas:TCanvas;
begin
// 如果是点击鼠标右键,则取消抓图
if (Shift = [ssRight]) and (IsCapture) then
begin
IsCapture := FALSE;
ShowWindow(Handle,SW_RESTORE);
SetForegroundWindow(Handle);
ReleaseCapture;
// 如果是点击鼠标左键,则开始抓图
end else if (Shift = [ssLeft]) and (IsCapture) then
begin
IsCapture := FALSE;
Bitmap := TBitmap.Create;
Canvas := TCanvas.Create;
try
// 获取当前鼠标座标,并计算出以鼠标为中心的区域大小(这里是200*200的大小)
GetCursorPos(Point);
if Point.X > 100 then
Rect1.Left := Point.X - 100
else
Rect1.Left := Point.X;
if Point.Y > 100 then
Rect1.Top := Point.Y - 100
else
Rect1.Top := Point.Y;
Rect1.Right := Rect1.Left + 200;
Rect1.Bottom := Rect1.Top + 200;
Canvas.Handle := GetDc(0);
Bitmap.Width := 200;
Bitmap.Height := 200;
// 区域抓取图像
Bitmap.Canvas.CopyRect(Rect(0,0,200,200),Canvas,Rect1);
Image1.Picture.Bitmap.Assign(Bitmap);
finally
ReleaseCapture;
ShowWindow(Handle,SW_RESTORE);
SetForegroundWindow(Handle);
ReleaseDC(0,Canvas.Handle);
Bitmap.Free;
Canvas.Free;
UnHook;
end;
end;
end;
[/red]
end.
 
接受答案了.
 
后退
顶部