screenshot a main formról, de csak fekete a kép
- Gábor
-
- Adminisztrátor
-
- Hozzászólások: 436
- Karma: 8
- Köszönetek: 70
Gábor válaszolt a témára: screenshot a main formról, de csak fekete a kép
A "jpg" formátumba mentés pedig hihetetlenül egyszerű. Az előbbi példában csak egy picit kell változtatni:
Image.Picture.SaveToFile('ablaktartalma.jpg');
Á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.
- robotech
-
- Haladó fórumozó
-
- Hozzászólások: 28
- Köszönetek: 0
robotech válaszolt a témára: screenshot a main formról, de csak fekete a kép
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?
- robotech
-
- Haladó fórumozó
-
- Hozzászólások: 28
- Köszönetek: 0
robotech válaszolt a témára: screenshot a main formról, de csak fekete a kép
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?
- Gábor
-
- Adminisztrátor
-
- Hozzászólások: 436
- Karma: 8
- Köszönetek: 70
Gábor válaszolt a témára: screenshot a main formról, de csak fekete a kép
var
Image: TImage;
Bitmap: TBitmap;
W, H: Integer;
R: TRect;
begin
// bitkép létrehozása, melynek mérete az ablak méretével egyenlő
W := Form1.Width;
H := Form1.Height;
R := Rect(0, 0, W, H);
Bitmap := TBitmap.Create;
Bitmap.Width := W;
Bitmap.Height := H;
// ablak rajzlapjának tartalmát átmásoljuk a bitképbe
Bitmap.Canvas.CopyRect(R, Form1.Canvas, R);
// kép létrehozása és mentése a memóriabeli bitkép alapján
Image := TImage.Create(Self);
Image.Picture.Bitmap.Assign(Bitmap);
Image.Picture.SaveToFile('ablaktartalma.bmp');
//megsemmisítés
Image.Destroy;
Bitmap.Destroy;
end;
- robotech
-
- Haladó fórumozó
-
- Hozzászólások: 28
- Köszönetek: 0
robotech létrehozta a témát: screenshot a main formról, de csak fekete a kép
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;