PB BitbltRésolu

Question

Bonjour J'ai des soucis avec l'API Bilblt je l'utilise pour faire des captures d'écrans J'ai au bout d'un moment une erreur "Espace insuffisant pour traiter cette commande" Lors de mes tests j’ai créé une classe Tcapture Tcapture = class(TObject) private imageCapture : tbitmap; procedure ScreenShot(x : integer; y : integer; Width : integer; Height : integer); procedure initActiveDesktop ; public constructor Create(image : tbitmap); destructor Destroy; override; procedure getCapture; end; implementation constructor Tcapture.Create(image : tbitmap); begin imageCapture := image; imageCapture.PixelFormat := pf8bit ; imageCapture.Height := screen.Height ; imageCapture.Width := screen.Width ; end; destructor Tcapture.Destroy ; begin // end; procedure Tcapture.getCapture; begin initActiveDesktop; ScreenShot(0,0,Screen.Width ,Screen.Height ); end; procedure Tcapture.initActiveDesktop ; var hThreadDesktop : THandle ; hInputDesktop : THandle ; dwSize : LongWord; inputName : Array [0..1023] of Char; currentName : Array [0..1023] of Char; begin hThreadDesktop := GetThreadDesktop(GetCurrentThreadId()); if hThreadDesktop <>0 then try hInputDesktop := OpenInputDesktop(0, FALSE, DESKTOP_CREATEMENU or DESKTOP_CREATEWINDOW or DESKTOP_ENUMERATE or DESKTOP_HOOKCONTROL or DESKTOP_WRITEOBJECTS or DESKTOP_READOBJECTS or DESKTOP_SWITCHDESKTOP or GENERIC_WRITE); if hInputDesktop <>0 then try GetUserObjectInformation(hInputDesktop, UOI_NAME, @inputName, 1023, dwSize); GetUserObjectInformation(hThreadDesktop, UOI_NAME, @currentName, 1023, dwSize); if StrIComp(inputName, currentName)<> 0 then SetThreadDesktop(hInputDesktop); finally CloseDesktop(hInputDesktop ); end; finally CloseDesktop(hThreadDesktop); end; end; procedure Tcapture.ScreenShot(x : integer; y : integer; Width : integer; Height : integer); var dc: HDC; begin if ((Width 0) OR (Height 0)) then exit; imageCapture.Width := Width; imageCapture.Height := Height; dc := GetDc(0); if (dc = 0) then exit; ReleaseDc(0, dc); end; Quand j’utilise cette classe dans un programme simple pas de soucie procedure TForm1.Timer1Timer(Sender: TObject); var dep,fin : TDateTime ; begin timer1.Enabled := false; CCapture.getcapture; Image1.Picture.Bitmap:=(imgtemp ); Image1.Picture.Bitmap.PixelFormat := pf8bit ; image1.Refresh ; timer1.Enabled := true; end; par contre lors de l’utilisation dans un Service là plantage idem dans un thread tthrCapture = class(TThread) private { Déclarations privées } varcapture : Tcapture ; protected procedure Execute; override; public captureOK : boolean; finok : boolean; constructor create (img : tbitmap); end; implementation { tthrCapture } uses unit1; constructor tthrCapture.create (img : tbitmap); begin FreeOnTerminate := true; inherited Create(true); varcapture := Tcapture.Create(img); captureOK := false; finok := false; end; procedure tthrCapture.Execute; begin repeat if not captureok then begin varcapture.getCapture ; captureok := true; end; sleep(30); until finok ; end; Cela se produit apres la premiere capture quand le PixelFormat est defini sur pf8bit dans ma classe tcapture si je le defini en PF32bit là le plantage arrive moins souvent si vous avez une idée je suis preneur

florenth · Accepted Answer

Salut, 

Tu as essayé de vérrouiller le canvas avant de dessiner dedans ? Essaye avec imageCapture.Canvas.Lock avant l'appel à BitBlt() et imageCapture.Canvas.Unlock après.

En fait, il faut faire ça, à CHAQUE utilisation du canvas si tu as une application multi-thread, ça explique peut etre le problème...

Par contre, tu es sur que ça ne vient pas du code que tu as *nottoyé* avant de poster ?
Ou sinon, tu pourrais nous dire la ligne exacte de l'erreur ?

++

cs_rt15 · Answer

Salut,

Je ne vois pas ton BitBlt...

Tu est sûre de ton code de création de la bitmap (on ne le voie pas ici) ?

Nottement, il faut peut être que tu travail sur CreateCompatibleDC et CreateCompatibleBitmap.

Cherche ses routines dans le sdk Win32 fournie avec Delphi.

fbalien · Answer

Arf à vouloir trop nettoyer j'avais viré une ligne de trop




procedure Tcapture.ScreenShot(x : integer; y : integer; Width : integer; Height : integer);

var
  dc: HDC;
begin  if ((Width 0) OR (Height 0)) then exit;
  imageCapture.Width := Width;
  imageCapture.Height := Height;

  dc := GetDc(0);
  BitBlt(imageCapture.Canvas.Handle,0,0,Width,Height,Dc,x,y,SRCCOPY);
  if (dc = 0) then exit;

  ReleaseDc(0, dc);
end;

pour la création du Bitmap 
imgtemp := TBitmap.Create ;

cs_rt15 · Answer

Place peut être la taille avant le changement de format :

  imageCapture.Height := screen.Height ;
  imageCapture.Width := screen.Width ;
  imageCapture.PixelFormat := pf8bit ;


Un articlequi a l'air pas mal sur le sujet.

DRJEROME · Answer

Salut,

je n'ai pas regardé de près mais quand on fait un "create" il faut libérer par la suite la mémoire (free... ou autre méthode)

DrJerome

fbalien · Answer

RT15
  çà ne change pas grand chose
  merci pour l'article

DRJEROME
  Oui en effet mais je n'ai mis qu'une partie du code

fbalien · Answer

pour le *nottoyé* j'ai juste viré les commentaires
la ligne qui plante c'est 
  BitBlt(imageCapture.Canvas.Handle,0,0,Width,Height,Dc,x,y,SRCCOPY);
apres d'autres tests
j'ais fait ceci
try
  BitBlt(imageCapture.Canvas.Handle,0,0,Width,Height,Dc,x,y,SRCCOPY);
except
on e:exception do
  imageCapture.canvas.TextOut(10,10,e.message);
end;

j'ai l'erreur sur la ligne Bitblt et aussi sur  imageCapture.canvas.TextOut(10,10,e.message);
je vais donc tenter le canvas.lock

fbalien · Answer

Merci Florenth
Avec canvas.lock çà marche nikel
le tous maintenant c'est de bien gérer les lock et unlock car apparemment çà fige le programme s'il y en a un de plus donc petite boucle sur lockcount et çà roule

PB Bitblt

8 réponses

Votre réponse

Discussions similaires