Problème copie d'écran des champs déroulants [Résolu]

Signaler
Messages postés
251
Date d'inscription
lundi 9 novembre 2009
Statut
Membre
Dernière intervention
11 mai 2021
-
Messages postés
420
Date d'inscription
samedi 17 mai 2003
Statut
Membre
Dernière intervention
6 mai 2019
-
Bonjour,
Je dois copier un écran contenant des champs edit et combobox.
J'utilise le code suivant:
bmp := Tbitmap.create;
Onglets.ActivePage:=method;
Onglets.ActivePage.Repaint;
Bmp.Width := method.Width;
Bmp.Height := method.Height;
method.PaintTo(Bmp.Canvas, 0, 0);
sleep(500); // pas mieux
bmp.SaveToFile(VMProjectPath.text+'P1.bmp');
bmp.free;
WaitBar.position:=WaitBar.position+1;


J'obtiens bien une copie d'écran mais les champs combobox sont vides (les champs edit sont visibles)
J'ai tenté des repaint sur les combo mais pas mieux :(
J'ai ajouté une temporosation, idem :-/
HELP

Merci pour vos idées
;)
Phil

2 réponses

Messages postés
251
Date d'inscription
lundi 9 novembre 2009
Statut
Membre
Dernière intervention
11 mai 2021

Voilà, j'ai trouvé ;-)
bmp := Tbitmap.create;
Onglets.ActivePage:=method;
Onglets.ActivePage.Repaint;
try
Bmp.Width := method.Width;
Bmp.Height := method.Height;
Srcdc:=GetDC(method.Handle);//nouveau
try
BitBlt(bmp.Canvas.Handle,0,0,method.ClientWidth,method.ClientHeight,Srcdc,0,0,SRCCOPY);
finally
ReleaseDC(method.Handle, Srcdc);
end;
bmp.SaveToFile(VMProjectPath.text+'P1.bmp');
finally
bmp.Free;
end;

Ca peut servir :-)
Messages postés
420
Date d'inscription
samedi 17 mai 2003
Statut
Membre
Dernière intervention
6 mai 2019
16
Salut,

On peut également créer deux procédures utilisables pour capturer tous les TWinControl (y compris le TPageControl avec ses listes déroulantes...)

vers un fichier bitmap :

procedure ControlToBitmapFile(AControl: TWinControl; FileName: string);
var
  DC: HDC;
begin
  if not Assigned(AControl) then Exit;
  DC := GetWindowDC(AControl.Handle);
  try
    with TBitmap.Create do
    try
      Width := AControl.Width;
      Height := AControl.Height;
      BitBlt(Canvas.Handle, 0, 0, Width, Height, DC, 0, 0, SrcCopy);
      SaveToFile(FileName);
    finally
      Free;
    end;
  finally
    ReleaseDC(AControl.Handle, DC);
  end;
end;


vers un TBitmap :


procedure ControlToBitmap(AControl: TWinControl; Bmp: TBitmap);
var
  DC: HDC;
begin
  if not Assigned(AControl) or not Assigned(Bmp) then Exit;
  DC := GetWindowDC(AControl.Handle);
  try
    with Bmp do
    begin
      Width := AControl.Width;
      Height := AControl.Height;
      BitBlt(Canvas.Handle, 0, 0, Width, Height, DC, 0, 0, SrcCopy);
    end;
  finally
    ReleaseDC(AControl.Handle, DC);
  end;
end;