nur weiße screenshotes

[Harry M.]

also der code ist sehr gut einfach wie genial, besonders das mit dem mauszeiger das der mit drauf ist. auf meiner kist läuft es wieder super... nur auf dem anderen rechner wiedermal nicht. nen anderer kollege hat aber das gleiche problem.

[Harry M.]

guten morgen

also ich habe mir gestern abend mal die funktionen zugemüte geführt. so begeister wie ich anfangs war bin ich es nun leider nicht mehr. schon nach wenigen durchläufen (nämlich 43) sind die resourcen erschöpft. und zwar gänzlich... ich hatte testweise den ram auf nur 64mb bei win2k schrumpfen lassen. ich bleibe da lieber bei "meinen" oben schon dargestellten funktionen. die sind für meine zwecke wesendlich besser weil resourcen-sparender (bei über 200 durchläufen ging immer noch alles normal). da ist zwar nicht der mauszeiger drauf aber ich kucke mal ob ich das irgendwie zusammen kriege.

vielleicht kann mir ja jemand von den DP'lern unter die arme greifen

[Sharky]

Hai Harry M.

es könnte daran liegen das in dem Code bei jedem Capturen ein TBitmap erzeugt wird das nicht mehr freigegeben wird?

Delphi-Quellcode:

// 2. Capture the screen 
function CaptureScreen: TBitmap; 
var 
  DC: HDC; 
  ABitmap: TBitmap; 
  MyCursor: TIcon; 
  CursorInfo: TCursorInfo; 
  IconInfo: TIconInfo; 
begin 
  // Capture the Desktop screen 
  DC := GetDC(GetDesktopWindow); 
  ABitmap := TBitmap.Create;  // Hier zu sehe ich kein ABitmap.Free;
  .
  .
end;

[Harry M.]

ich konnte mir schon denken das da das bitmap objekt nicht wiederfreigegeben wird. meine modifizierungan am code brachten aber nie das gewünschte ergebnis. da ich es aber vor 10min geschaft habe, in den code den ich verwendet also nicht das von den schweitzern, die sache mit den corsur einzubinden, ist das eigendlich auch schon hinfällig. ich kucke aber trozdem mal wo bei mir der fehler lag kann ja nicht schaden.

[Khabarakh]

Falls du noch suchen willst: Benutze MemCheck

[Assun]

Zitat von Harry M.:

ich konnte mir schon denken das da das bitmap objekt nicht wiederfreigegeben wird. meine modifizierungan am code brachten aber nie das gewünschte ergebnis. da ich es aber vor 10min geschaft habe, in den code den ich verwendet also nicht das von den schweitzern, die sache mit den corsur einzubinden, ist das eigendlich auch schon hinfällig. ich kucke aber trozdem mal wo bei mir der fehler lag kann ja nicht schaden.

könntest du mir mal deinen Code posten ? wär echt interessant !

[Harry M.]

bitte schön:

Delphi-Quellcode:

uses Jpeg;
var 
  PIC : TImage;
  fNameJPG, S : string;

////////////////////////////////////////////////////////////////////////////////
function GetCursorInfo2: TCursorInfo; 
var 
hWindow: HWND; 
pt: TPoint; 
pIconInfo: TIconInfo; 
dwThreadID, dwCurrentThreadID: DWORD; 
begin 
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; 
end;  
////////////////////////////////////////////////////////////////////////////////
function setJPGFileName(fbmp: string):string;
var
  I : integer;
begin
  s := ExtractFileName(fbmp);
  for i := 1 to 3 do Delete(s,Length(s),1);
  result := s + 'JPG'
end;
////////////////////////////////////////////////////////////////////////////////
procedure ScreenShot(Bild: TBitMap);  
var  
  c: TCanvas;
  r: TRect;
  MyCursor: TIcon; 
  CursorInfo: TCursorInfo;
  IconInfo: TIconInfo;
begin  
  c := TCanvas.Create;  
  c.Handle := GetWindowDC(GetDesktopWindow);
  try
    r := Rect(0, 0, Screen.Width, Screen.Height);
    Bild.Width := Screen.Width;
    Bild.Height := Screen.Height;
    Bild.Canvas.CopyRect(r, c, r);


      // 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
       Bild.Canvas.Draw(CursorInfo.ptScreenPos.X - IconInfo.xHotspot, CursorInfo.ptScreenPos.Y - IconInfo.yHotspot, MyCursor);
     end;
   finally
     // Clean up
     MyCursor.ReleaseHandle;
     MyCursor.Free;
   end;


  finally
    ReleaseDC(0, c.Handle);  
    c.Free;
  end;
end;
////////////////////////////////////////////////////////////////////////////////

// screenshot machen
ScreenShot(Image1.Picture.BitMap);

// konvertieren
Try
pic := TImage.Create(nil);
pic.Picture := Image1.Picture;
with TJPEGImage.Create do begin
  Performance := jpBestQuality;
  CompressionQuality := 20;
  Assign(pic.Picture.Graphic);
  //fNameJPG := setJPGFileName('Temp.bmp');
  SaveToFile('Temp.jpg');
  Free
  end;
except; end;
pic.Free;

das der cursor nun mit angezeigt wird, lässt aber die resourcen wieder etwas mehr in anspruch nehmen. kommentiere das dann einfach aus um den unterschied festzustellen