unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, JPEG, ShellApi, Menus;
type
TForm1 =
class(TForm)
Button2: TButton;
Button1: TButton;
Button3: TButton;
Button4: TButton;
CheckBox1: TCheckBox;
Button5: TButton;
procedure Button5Click(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private-Deklarationen }
public
{ Public-Deklarationen }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
Procedure BmpToJpg(
const Filename:
String; Quality: TJPEGQualityRange=100);
var
Bmp: TBitmap;
Jpg: TJpegImage;
begin
Bmp:=TBitmap.Create;
Jpg:=TJpegImage.Create;
try
Bmp.LoadFromFile(Filename);
Jpg.CompressionQuality:=Quality;
Jpg.Assign(Bmp);
Jpg.SaveToFile(ChangeFileExt(Filename, '
.jpg' ));
finally
Jpg.Free;
Bmp.Free;
end;
end;
procedure SaveAppScreen(
const SaveBmpFileName:
string);
var
Bitmap: TBitmap;
Canvas: TCanvas;
begin
Canvas := TCanvas.Create;
try
Canvas.Handle := GetWindowDC(0);
try
Bitmap := TBitmap.Create;
try
Bitmap.Width := Application.MainForm.Width;
Bitmap.Height:= Application.MainForm.Height;
Bitmap.PixelFormat := pfDevice;
BitBlt(Bitmap.Canvas.Handle, 0, 0, Pred(Application.MainForm.Width), Pred(
Application.MainForm.Height), Canvas.Handle,
Application.MainForm.Left, Application.MainForm.Top,
Bitmap.Canvas.CopyMode);
Bitmap.SaveToFile(SaveBmpFileName);
finally
FreeAndNil(Bitmap);
end;
finally
ReleaseDC(0, Canvas.Handle);
end;
finally
FreeAndNil(Canvas);
end;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
SaveAppScreen('
C:\Screenie.bmp');
if CheckBox1.Checked
then
BmpToJpg('
C:\Screenie.bmp');
if CheckBox1.Checked
then
deletefile('
C:\Screenie.bmp');
end;
procedure TForm1.Button4Click(Sender: TObject);
begin
Form1.Width := 800;
Form1.Height := 600
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
Form1.Width := 1024;
Form1.Height := 768
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
Form1.Width := 1280;
Form1.Height := 1024;
end;
procedure TForm1.FormShow(Sender: TObject);
begin
Form1.ScreenSnap := true;
Form1.SnapBuffer := 30;
end;
procedure TForm1.Button5Click(Sender: TObject);
begin
if ShellExecute(Application.Handle,
'
open',
PChar('
C:\Screenie.bmp'),
Nil,
Nil, SW_NORMAL) <= 32
then
ShellExecute(Application.Handle,
'
open',
PChar('
C:\Screenie.jpg'),
Nil,
Nil, SW_NORMAL)
end;
end.