Мастера DELPHI (документация, исходники, скачать)

Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

« предыдущая ветвь | форум | следующая ветвь »

Как сделать снимок с экрана с курсором мыши? [D7, WinXP]

Chaser © (2005-12-26 11:20:00)
Есть код, делающий снимок с экрана с курсором мыши, но он очень медленно работает (примерно 30 миллисекунд).
Код:

// Скриншот с курсором
function CaptureScreen: TBitmap;
var
DC: HDC;
ABitmap: TBitmap;
MyCursor: TIcon;
CursorInfo: TCursorInfo;
IconInfo: TIconInfo;
begin
// Capture the Desktop screen
DC:=GetDC(GetDesktopWindow);
ABitmap:=TBitmap.Create;
try
ABitmap.Width:=GetDeviceCaps(DC, HORZRES);
ABitmap.Height:=GetDeviceCaps(DC, VERTRES);
// BitBlt on our bitmap
BitBlt(ABitmap.Canvas.Handle, 0, 0, ABitmap.Width, ABitmap.Height,
DC, 0, 0, SRCCOPY);
// Create temp. Icon
MyCursor:=TIcon.Create;
try
// Retrieve Cursor info
CursorInfo:=GetCursorInfo2;
if CursorInfo.hCursor<>0
then
begin
MyCursor.Handle:=CursorInfo.hCursor;
// Get Hotspot information
GetIconInfo(CursorInfo.hCursor, IconInfo);
// Draw the Cursor on our bitmap
ABitmap.Canvas.Draw(CursorInfo.ptScreenPos.X-IconInfo.xHotspot,
CursorInfo.ptScreenPos.Y-IconInfo.yHotspot, MyCursor);
end;
finally
// Clean up
MyCursor.ReleaseHandle;
MyCursor.Free;
end;
finally
ReleaseDC(GetDesktopWindow, DC);
end;
Result:=ABitmap;
end;

Image1.Picture.Assign(CaptureScreen);

Прошу поделиться кодом либо соображениями как ускорить процесс получения скриншота с курсором мыши.

Заранее благодарен.

Woolen (2005-12-27 14:42:00) [1]
Вру, со Screen все впорядке. Это не он виноват, но, что TaskBar не виден

Woolen (2005-12-27 13:14:00) [2]
Да, и Screen.Height,Width - это я так, для простоты. Он не учитывает TaskBar. Через GetDeviceCaps, действительно, правильно.

Woolen (2005-12-27 12:55:00) [3]
У меня так все копируется в битмап, выводится курсор и выводится на экран. Несколько раз попробовал - ни разу не упало. Замерять производительность не пробовал, но "на глаз" работает моментально.

Woolen (2005-12-27 12:54:00) [4]
procedure TForm1.FormClick(Sender: TObject);
var
Bmp: TBitmap;
TmpCanvas: TCanvas;
CRect: TRect;
begin
TmpCanvas := TCanvas.Create;
TmpCanvas.Handle := GetDC(0);
Bmp := TBitmap.Create;
Bmp.Width := Screen.Width;
Bmp.Height := Screen.Height;
Bmp.PixelFormat := pf24bit;
CRect := Rect(0,0,Screen.Width - 1,Screen.Height - 1);
Bmp.Canvas.CopyRect(CRect,TmpCanvas,CRect);
if not DrawIcon(Bmp.Canvas.Handle,Mouse.CursorPos.X,Mouse.CursorPos.Y,GetCursor)
then
ShowMessage('Ошибка!');
ReleaseDC(0,TmpCanvas.Handle);
TmpCanvas.Free;
Form1.Canvas.StretchDraw(Rect(0,0,Form1.Width - 1,Form1.Height - 1),Bmp);
Bmp.Free;
end;

Woolen (2005-12-27 12:32:00) [5]

> Это занимает много ресурсов, вылетает с ошибкой.

Извини, не прочитал код. Брякнул сразу...

Chaser (2005-12-27 12:20:00) [6]
Это занимает много ресурсов, вылетает с ошибкой.

Woolen (2005-12-27 11:46:00) [7]
По большому счету, никак, но, может быть, попробовать прорисовать текущий курсор в его координатах на снятом с экрана растре?

Eraser (2005-12-26 13:04:00) [8]

> Chaser © (26.12.05 11:20)

Принципально -- никак. Немного возможно оптимизировать можно.

Наверх

	« предыдущая ветвь \| форум \| следующая ветвь »