Wednesday, January 12, 2011

Capture your desktop as a .bmp and as a .jpg image

This is a small utility written in delphi 7 that captures your desktop as a photo in both .bmp and .jpg format.

You can download it HERE.

Source code (Delphi 7) follows.
The 2 forms trick is used, to hide the main application form from the taskbar.
The main application form (form2) creates another form (form1) that works as a "fake" main form.
The fake form does not show at taskbar, so when u press the button "capture" the program just hides this form takes a snapshot of your desktop in both .bmp & .jpg formats and then shows itself again.
This is used so u dont get form1 showing into your snapshot.
A small delay (sleep) is used because windows animations & effects fade the forms slowly...

 (Project)
--------------------------------------------------------------------
program CaptureScreen;

uses
  Forms,
  Unit2 in 'Unit2.pas' {Form2};

{$R *.res}

begin
  Application.Initialize;
  Application.ShowMainForm := false;
  Application.CreateForm(TForm2, Form2);
  Application.Run;
end.

(Form2)
--------------------------------------------------------------------

unit Unit2;

interface

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

type
  TForm2 = class(TForm)
    Label1: TLabel;
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form2: TForm2;

implementation

{$R *.dfm}
uses unit1;

procedure TForm2.FormCreate(Sender: TObject);
begin
   with TForm1.Create(Application) do
     Show;
end;

end.


(Form1)
--------------------------------------------------------------------
unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  end;

implementation

{$R *.dfm}

procedure CaptureScreen(AFileName: string);
const
  CAPTUREBLT = $40000000;
var
  hdcScreen: HDC;
  hdcCompatible: HDC;
  bmp,bmp2: TBitmap;
  hbmScreen: HBITMAP;
  jpegimg : TJPegImage;
begin
  hdcScreen := CreateDC('DISPLAY', nil, nil, nil);
  hdcCompatible := CreateCompatibleDC(hdcScreen);
  // Create a compatible bitmap for hdcScreen.

  hbmScreen := CreateCompatibleBitmap(hdcScreen,
    GetDeviceCaps(hdcScreen, HORZRES),
    GetDeviceCaps(hdcScreen, VERTRES));

  // Select the bitmaps into the compatible DC.
  SelectObject(hdcCompatible, hbmScreen);
  bmp := TBitmap.Create;
  bmp.Handle := hbmScreen;
  BitBlt(hdcCompatible,
    0, 0,
    bmp.Width, bmp.Height,
    hdcScreen,
    0, 0,
    SRCCOPY or CAPTUREBLT);

  bmp.SaveToFile(aFileName+'.bmp');
  bmp2 := TBitmap.Create;
  bmp2.LoadFromFile(aFileName+'.bmp');

  jpegimg := TjpegImage.Create;
  try
    JpegImg.Assign(bmp2);
    JpegImg.SaveToFile(aFileName+'.jpg');
  finally
    JpegImg.Free;
  end;

  bmp.Free;
  bmp2.Free;

  DeleteDC(hdcScreen);
  DeleteDC(hdcCompatible);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Hide;
  Sleep(250);
  CaptureScreen('desktop');
  Show;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Action := caFree;
  if Screen.FormCount = 2 then
    Application.Terminate;
end;

end.

No comments:

Post a Comment