Screenshots erstellen. Canvas not allow to draw / Out of system resources

[gee21]

Hallo Ich möchte mit den beiden untenstehenden Proceduren/Functionen den Bildschirm auslesen mit Screenshots. (1+2 lesen den Desktop mit Mauszeiger aus und Nr3 liest Desktop ohne Mauszeiger aus). Funktioniert soweit alles wie gewünscht aber nach 5-30 Minuten kommen Fehlermeldungen.

Gemäss den Fehlermeldungen gibt es wohl Probleme bei zugriff von Handle/Canvas oder es wird wohl irgendetwas nicht mehr freigegeben. (vermute ich mal). ich habe diverses auf google dazu gefunden.(Canvas.lock, .free anstatt. destroy, ReleaseDC und bitmap freigeben nicht vergessen) leider konnte ich keine Lösung finden die für mich funktioniert hat. Und es ist etwas schwierig zu testen da es manchmal bis zu 30 min einwandfrei funktioniert.

Noch wichtig zu wissen: Ich rufe die Proceduren in einem Timer mit 200ms durchgehend ab.
Weiss jemand an was es liegen könnte? Und gibt es eine "einfache Lösung"?

Fehlermeldungen:

Code:

Maus Fehler: Falscher Parameter.
Maus Fehler: Falscher Parameter.
Maus Fehler: Falscher Parameter.
Maus Fehler: Out of system resources
Maus Fehler: Falscher Parameter.
Maus Fehler: Falscher Parameter.
Maus Fehler: Out of system resources
Maus Fehler: Falscher Parameter.
Maus Fehler: Out of system resources
Fehler: Screen 2 pic:Das Handle ist ungültig.
Fehler: Screen 2 pic:Out of system resources
Fehler: Screen 2 pic:Out of system resources
Fehler: Screen 2 pic:Out of system resources
Maus Fehler: Out of system resources
Maus Fehler: Das Handle ist ungültig.
Fehler: Screen 2 pic:Canvas does not allow drawing
Fehler: Screen 2 pic:Out of system resources
Fehler: Screen 2 pic:Out of system resources
Fehler: Screen 2 pic:Out of system resources
Maus Fehler: Out of system resources
Maus Fehler: Das Handle ist ungültig.

Geht dann immer so weiter.

Delphi-Quellcode:

// 1. Get the handle to the current mouse-cursor and its position
function GetCursorInfo2: TCursorInfo;
var
 hWindow: HWND;
 pt: TPoint;
 pIconInfo: TIconInfo;
 dwThreadID, dwCurrentThreadID: DWORD;
begin
  try
 Result.hCursor := 0;
 ZeroMemory(@Result, SizeOf(Result));
 // Find out which window owns the cursor
 if GetCursorPos(pt) then
 begin
   Result.ptScreenPos := pt;
   hWindow := WindowFromPoint(pt);
   if IsWindow(hWindow) then
   begin
     // Get the thread ID for the cursor owner.
     dwThreadID := GetWindowThreadProcessId(hWindow, nil);

     // Get the thread ID for the current thread
     dwCurrentThreadID := GetCurrentThreadId;

     // If the cursor owner is not us then we must attach to
     // the other thread in so that we can use GetCursor() to
     // return the correct hCursor
     if (dwCurrentThreadID <> dwThreadID) then
     begin
       if AttachThreadInput(dwCurrentThreadID, dwThreadID, True) then
       begin
         // Get the handle to the cursor
         Result.hCursor := GetCursor;
         AttachThreadInput(dwCurrentThreadID, dwThreadID, False);
       end;
     end
     else
     begin
       Result.hCursor := GetCursor;
     end;
   end;
 end;
 except on e: exception do addline('Fehler getcursorinfo2:'+e.Message);  end;
 end;

// 2. Capture the screen
procedure CaptureScreen (ImageKomp: TBitmap);
var
 DC: HDC;
 ABitmap: TBitmap;
 MyCursor: TIcon;
 CursorInfo: TCursorInfo;
 IconInfo: TIconInfo;
 MausPos: TPoint;
begin
try
 // Capture the Desktop screen
 DC := GetDC(GetDesktopWindow);
 ABitmap := TBitmap.Create;
 try
   ABitmap.Width  := 25;// GetDeviceCaps(DC, HORZRES);
   ABitmap.Height := 25;// GetDeviceCaps(DC, VERTRES);
   // BitBlt on our bitmap

   GetCursorPos(MausPos);

   BitBlt(ABitmap.Canvas.Handle,
     0,
     0,
     ABitmap.Width,
     ABitmap.Height,
     DC,
     MausPos.x - form1.Image_maus.Width div 2, //left
     MausPos.y - form1.Image_maus.height div 2,//top
     SRCCOPY);
   // Create temp. Icon
   MyCursor := TIcon.Create;
   try
     // Retrieve Cursor info
     CursorInfo := GetCursorInfo2;
     if CursorInfo.hCursor <> 0 then
     begin
       MyCursor.Handle := CursorInfo.hCursor;
       // Get Hotspot information
       GetIconInfo(CursorInfo.hCursor, IconInfo);
     // Draw the Cursor on our bitmap
       ABitmap.Canvas.Draw( -20-IconInfo.xHotspot,
                            -15-IconInfo.yHotspot, MyCursor);
     end;
   finally
     // Clean up
     MyCursor.ReleaseHandle;
     MyCursor.Free;
   end;

   form1.image_maus.picture.bitmap:=abitmap;
 finally
   ReleaseDC(GetDesktopWindow, DC);
   abitmap.Free;
 end;

except on e:exception do addline('Maus Fehler: '+e.Message); end;

end;

Delphi-Quellcode:

//3 Screenshot ohne Mauszeiger
procedure ScreenToImage( hoch: integer; breit: integer; oben:integer; links:integer; picturebild:timage);
var 
   Bitmap: TBitmap;
   Canvas: TCanvas;
begin
  try
   Canvas := TCanvas.Create;
   Canvas.Lock;
   try
     Canvas.Handle := GetWindowDC(0);
     try
       picturebild.Picture:=nil;
       Bitmap :=  TBitmap.Create;
       try
         Bitmap.Width := breit;
         Bitmap.Height:= hoch;
         Bitmap.PixelFormat := pf32bit;
         BitBlt(Bitmap.Canvas.Handle, 0, 0, Pred(Screen.DesktopWidth), Pred(
         Screen.DesktopHeight), Canvas.Handle, Screen.DesktopLeft+links,
         Screen.DesktopTop+oben, Bitmap.Canvas.CopyMode);
         picturebild.Picture.assign(bitmap);
       finally
        Bitmap.Free;
       end;
     finally
       ReleaseDC(0, Canvas.Handle);
     end;
   finally
     canvas.Unlock;//im internet gefunden. hilft aber nicht
   Canvas.Free;
   end;
   except on e: exception do addline('Fehler: Screen 2 pic:'+e.message); end;
end;