Re: nur weiße screenshotes
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.
|
Re: nur weiße screenshotes
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 |
Re: nur weiße screenshotes
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; |
Re: nur weiße screenshotes
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.
|
Re: nur weiße screenshotes
Falls du noch suchen willst: Benutze MemCheck
|
Re: nur weiße screenshotes
Zitat:
|
Re: nur weiße screenshotes
bitte schön:
Delphi-Quellcode:
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
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; |
Alle Zeitangaben in WEZ +1. Es ist jetzt 09:27 Uhr. |
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz