Screenshot - Komplet "pakke"

Tag en form placer et Timage komponent på den. Og en knap. Skriv der efter det følgende kode :

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Image1: TImage;
    Button2: TButton;
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

uses
JPEG, ShellAPi;

function ScreenCapture:TBitmap;
// this function captures the screen
var
  ScreenDC: HDC;
ARect:TRect;
begin
  Result := TBitmap.Create;
  ARect := Rect(0,0,Screen.Width,Screen.Height);
  Result.Width := ARect.Right - ARect.Left;
  Result.Height := ARect.Bottom - ARect.Top;
  ScreenDC := GetDC( 0 );
  try
    BitBlt( Result.Canvas.Handle, 0, 0, Result.Width, Result.Height, ScreenDC, ARect.Left, ARect.Top, SRCCOPY );
  finally
    ReleaseDC( 0, ScreenDC );
  end;
end;



//You might also want to use this procedure, because the bmp is normally pretty huge
//this converts the a Bitmap to a JPEG image

procedure TForm1.Button2Click(Sender: TObject);
var
  BitmapImage : TBitmap;
  JPEGImage : TJPEGImage;
begin
BitmapImage := ScreenCapture();
JpegImage := TJPEGImage.Create;
Try
  BitmapImage.Width := BitmapImage.Width div 2;
  BitmapImage.Height := BitmapImage.Height div 2;
  JPEGImage.Assign(BitmapImage);
  Image1.Picture.Assign(JPEGImage);
  JpegImage.SaveTofile('Tmp.JPEG');
Finally
  JPEGImage.Free;
  BitMapImage.Free;
end;
ShellExecute(handle,'open','Tmp.JPEG','','',SW_NORMAL);
end;
end.

Jens B

Det ser ganske fornuftigt ud, og med meget mindre kode end det sidste jeg fik lavet ;)

Jeg ved ikke lige om jeg når at få testet det i aften, men jeg vil teste det hurtigst mulig, og så skal du nok få dine point hvis det virker !

Snowball

For andre eksempler på Screen Capture så kig på http://borrisholt.com

Det virker fint, bortset lige fra 1 ting: Billedet bli'r ikke skaleret til halv størrelse !!!

Jeg har prøvet at indsætte JpegImage.Scale := jsHalf; men så får jeg bare en JPEG error #41 !?!?!?

Hvis du lige hurtigt skriver hvordan man skalerer billedet så er point'ene dine ;)

Snowball

Kom lige til at se noget !!!

BitmapImage.Width := BitmapImage.Width div 2;
BitmapImage.Height := BitmapImage.Height div 2;

Den kode laver ikke billedet til halv størrelse ! Eller jo, det gør den, men den cutter billedet ! Altså den laver ikke billedet mindre på en måde så hele billedet stadig er der, men beskærer billedet !!!
 
Snowball