Ta' et screenshot med Delphi

snowball,

Alle skærmdumps (printscreen) bliver lagt på windows klippebord. Ved at bruge en funktion der sender tastetryk til windows messagekø, med de taster der svarer til at trykke på printscreen vil der blive oprettet en kopi af skærmbilledet på klippebordet.

I dit delphi program skal du derefter "use" unitten "Clipboard" og du har nu adgang til din skærmkopi via clipboards metoder. Herunder Savetofile.

Så problemet ligger kun i at få sendt tasterne til vindows, men der findes diverse komponenter der virker som "SendKeys", der kan gøre det. Prøv at se på nogle af disse sider for en løsning på det problem:

http://sunsite.icm.edu.pl/delphi/ (søg efter "sendkeys") eller
http://www.undu.com (se i articles efter sendkeys) eller
http://www.borland.com (find Delphi FQA under techsupport og søg på sendkeys).

Desværre.

De komponenter der er på http://sunsite.icm.edu.pl/delphi/ kan man ikke hente da linket er dødt !

På http://www.undu.com kunne jeg ikke lige finde noget om sendkeys, og jeg fik samme resultat på http://www.borland.com !!!

Desuden er ordet sendkeys slet ikke en del af Delphi's hjælp !!!

Snowball

prøv uden delphi bag på:

http://sunsite.icm.edu.pl

Og du skal nok ikke lige søge efter "sendkeys" da det som du selv siger ikke er en del af delpi. prøv KeyboardHooks eller at skille ordet i 2 til "send keys" når du søger

Det blev det ikke bedrer af ! Faktisk tværtiomd !

Snowball

det var dog helt utroligt !!

Jeg har lige været på http://delphi.icm.edu.pl/search.htm og har søgt på sendkeys og fandt disse 2:

