Discussion :

[KlausGunther]

Salut à tous,

Je développe une DLL en Dlephi 6, et je rencontre un problème avec l'API OutText.

Voici mon code:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
 
var                                         // mes variables globales
        ShowPageHandle: hWnd;           // handle de la page créée
        ShowCanvasHandle: HDC;          // DC du canvas du picture sur la page créé
 
 
function Test(const funct: integer): integer; stdcall; export;
var
        FDialog: TForm;
        Image: TImage;
        hnd: hWnd;
begin
        hnd := FindWindow(nil,'TestWindow');                // je cherche si ma fenêtre existe
        if hnd=0 then begin                                         // si non: cas normal: je la crée
               FDialog := TForm.Create(nil);                // création de la fenêtre
               ShowPageHandle := FDialog.Handle;       // mémoriser son handle
               FDialog.Caption := 'TestWindow';           // installer son titre
               Image := TImage.Create(FDialog);          // créer une image
               Image.Parent :=  FDialog;                     // la placer sur ma fenêtre
               Image.Height := printer.PageHeight/4;    // forcer les dimensions
               Image.Width := printer.PageWidth/4;
               ShowCanvasHandle := Image.Canvas.Handle;  // mémoriser de DC de l'image
                        // les fonctions suivantes marchent parfaitement:
               Image.Canvas.Font.Name := 'Arial';
               Image.Canvas.Font.Size := 12;
               Image.Canvas.Pen.Color := clBlack;
               Image.Canvas.TextOut(0,0,format('Page %d',[PageNumber]));
               Image.Canvas.Rectangle(100,100,900,900);
                         // les fonctions suivantes NE MARCHENT PAS:
               SetBkMode(ShowCanvasHandle, TRANSPARENT);
               TextOut(ShowCanvasHandle,50,50,'Ligne 2',7);
                         // les fonctions suivantes marchent parfaitement:
               TextOut(image.Canvas.Handle,75,75,'Ligne 3',7);
               Image.Canvas.TextOut(50,100,'Ligne 4');
               FDialog.Update;
               FDialog.Show;
        end else begin
               showmessage('La fenêtre est déjà ouverte !');
        end;
end;

Il s'agit d'un extrait de ma DLL qui contient beaucoupt de fonctions déjà opérationnelles. Mais je n'arrive pas à comprendre pourquoi l'API OutText ne marche pas sur mon DC chargé par Image.Canvas.Handle, alors que la fonction Image.Canvas.OutText marche parfaitement.

Qu'est-ce que j'ai mal compris ? Merci de votre aide !

[ShaiLeTroll]

Vérifie si l'objet ne change pas de handle lors de l'application d'une nouvelle font !

[KlausGunther]

J'ai ajouté un showmessage comme suit:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
 
var                                         // mes variables globales
        ShowPageHandle: hWnd;           // handle de la page créée
        ShowCanvasHandle: HDC;          // DC du canvas du picture sur la page créé
 
 
function Test(const funct: integer): integer; stdcall; export;
var
        FDialog: TForm;
        Image: TImage;
        hnd: hWnd;
begin
        hnd := FindWindow(nil,'TestWindow');                // je cherche si ma fenêtre existe
        if hnd=0 then begin                                         // si non: cas normal: je la crée
               FDialog := TForm.Create(nil);                // création de la fenêtre
               ShowPageHandle := FDialog.Handle;       // mémoriser son handle
               FDialog.Caption := 'TestWindow';           // installer son titre
               Image := TImage.Create(FDialog);          // créer une image
               Image.Parent :=  FDialog;                     // la placer sur ma fenêtre
               Image.Height := printer.PageHeight/4;    // forcer les dimensions
               Image.Width := printer.PageWidth/4;
               ShowCanvasHandle := Image.Canvas.Handle;  // mémoriser de DC de l'image
        showmessage(format('A: handle=%x',[ShowCanvasHandle]));
                        // les fonctions suivantes marchent parfaitement:
               Image.Canvas.Font.Name := 'Arial';
               Image.Canvas.Font.Size := 12;
               Image.Canvas.Pen.Color := clBlack;
               Image.Canvas.TextOut(0,0,format('Page %d',[PageNumber]));
               Image.Canvas.Rectangle(100,100,900,900);
                         // les fonctions suivantes NE MARCHENT PAS:
               ShowCanvasHandle := Image.Canvas.Handle;  // mémoriser de DC de l'image à nouveau
        showmessage(format('B: handle=%x',[ShowCanvasHandle]));
               SetBkMode(ShowCanvasHandle, TRANSPARENT);
               TextOut(ShowCanvasHandle,50,50,'Ligne 2',7);
                         // les fonctions suivantes marchent parfaitement:
               TextOut(image.Canvas.Handle,75,75,'Ligne 3',7);
               Image.Canvas.TextOut(50,100,'Ligne 4');
               FDialog.Update;
               FDialog.Show;
        end else begin
               showmessage('La fenêtre est déjà ouverte !');
        end;
