Главная страница
Top.Mail.Ru    Яндекс.Метрика
Текущий архив: 2006.05.28;
Скачать: CL | DM;

Вниз

Как сделать снимок с экрана с курсором мыши?   Найти похожие ветки 

 
Chaser ©   (2005-12-26 11:20) [0]

Есть код, делающий снимок с экрана с курсором мыши, но он очень медленно работает (примерно 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);

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

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


 
Eraser ©   (2005-12-26 13:04) [1]


> Chaser ©   (26.12.05 11:20)

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


 
Woolen ©   (2005-12-27 11:46) [2]

По большому счету, никак, но, может быть, попробовать прорисовать текущий курсор в его координатах на снятом с экрана растре?


 
Chaser ©   (2005-12-27 12:20) [3]

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


 
Woolen ©   (2005-12-27 12:32) [4]


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

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


 
Woolen ©   (2005-12-27 12:54) [5]

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:55) [6]

У меня так все копируется в битмап, выводится курсор и выводится на экран. Несколько раз попробовал - ни разу не упало. Замерять производительность не пробовал, но "на глаз" работает моментально.


 
Woolen ©   (2005-12-27 13:14) [7]

Да, и Screen.Height,Width - это я так, для простоты. Он не учитывает TaskBar. Через GetDeviceCaps, действительно, правильно.


 
Woolen ©   (2005-12-27 14:42) [8]

Вру, со Screen все впорядке. Это не он виноват, но, что TaskBar не виден



Страницы: 1 вся ветка

Текущий архив: 2006.05.28;
Скачать: CL | DM;

Наверх




Память: 0.48 MB
Время: 0.035 c
1-1145270141
Stanislav
2006-04-17 14:35
2006.05.28
Как определить завершение работы программы...


15-1146645692
balepa
2006-05-03 12:41
2006.05.28
*.mp4


2-1147445279
SummerSwan
2006-05-12 18:47
2006.05.28
TFileStream


4-1138482663
Tarantiono
2006-01-29 00:11
2006.05.28
как сделать BitBlt Logon Screen a?


9-1130771485
Finsternis
2005-10-31 18:11
2006.05.28
Прошу помощи у специалистов