TÉMA:

Gyakori csapda windows rendszeren, hogy több típus és osztály neve megegyezik az LCL és a windows unitokban. Ezért ha a paraméterezés vagy a használat módja miatt reklamál a fordító akkor érdemes a windows unitot a előbbre venni vagy hátrébb tenni a uses szakaszban, illetve jó megoldás lehet az általad is használt direkt hivatkozás a forrásra (ha nem kell túl sokszor begépelni).

A "jpg" formátumba mentés pedig hihetetlenül egyszerű. Az előbbi példában csak egy picit kell változtatni:Természetesen nem minden fájltípussal működik, de a leggyakoribbak esetén igen. Betölteni egy képet ugyanílyen egyszerűen lehet a LoadFromFile metódussal.

Átolvasva a Graphics unit leírását, illetve a Developing_with_Graphics és az fcl-image című cikkeket, sok támpontot találhatsz a különböző képtípusokkal történő munkához.

Meg is van a hiba!

a Rect as jelen van a Windows unitban is és a Classes unitban is.

Ha azt írom:

rectangle1 :=Rect(0,0,W,H);

akkor a windows Rect-et veszi figyelembe, ha úgy írom:

rectangle1 := Classes.Rect(0,0,W,H);

akkor rendesen a program lefordul, és megfelelő screenshotot készít!!!

Nagyon Köszönöm a segítséget!

Még egy extra kérdés lehet?

JPEG unit nincs a lazarusban, hogyan lehetne JPG exportra rávenni a programot?

Üdv!

Copy Paste-el nem tudta nekem lefordítani, mert a Rect(0,0,W,H)-val igen komoly baja volt:

rectangle1 := Rect(0, 0, W, H);
unit1.pas(375,24) Fatal: Syntax error, ")" expected but "," found

a kurzor az első paraméternél áll meg Rect(0, (szóval a Tect az egy egyparaméteres eljárás?
Nem is értem!


ezért úgy rögtönöztem, hogy egy másik eljárásban már láttam a GetWindowRect-et,
ami viszont nem okozott fordítási hibát, így azt alkalmaztam:

var
win : hwnd;
..
...
rectangle1: TRect;
begin
....
...
GetWindowRect(Win, rectangle1);
// rectangle1 := Rect(0, 0, W, H);
Bitmap := Graphics.TBitmap.Create;
Bitmap.Width := W;
Bitmap.Height := H;

viszont így nem teljesen kaptam meg az egész formot, az eleje hiányos.... Ez vajon mitől lehet?

Mitől lehet, hogy Rect-et nem ismeri fel/nem fordítja le, ill. mitől lehet, hogy az ablak méretét nem pontosan kapja meg?

Nálam így működik:
Linux / Lazarus 1.9 (fejlesztői változat, de a korábbiakban is működnie kell)

Üdv!

Szerettem volna készíteni egy olyan rutint, ami megadott időközönként elment egy screenshotot a saját program form1-éről.

Három megoldást is találtam a neten, valahol kifejezetten lazarussal (tehát nem Delphi) készítették az eljárást, azonban én nálam mindhárom eljárás esetén a mentett BMP kép teljesen fekete.
3-ből két esetben a BMP mérete megegyezik a form1 méretével, tehát ez az információ átjön, de a képinformáció nem.

Mit csinálhatok rosszul? (lazarus 1.2.0 , FPC 2.4)


Első megoldás:

procedure TForm1.Button1Click(Sender: TObject);
const
FullWindow = True; // Set to false if you only want the client area.
var
Win: HWND;
DC: HDC;
BMP: Graphics.TBitmap;
FileName: string;
WinRect: TRect;
Width1: Integer;
Height1: Integer;
begin
//Form1.Hide;
try
Application.ProcessMessages; // Was Sleep(500);
Win := GetForegroundWindow;

if FullWindow then
begin
GetWindowRect(Win, WinRect);
DC := GetWindowDC(Win);
end else
begin
Windows.GetClientRect(Win, WinRect);
DC := GetDC(Win);
end;
try
Width1 := WinRect.Right - WinRect.Left;
Height1:= WinRect.Bottom - WinRect.Top;

BMP := Graphics.TBitmap.Create;

try
Bmp.Height := Height1;
Bmp.Width := Width1;
BitBlt(Bmp.Canvas.Handle, 0, 0, Width, Height, DC, 0, 0, SRCCOPY);
FileName := 'Screenshot_' +
FormatDateTime('mm-dd-yyyy-hhnnss', Now());
Bmp.SaveToFile(Format('%s.bmp', [FileName]));
finally
Bmp.Free;
end;
finally
ReleaseDC(Win, DC);
end;
finally
Form1.Show;
end;
end;

Második megoldás:

procedure SaveFormBitmapToBMPFile(AFileName : string = '' );
// Copies this form's bitmap to the specified file
var
Bitmap: Graphics.TBitMap;
begin
Bitmap := form1.GetFormImage;
Bitmap.SaveToFile(AFileName);
Bitmap.Free;

Harmadik Megoldás:

procedure CaptureScreen(ABitmap: Graphics.TBitmap);
var
vDesktopDC: HDC; // variable to store the device context handle of desktop window
begin
// get the device context handle of current desktop window
vDesktopDC := GetWindowDC(GetDesktopWindow);
try
// adjust the dimension and format of the supplied bitmap to match the screen
ABitmap.PixelFormat := pf24bit;
ABitmap.Height := Screen.Height;
ABitmap.Width := Screen.Width;

// draw the content of desktop into ABitmap
BitBlt(ABitmap.Canvas.Handle, 0, 0, ABitmap.Width, ABitmap.Height, vDesktopDC, 0, 0, SRCCOPY);
finally
// mark that we have done with the desktop device context
ReleaseDC(GetDesktopWindow, vDesktopDC);
end;
end;


procedure TForm1.Button6Click(Sender: TObject);
var
vJpg: TJpegImage;
vBmp: Graphics.TBitmap;
begin
// create temporary bitmap
vBmp := Graphics.TBitmap.Create;
try
CaptureScreen(vBmp);
// create Jpg image object
// vJpg := TJpegImage.Create;
try
vBmp.savetofile('screenshot.bmp');
// vJpg.Assign(vBmp);
// compress the image to have quality 70% of original
// vJpg.CompressionQuality := 70;
// save the captured screen into a file in jpg format
// vJpg.SaveToFile(AFileName);
finally
// vJpg.Free; //destroy the jpg image object
end;
finally
vBmp.Free; // destroy temporary bitmap
end;
end;