K210.ORG

Скрин (13.07.05 3:39)
Мне дали одну функцию, как это делать. Но она глючит. Часто вылетает какая то ошибка "неверный параметр". Не знаю, что это такое. Может у кого есть безглючный вариант ?

Просто Джо © (13.07.05 4:09) [2]
Вот, держив "самопал" из одного проекта.
При необходимости, накладывает даже изображение курсора.

unit ScrUtil;

 

interface

uses Windows, SysUtils, Graphics;

 

procedure MakeScreenshot (Bmp: TBitmap; CaptureCursor: Boolean = True);

 

implementation

uses Controls, Forms;

 

procedure MakeScreenshot (Bmp: TBitmap; CaptureCursor: Boolean = True);

var

 DC: HDC;

 ACursor: HICON;

 Pt: TPoint;

 CurInfo: tagCURSORINFO;

 IcoInfo: _ICONINFO;

begin

 Bmp.Width := Screen.Width;

 Bmp.Height := Screen.Height;

 

 DC := GetDC (GetDesktopWindow);

 try

   BitBlt (

     Bmp.Canvas.Handle,

     0,0,Bmp.Width,Bmp.Height,

     DC,

     0,0,

     SRCCOPY);

 

   // -- курсор

   if CaptureCursor then

   begin

 

     CurInfo.cbSize := SizeOf(CurInfo);

     GetCursorInfo(CurInfo);

 

     ACursor := CurInfo.hCursor;

     Pt := CurInfo.ptScreenPos;

 

     GetIconInfo (ACursor,IcoInfo);

 

     DrawIcon(

       Bmp.Canvas.Handle,

       Pt.X-IcoInfo.xHotspot,

       Pt.Y-IcoInfo.yHotspot,

       ACursor

     )

   end;

 

 finally

   ReleaseDC (GetDesktopWindow,DC);

 end;

end;

 

end.

Пример использования:

procedure TScrnShtFrm.Button5Click(Sender: TObject);

var

 Bmp: TBitmap;

begin

 Bmp := TBitmap.Create;

 try

   // снимаем изображение экрана с курсором

   MakeScreenshot(Bmp,True);

   // и сохраняем его в файл директории программы

   Bmp.SaveToFile(ExtractFilePath(ParamStr(0))+'screen.bmp');

 finally

   Bmp.Free;

 end;

end;

http://www.delphimaster.ru/cgi-bin/forum.pl?id=1121211557&n=0