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