Forum > Windows

Freepascal - Console application to make Desktop screenshot on Windows 7

(1/2) > >>

dogriz:
Is it posible to create console application that can take screenshots of Windows 7 desktop and save it to image file?

Trenatos:
Is it possible? Yes.

I haven't done it myself, but this should help:  http://wiki.lazarus.freepascal.org/Developing_with_Graphics#Taking_a_screenshot_of_the_screen

dogriz:
Yes, I know this method, I've used something similar in Delphi. But what I want is to accomplish that without using Graphics and LCL (for example: simulate print screen button and get result from clipboard somehow... maybe, I don't know)

molly:

--- Quote ---But what I want is to accomplish that without using Graphics and LCL
--- End quote ---
Maybe this can help you (which also leads to this)

Microsoft also has an article about it.

Pretty weird that i just stumbled upon those while googling   :-X

GetMem:
Here you go:

--- Code: ---program Test;

{$MODE Delphi}

uses
  {$IFDEF UNIX}{$IFDEF UseCThreads}
  cthreads,
  {$ENDIF}{$ENDIF}
  windows,
  Classes
  { you can add units after this };

function ScreenShot(const AFileName: String): Boolean;
var
  bFileHeader: TBitmapFileHeader;
  bHandle: HGLOBAL;
  bInfoHeader: PBitmapInfoHeader;
  ms: TMemoryStream;
begin
  Result := False;
  Keybd_Event(VK_SNAPSHOT, MapVirtualKey(VK_SNAPSHOT, 0), 0, 0);
  Keybd_Event(VK_SNAPSHOT, MapVirtualKey(VK_SNAPSHOT, 0), KEYEVENTF_KEYUP, 0);
  Sleep(2000);
  if OpenClipboard(0) then
  begin
    bHandle := GetClipboardData(CF_DIB);
    if bHandle <> 0 then
    begin
      bInfoHeader := GlobalLock(bHandle);
      if bInfoHeader <> nil then
      begin
        FillChar(bFileHeader, SizeOf(bFileHeader), 0);
        bFileHeader.bfType := $4D42;
        bFileHeader.bfSize := SizeOf(bFileHeader) + GlobalSize(bHandle);
        bFileHeader.bfOffBits := SizeOf(bFileHeader) + bInfoHeader.biSize;
        ms := TMemoryStream.Create;
        try
          ms.WriteBuffer(bFileHeader, SizeOf(bFileHeader));
          ms.WriteBuffer(bInfoHeader^, bFileHeader.bfSize - SizeOf(bFileHeader));
          ms.Position := 0;
          ms.SaveToFile(AFileName);
          Result := True;
        finally
          ms.Free;
        end;
        GlobalUnlock(bHandle)
      end;
    end;
    CloseClipboard;
  end;
end;

begin
  if ScreenShot('c:\test.bmp') then
    Writeln('success')
  else
    Writeln('failed');
  Readln;
end.                   

--- End code ---

Navigation

[0] Message Index

[#] Next page

Go to full version