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

PhilLu 245 Messages postés lundi 9 novembre 2009Date d'inscription 10 octobre 2017 Dernière intervention - 26 mai 2017 à 17:51 - Dernière réponse : korgis 392 Messages postés samedi 17 mai 2003Date d'inscription 24 novembre 2017 Dernière intervention
- 26 mai 2017 à 23:47
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
Afficher la suite 

2 réponses

Répondre au sujet
PhilLu 245 Messages postés lundi 9 novembre 2009Date d'inscription 10 octobre 2017 Dernière intervention - 26 mai 2017 à 20:20
0
Utile
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 :-)
Commenter la réponse de PhilLu
korgis 392 Messages postés samedi 17 mai 2003Date d'inscription 24 novembre 2017 Dernière intervention - 26 mai 2017 à 23:47
0
Utile
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;

Commenter la réponse de korgis

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.