PB Bitblt [Résolu]

Signaler
Messages postés
251
Date d'inscription
dimanche 7 décembre 2003
Statut
Membre
Dernière intervention
11 novembre 2016
-
Messages postés
251
Date d'inscription
dimanche 7 décembre 2003
Statut
Membre
Dernière intervention
11 novembre 2016
-
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

8 réponses

Messages postés
1023
Date d'inscription
dimanche 1 août 2004
Statut
Membre
Dernière intervention
17 août 2008
1
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 ?

++
Messages postés
3874
Date d'inscription
mardi 8 mars 2005
Statut
Modérateur
Dernière intervention
7 novembre 2014
13
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.
Messages postés
251
Date d'inscription
dimanche 7 décembre 2003
Statut
Membre
Dernière intervention
11 novembre 2016

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 ;
Messages postés
3874
Date d'inscription
mardi 8 mars 2005
Statut
Modérateur
Dernière intervention
7 novembre 2014
13
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.
Messages postés
436
Date d'inscription
jeudi 9 janvier 2003
Statut
Membre
Dernière intervention
5 février 2015

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
Messages postés
251
Date d'inscription
dimanche 7 décembre 2003
Statut
Membre
Dernière intervention
11 novembre 2016

RT15
çà ne change pas grand chose
merci pour l'article

DRJEROME
Oui en effet mais je n'ai mis qu'une partie du code
Messages postés
251
Date d'inscription
dimanche 7 décembre 2003
Statut
Membre
Dernière intervention
11 novembre 2016

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
Messages postés
251
Date d'inscription
dimanche 7 décembre 2003
Statut
Membre
Dernière intervention
11 novembre 2016

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