Aplikasi Print Screen

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='Jepreet' 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:='Jepreet';
    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.