Sesuai Judulnya, mungkin tak asing bagi user yang sering copas Sanah Sinih dengan Istilah PrintScreen, Mukin Sudah banyak yang tau bahwa Semua OS Koputer dan Smartphone dapat menggunakan Fitur Tersebut, kali ini saya akan menshare Cara tersebut , bukan menggunakan Shortcut-Shortcut yang disediakan, akan tetapi mengunakan program deplhi..
Langkah Pertama,
Buatlah Desain Seperti gambar diatas,
Dengan Menggunakan 2 Botton (1 Shoot, 1 Untuk Simpan), Object Savepicture, dan Image
Lalau Massukan Codingannya
unit USS;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, ExtDlgs, jpeg ;
type
TFPS = class(TForm)
Bevel1: TBevel;
Image1: TImage;
Button1: TButton;
SavePictureDialog1: TSavePictureDialog;
Button2: TButton;
Label1: TLabel;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
procedure TakeShot(activeWindow : boolean);
public
{ Public declarations }
end;
var
FPS: TFPS;
implementation
{$R *.dfm}
procedure ScreenShot(activeWindow: bool; destBitmap : TBitmap) ;
var
w,h : integer;
DC : HDC;
hWin : Cardinal;
r : TRect;
begin
if activeWindow then
begin
hWin := GetForegroundWindow;
dc := GetWindowDC(hWin);
GetWindowRect(hWin,r);
w := r.Right - r.Left;
h := r.Bottom - r.Top;
end
else
begin
hWin := GetDesktopWindow;
dc := GetDC(hWin);
w := GetDeviceCaps (DC, HORZRES);
h := GetDeviceCaps (DC, VERTRES);
end;
try
destBitmap.Width := w;
destBitmap.Height := h;
BitBlt(destBitmap.Canvas.Handle,
0,
0,
destBitmap.Width,
destBitmap.Height,
DC,
0,
0,
SRCCOPY) ;
finally
ReleaseDC(hWin, DC) ;
end;
end;
procedure TFPS.TakeShot(activeWindow : boolean);
var
b:TBitmap;
begin
b := TBitmap.Create;
try
ScreenShot(activeWindow, b);
Image1.Picture.Bitmap.Assign(b);
finally
b.FreeImage;
FreeAndNil(b);
end;
end;
procedure TFPS.Button1Click(Sender: TObject);
begin
{
if result = mrYes then
TakeShot(false)
else if result=mrNo then
TakeShot(true);
}
if Button1.Caption='Shoot' then Begin
TakeShot(false);
Button1.Caption:='Lagi';
Button2.Enabled:=True;
Label1.Visible:=False;
end
else if Button1.Caption='Lagi' then Begin
Image1.Picture:=NIL;
Button1.Caption:='Shoot';
Button2.Enabled:=False;
Label1.Visible:=True;
End;
end;
procedure TFPS.Button2Click(Sender: TObject);
begin
If Image1.Picture <> nil then begin
If SavePictureDialog1.Execute then begin
if FileExists(SavePictureDialog1.FileName) = False then begin
Image1.Picture.SaveToFile(SavePictureDialog1.FileName);
end
else ShowMessage('Nama File Sudah ada, Silahkan Ganti yang lain');
end;
end;
end;
procedure TFPS.FormCreate(Sender: TObject);
begin
with SavePictureDialog1 do begin
InitialDir:=ExtractFilePath(Application.ExeName);
Filter:='JPEG Image File (*.jpg)|*.jpg';
end;
Button2.Enabled:=False;
end;
end.ya, walapun sedikit semoga Bermanfaat ..
Sekian dari saya
Waalaikumsalam.wr.wb
Tidak ada komentar:
Posting Komentar