[delphi] szybki zrzut ekranu nie zawieszający pracy

0

Robiłem już zrzuty wieloma sposobami, niestety zawsze podczas robienia zdięcia program zawiesza na około 0,5sec myszkę/pracę na kompie i jest to uporczywe.

Pracuję nad programem do np nagrywania zawartości pulpitu podczas gry, na razie chcę jedynie aby zapisywał się do plików jpg co ok kilka sekund, niestety zawiesza na 0,5 kompa podczas zdięcia:(

znalazłem fajną funkcię :

const cTileSize = 50;
function TForm1.GetScreenShot: TBitmap;
var X, Y, XS, YS : Integer;
Locked : Boolean;
Canvas : TCanvas;
R : TRect;
begin
Result := TBitmap.Create;
Result.Width := Screen.Width;
Result.Height := Screen.Height;
Canvas := TCanvas.Create;
Canvas.Handle := GetDC(0);
Locked := Canvas.TryLock;
try
XS := Pred(Screen.Width div cTileSize);
if Screen.Width mod cTileSize > 0 then
Inc(XS);
YS := Pred(Screen.Height div cTileSize);
if Screen.Height mod cTileSize > 0 then
Inc(YS);
for X := 0 to XS do
for Y := 0 to YS do
begin
R := Rect(
X * cTileSize, Y * cTileSize, Succ(X) * cTileSize,
Succ(Y) * cTileSize);
Result.Canvas.CopyRect(R, Canvas, R);
end;
finally
if Locked then
Canvas.Unlock;
ReleaseDC(0, Canvas.Handle);
Canvas.Free;
end;
end

Robi kilka małych zrzutów i łączy w jeden :) i zwraca jako tbitmap, jest ona zajedwabista i spełnia moje wymagania, ale nie mogę jej użyć wiecej niż kilka razy bo program się zwiesza.
Pewnie jest to spowodowane tym, że nie jest zwraca pamieci po operacji czyli brak np. GetScreenShot.Free / czy wie ktoś jak zwolnić pamięć? albo jak przedłużyć możliwość wykonywania tej funkcji?

0

Zrób to w wątku.

0

Wpisanie linijki:
Application.ProcessMessages;
po na przykład:
Result.Canvas.CopyRect(R, Canvas, R);
powinno pomóc

0

przerób na procedurę

procedure TForm1.GetScreenShot(BMP: TBitmap):

nie musi być var, bo BMP to wskaźnik.

0

co do wątków, to też muszę zwalniać mem.

Force mi nie zwiesza programu tylko myszką i pracę w windows wiec Aplication.porcessmessages tu nie pomoże.

Misiekd napisał(a)

przerób na procedurę

procedure TForm1.GetScreenShot(BMP: TBitmap):

nie musi być var, bo BMP to wskaźnik.

dzięki, że też na to nie wpadłem [browar], wyprobuję wieczorkiem.

0

zasada jest prota tworz tablice i zapisuj tam obraz nastepnie zapisuj. Zawsze bedzie spadek wydajnosci! chocby nie wiem co by robil :0

0

Ten program zapisuje na bieżąco na dysku?

0

jak nie chcesz wieszać to może po prostu nie blokuj ekranu - usuń linijki z Canvas.TryLock i Canvas.Unlock; a i rób na jednej bitmapie jak powyżej a nie tak jak jest że tworzysz ciągle nową

0

Ja napisałem taką procedurke :

procedure TForm1.ScreenJpg(kompr:integer);
var
Im: TJpegImage;
Rozd : packed record
X, Y : Integer; //p. roz.
end;
begin
Rozd.X := GetSystemMetrics(SM_CXSCREEN);
Rozd.Y := GetSystemMetrics(SM_CYSCREEN); // pobranie rozdzielczosci
image1.Width:=rozd.X-100;
image1.Height:=rozd.Y-100;
image1.Visible:=true;
Im := TJpegImage.Create;
Canvas.Handle := GetWindowDC(GetDesktopWindow);
image1.Canvas.CopyRect(image1.ClientRect, canvas, screen.DesktopRect);
image1.Picture.SaveToFile(win+'scr010.jpg');
Im.Assign(Image1.Picture.Bitmap);
Im.CompressionQuality:=kompr;
Im.Compress;
Im.SaveToFile(win+'scr010.jpg');
Im.Free;
image1.Visible:=false;
end;

Może Ci się przyda , co o niej myślicie ? jakieś udoskonalenia ?

1 użytkowników online, w tym zalogowanych: 0, gości: 1