end;

Effectivement, le handle a changé. Je ne comprends pas pourquoi, d'ailleurs. Mais peu importe: maintenant, je le recharge comme dans le code ci-dessus, mais j'ai toujours le même problème. Je charge image.canvas.handle dans la variable ShowCanvasHandle. J'utilise cette variable immédiatement pou rmon API - sans résultat. Le même API juste derrière en passant image.canvas.handle en paramètre fonctionne bien. Est-ce que j'ai un problème de passage de paramètres ? Ma variable ShowCanvasHandle est typé hDC.

EDIT

J'ai essayé de multiples façons, mais j'ai toujours le même constat:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
 
               ShowCanvasHandle := Image.Canvas.Handle;  // mémoriser de DC de l'image à nouveau
               SetBkMode(ShowCanvasHandle, TRANSPARENT);
               TextOut(ShowCanvasHandle,50,50,'Ligne 2',7);

ne fonctionne pas, alors que la ligne immédiatement suivante:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 
               TextOut(image.Canvas.Handle,75,75,'Ligne 3',7);

fonctionnne parfaitement. Où est mon erreur ? je ne comprends pas !

[KlausGunther]

Je continue à tâtonner, mais le constat reste identique: le device context passé via une variable déclarée pourtant HDC ne marche pas, mais passé par image.canvas.handle ça marche. Est-ce que je n'ai vraiment rien compris ? Juste une précision: j'utilise Delphi 6...

[KlausGunther]

Est-ce que le problème est trop trivial pour que quelqu'un s'y intéresse, ou est-ce que je suis tombé sur un os ? En tout cas, je suis bloqué, je patauge sans succès. J'apprécierais vraiment qu'une âme charitable m'aide à me sortir de ce mauvais pas !

[ShaiLeTroll]

Personnellement, je ne mélange que très rarement VCL et API, la VCL est faite de façon à masquer certains éléments, il n'est pas surprenant que le Handle change à chaques modification de l'objet ...

Dans une DLL de Hook qui affiche dans toutes les fenêtres le nom de leur classe !
Je n'ai aucun soucis pour un code simple, j'ai jamais essayé de modifier la font !

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
 
function HookPaintProc(Code: Integer; RemoveOrNot: WPARAM; MSG: LPARAM): LRESULT; stdcall;
var
  DC: HDC;
  TextString: ShortString;
begin
  Result := 0;
 
  with TMsg(Pointer(MSG)^) do
  begin
    if message = WM_PAINT then
    begin
      DC := GetDC(hwnd);
      if DC > 0 then
      begin
        SendMessage(hwnd, message, wParam, lParam); // ne provoque pas de HookPaintProc ... j'aurais cru que ...
        TextString := '';
        GetClassName(hwnd, @TextString[1], 255);
        TextOut(DC, 0, 0, @TextString[1], StrLen(@TextString[1]));
 
        message := WM_NULL;
      end;
    end;
  end;
end;
 
function StartPaintHook(): HHOOK; stdcall;
begin
  Result := SetWindowsHookEx(WH_GETMESSAGE, HookPaintProc, HInstance, 0);
end;
 
procedure StopPaintHook(HookPaintHandle: HHook); stdcall;
begin
  if HookPaintHandle <> 0 then
    UnhookWindowsHookEx(HookPaintHandle);
end;

[KlausGunther]

Je clos cette discussion. Je n'ai pas trouvé de solution à ce problème, et j'ai choisi de procéder entièrement différemment, dans l'application. Le handle du canvas ne peut pas être transmis valablement à une DLL et utilisé à cet endroit. Tant pis. En tout cas, merci de votre aide.

[Ph. B.]

Bonjour,

Je clos cette discussion. Je n'ai pas trouvé de solution à ce problème, et j'ai choisi de procéder entièrement différemment, dans l'application. Le handle du canvas ne peut pas être transmis valablement à une DLL et utilisé à cet endroit. Tant pis. En tout cas, merci de votre aide.