sendkeys.exe (154,254 bytes) SendKeys VCL/DLL Sends Keystrokes to any App. Switch between VCL/DLL inc.. 3 Functions build in: SendKeys(string); { to active window}; SendKeysTo(string, FocusHwnd);{ to FocusHwnd} SendKeysToTopWindow(string, Class,Title); { to Window with matching (ver. 2.32 12/03/97, added 3/18/97, no src.)  by FreDsterWare 

--------------------------------------------------------------------------------

sendkeys.zip (3,131 bytes) This is the component you've been waiting for. Finally Delphi sends keys to any other application (works like SendKeys in VB). FreeWare with Source. Works with Delphi 3 and 4. (ver. 1.0, added 6/7/99, no src., This component was ONLY tested with Delphi 3 and 4.)  by Pedro Gardete 
Rows

Når du vælger http://sunsite.icm.edu.pl  skal du vælge "Delphi Super Page" selvom du måske ikke lige kan forstå hvad der står på "denlandsk".

NB! Vælg den lille 3131bytes. Der er sourcen med. Hvis den afviser downloadf med "findes ikke" så klik på navnet Pedra Gardete og download den herfra. Der virker det.

Hvis du nu læser hvad jeg har skrevet længere oppe, så ville du se at jeg også fandt de komponenter du skriver om, men som sagt var linket dødt !!! Prøvede også at klikke på hans navn, men fik en fejl da jeg prøvede første gang. Den får jeg ikke nu, og har derfor hentet den, og vil nu kigge lidt på det !!!

Snowball

Prøv den her:

procedure Tform1.ScreenShot(ScreenCap : TBitmap);
var
  DeskDC : HDC;
  DeskCanvas : TCanvas;
  DeskRect : TRect;
begin
  DeskDC := GetWindowDC(GetDeskTopWindow);
  DeskCanvas := TCanvas.Create;
  DeskCanvas.Handle := DeskDC;
  DeskRect := Rect(0, 0, Screen.Width, Screen.Height);
  with ScreenCap do begin
    Width := Screen.Width;
    Height:= Screen.Height;
  end;
  ScreenCap.Canvas.CopyRect(DeskRect, DeskCanvas, DeskRect);
  DeskCanvas.Free;
  ReleaseDC(GetDesktopWindow, DeskDC);
end;

Screencap er det Tbitmap som Screenshottet vil blive gemt i den skal derfor erklæres under Public, og så skal du jo lige huske at create bitmappet først, men det kan du jo sikkert godt ellers kan det gøres således:

  image := tbitmap.create;
  ScreenShot(Image);

Mvh. _DJ_

dj: Jeg synes ikke lige helt jeg kan finde "hovede og hale" i dit program !!! Kan du ikke lige prøve og forklare det lidt nærmere ???

sjensen: Jeg får en fejl når jeg vil tilføje komponenterne i min D5 Ent.. Kan det ha' noget at gøre med at komponenterne er udviklet til D1 + D2 ??? Har du prøvet dem ???

Snowball

Snowball,

næh.. det har jeg nu ikke. Jeg tager aldrig en skærmkopi fra mit program, men jeg har da knapper brugerene kan trykke på efter at de har trykket på printscreen tasten, og på den måde få skærmbilledet gemt som en bitmap fil.

Men det eks. dj har lavet frigør helt de komponenter til sendkey jeg anbefalede. Det ser ud til at virke (jeg har ikke prøvet det, men bare set det igennem) så du burde kunne kopiere det direkte ind i din kode. Du skal dog lige lave et par små ændringer:

Enten skal det være en funktion der returnerer et bitmap billede:

skmkopi := screenshot;

eller også skal der stå VAR foran parametren i proceduren:

procedure Tform1.ScreenShot(VAR ScreenCap : TBitmap);

så hvis du laver en knap brugeren kan trykke på:

procedure TForm1.button1click(sender: tobject);
var img1 : timage;
begin
  img1 := timage.create;
  try
    screenshot(img1);
    img1.picture.savetofile('filnavn');
  finally
    img1.free;
  end;
end;

så burde det virke

dj>det er ikke får at tage æren af dit forslag, men jeg synes det er godt, og at du blot manglede at forklare det lidt bedre.

Det kører bare slet ikke for mig i dag !!! Får en masse "Missing operator or semicolon" og "Undeclared identifier" fejl !!!

Kigger lige på det når jeg kommer hjem !

Snowball

hvis du vil have det kan jeg lige sende et eksempel jeg lavede en eller anden gang.
Bare send en mail på rayman@superbruger.dk
så kan du lige få det.
Det benytter godt nok noget lignende kode, som dj har skrevet, men dette eksempel gemmer i jpg.

jensaa: Du må meget gerne sende dit eksempel til mig på michael@geertsen.net !

På forhånd tak

Snowball

Hej snowball

Sorry at jeg ikke har svaret på det sidste, men jeg har været 3 dage på ferie så har først lige set at du ikke kunne få det til at virke i dag.

jeg har bikset et lille eksempel sammen der skulle forklare nøjagtigt hvordan det gøres. følgende eksempel kan selvfølgelig forbedres en del man kunne lave en dialog der spurgte hvor filen skulle gemme osv. men da jeg ikke ved hvad du skal bruge det til helt præcist har jeg valgt at lave det så simplet som muligt.


-------------------------------------------------------

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, jpeg;  //Her tilføjes JPEG til uses listen sådan at vi kan anvende JPEG billeder

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    Scrdump: Tbitmap; //erklæres en global bitmap som screenshottet gemmes i
    JPEG: Tjpegimage;  //og en global JPEG billede
    procedure ScreenShot(ScreenCap : TBitmap);
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure Tform1.ScreenShot(ScreenCap : TBitmap); //her er så proceduren der laver screendumpet og gemmer det i ScrDump som vi erklærede tidligere.
var
  DeskDC : HDC;
  DeskCanvas : TCanvas;
  DeskRect : TRect;
begin
  DeskDC := GetWindowDC(GetDeskTopWindow);
  DeskCanvas := TCanvas.Create;
  DeskCanvas.Handle := DeskDC;
  DeskRect := Rect(0, 0, Screen.Width, Screen.Height);
  with ScreenCap do begin
    Width := Screen.Width;
    Height:= Screen.Height;
  end;
  ScreenCap.Canvas.CopyRect(DeskRect, DeskCanvas, DeskRect);
  DeskCanvas.Free;
  ReleaseDC(GetDesktopWindow, DeskDC);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  JPEG:= Tjpegimage.create;
  scrdump := tbitmap.create;
  ScreenShot(scrdump); //her kaldes Screendump proceduren med vores Bitmap som parameter
  JPEG.Assign(scrdump); //her ligger vi billedet over i JPEG billedet
  jpeg.ProgressiveEncoding:=true; //Vi vælger at komprimere billedet sådan at det fylder mindre du kan ændre 100 til et tal imellem 1-100 hvor 100 er best.
  jpeg.CompressionQuality:=100;
  jpeg.compress;
  JPEG.SaveToFile('C:\temp.jpg'); //gemmer til en fil, dette er unødvendigt hvis du skal bruge billedet i dit program, men det gør det nemt at se at programmet virker.
  jpeg.free; //Frigører resourcerne
  scrDump.free;
  showmessage('Saved to C:\temp.jpg');
end;

end.

-------------------------------------------------------------------

Jeg håber at det kunne kaste lidt lys over dine problemer :-)

mvh. _DJ_

Jeg sad lige og legede lidt videre med det :)

Hvis du ikke vil have dit program til at indgå i screendumpet så kan du udskifte Knappens Onclick event med den her:

----------------------------

procedure TForm1.Button1Click(Sender: TObject);
begin
  form1.hide;  //skjuler formen
  showwindow(application.handle, SW_HIDE); //fjerner programmet fra taskbaren
  JPEG:= Tjpegimage.create;
  scrdump := tbitmap.create;
  ScreenShot(scrdump);
  JPEG.Assign(scrdump);
  jpeg.ProgressiveEncoding:=true;
  jpeg.CompressionQuality:=100;
  jpeg.compress;
  JPEG.SaveToFile('C:\temp.jpg');
  jpeg.free;
  scrDump.free;
  showwindow(application.handle,SW_NORMAL); //viser programmet på taskbaren
  form1.show; //viser selve formen igen
  showmessage('Saved to C:\temp.jpg');
end;

-----------------------------

Men det er selvfølgelig kun hvis dit program ikke skal med i billedet, ellers kan du bare holde dig til den oprindelige :o)

Mvh. _DJ_

Jeg skal bare ha' et dump af ALT hvad der er på skærmen !

Kom til at tænke på noget, programmet skal køre i baggrunden, så virker det også hvis man f.eks. er inde i et spil ??? (det skulle det nemlig helst gøre !!!)

Snowball

Har lige testet det lidt, og det virker bare som det skal :-)

Har hævet pointtallet, og fordeler point'ene mellem jer, men selvfølgelig flest til DJ da han kom med det svar jeg kunne bruge

Tak for hjælpen !

Snowball