Vieille discussion qui est exhumée là...
Cela dit, c'est assez confus et je ne suis pas sur d'avoir tout compris sur les spécifications et les responsabilités de l'application et de la dll...

Pour résumer, actuellement, l'application transmet un Handle de windows (fenêtre) au sens Windows du terme (système d'exploitation) et un certain nombre de fonctions de la dll doivent dessiner sur cette fenêtre en utilisant que des appels directs aux API et aucun mécanisme de Delphi (dont TCanvas qui encapsule les DeviceContext).

AMHA, cette approche n'est pas la bonne sur la répartition des responsabilités : Comme l'a dit Paul TOTH, l'application doit se charger de l'affichage et votre dll doit se limiter au dessin. Pour ce faire, l'application doit transmettre à chaque fonction appelée dans la dll le device context du moment, la fonction réalise son dessin et rend la main. L'avantage est que vous pouvez alors utiliser dans votre dll les mécanismes et les encapsulations propres à Delphi, en l'occurrence un TCanvas !

Comment ? C'est simple, vous allez créer un TCanvas dans votre fonction, lui affecter le device context reçu en paramètre, faire votre dessin, puis supprimer le Canvas avant de rendre la main.
La seule complication est côté application appelante : elle doit fournir un device context et le gérer....

Voici un extrait de code tiré d'un petit exemple que j'ai écrit à partir du code que vous aviez fourni : une application Lazarus qui appelle une dll Delphi...
Côté dll Delphi

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
function Cadre(HDC: HWND): Integer;
var
  Canvas: TCanvas;
begin
  Canvas := TCanvas.Create;
  try
    Canvas.Handle := HDC;
    Canvas.Font.Name := 'Arial';
    Canvas.Font.Size := 12;
    Canvas.Pen.Color := clBlack;
    Canvas.TextOut(0,0,format('Page %d',[1]));
    Canvas.Rectangle(100, 100, 400, 400);
    Canvas.TextOut(50, 50, 'Ligne 2');
    Canvas.TextOut(75, 75, 'Ligne 3');
    Canvas.TextOut(50,100,'Ligne 4');
  finally
    Canvas.Free;
  end;
end;
 
function Lines(HDC: HWND): Integer;
var
  Canvas: TCanvas;
begin
  Canvas := TCanvas.Create;
  try
    Canvas.Handle := HDC;
    Canvas.Pen.Color := clRed;
    Canvas.MoveTo(20, 20);
    Canvas.LineTo(480, 20);
    Canvas.MoveTo(20, 28);
    Canvas.LineTo(480, 28);
    Canvas.MoveTo(20, 36);
    Canvas.LineTo(480, 36);
  finally
    Canvas.Free;
  end;
end;

Côté application Lazarus

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
procedure TForm1.BtnCreateWinClick(Sender: TObject);
begin
  CreateWindows;
end;
 
procedure TForm1.CreateWindows;
var
  Frm: TForm;
  Img: TImage;
begin
  Frm := TForm.Create(nil);
  Frm.Left := Self.Left + Self.Width + 8;
  Frm.Top := Self.Top;
  Frm.Width := 500;
  Frm.Height := 500;
  Frm.Caption := 'Fenêtre Test';
  Frm.OnClose := @DynFormClose; // Lazarus contrairement à Delphi demande que l'adresse de la fonction soit préfixée par @
 
  BtnCreateWin.Enabled := False;
 
  //
  Img := TImage.Create(Frm);
  Img.Parent := Frm;
  Img.Left := 0;
  Img.Top := 0;
  Img.Width := Frm.ClientWidth;
  Img.Height := Frm.ClientHeight;
  Img.Canvas.FloodFill(0, 0, clWhite, fsBorder);
 
  ShowMessage('Handle 1 : ' + IntToStr(Img.Canvas.Handle)); // Les ShowMessage n'affectent pas le résultat !
  Cadre(Img.Canvas.Handle);
  ShowMessage('Handle 2 : ' + IntToStr(Img.Canvas.Handle));
  Lines(Img.Canvas.Handle);
  ShowMessage('Handle 3 : ' + IntToStr(Img.Canvas.Handle));
  Img.Repaint;
  Frm.Show;
end;
 
procedure TForm1.DynFormClose(Sender: TObject; var CloseAction: TCloseAction);
begin
  BtnCreateWin.Enabled := True;
end;