Discussion :

[KlausGunther]

J'utilise Delphi 6 Personal Edition sous Windows W10, toutes mises ç jour faites.

J'ai un programme princial avec un composant TImage sur Form1. J'y dessine une ellipse dans le code de création de Form1 - ça marche bien.
J'ai aussi une DLL dont j'appelle une fonction en lui passant Tmage1.Canvas.Handle en paramètre.
J'ai vérifié - le bon HDC arrive bien dans la fonction DLL.
Dans cette fonction, je crée un TCanvas et j'affecte le HDC passé en paramètre via Canvas.Handle. L'affectation se passe bien et la valeur est bonne.

Maintenant, je veux dessiner dans ce canvas à l'intérieur de ma fonction DLL. J'y dessine simplement un rectangle.
Puis, je fais un Canvas.Refresh, je mets le Canvas.Handle à zéro, puis je libère le canvas dans la DLL.
Finalement, je quitte la fonction.

Or, le dessin effectué dans la DLL n'est pas visible dans Image1 de Form1. Pourquoi ?
J'ai pourtant suivi

Au retour de la fonction DLL, je dessine un trait oblique dans le canvas à l'intérieur du programme principal et ce trait s'affiche.

Voici le programme principal dans la Form1 qui contient juste un TImage et un TButton:

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
library KGF;
 
uses
  SysUtils, Graphics, Dialogs,
  Classes;
 
{$R *.res}
 
function TestScalableGraphic(aHandle: pinteger; aWidth, aHeight: integer): integer; stdcall; export;
var
  canvas: TCanvas;
begin
  result := -1;
  try
   canvas := TCanvas.Create;
   canvas.Handle := aHandle^;
 
   canvas.Rectangle(200,200,400,200);
   canvas.Refresh;
   canvas.Handle := 0;
   canvas.Free;
 
   result := 0;
  except
  end;
end;
exports TestScalableGraphic;
 
begin
end.

Voici le code de la DLL qui ne contient qu'une petite fonction dont le but est de dessiner un rectangle sur le TIage de la Form1

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
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls;
 
type
  TForm1 = class(TForm)
    Image1: TImage;
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Déclarations privées }
  public
    { Déclarations publiques }
  end;
 
Type
  TestScalableGraphic = function (aHCanvas: pinteger; aWidth, aHeight: integer): integer; stdcall;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.dfm}
 
procedure TForm1.FormCreate(Sender: TObject);
begin
  Image1.Canvas.Brush.Color := clWhite;
  Image1.Canvas.Pen.Color := clWhite;
  Image1.Canvas.FillRect(Rect(0,0,Image1.Width,Image1.Height));
  Image1.Canvas.Pen.Color := clBlack;
  Image1.Canvas.Ellipse(100,100,300,200);
end;
 
procedure TForm1.Button1Click(Sender: TObject);
var
  res: integer;
  hCanvas: integer;
  HInst: THandle;
  FPointer: TFarProc;
  MyFunct: TestScalableGraphic;
begin
  hCanvas := Image1.Canvas.Handle;
 
  HInst := SafeLoadLibrary('KGF.dll');
  if HInst > 0 then begin
    try
      FPointer := GetProcAddress(HInst,'TestScalableGraphic');
      if FPointer <> nil then begin
        MyFunct := TestScalableGraphic(FPointer);
        res := MyFunct(@hCanvas,Image1.Width,Image1.Height);
        Image1.Canvas.MoveTo(20,20);
        Image1.Canvas.LineTo(300,100);
      end else ShowMessage(' TestScalableGraphic DLL function not found');
    finally
      FreeLibrary(HInst);
    end
  end else ShowMessage('KGF.dll library not found');
end;
 
end.

Mode d'emploi:
au lancement du programme Project1.exe, le composant Image1 montre bien l'ellipse dessinée dans le code de création de Form1.
Un clic surle bouton libellé "Go" devrait dessiner un rectange - or celui-ci n'apparaît pas.
Puis on essine une ligne oblique qui, elle par contre, apparaît bien.

Question: pourquoi est-ce que je ne peux pas dessiner sur le canvas de Image1 à partir de la DLL ?

Ci-joint un ZIP avec les deux projets.

[ShaiLeTroll]

Attention, Image1.Canvas.Handle n'est pas anodin, cela créé un TBitmap interne au TImage, le Canvas est en fait celui du TBitmap soit un TBitmapCanvas
Déjà faudra pouvoir fournir ce Handle correctement.

N'oubliez pas de préciser que l'appelant au final ne sera pas un programme Delphi mais un programme en Panoramic si je me souviens de l'autre sujet.
Toute la logique d'obtention des composants doit être dans cette logique

En vrai, qui va fournir le TImage, qui fournira le Canvas, est-ce une fonction précédente de la DLL ?
Il faut aussi redimensionner le Picture, c'est automatique en Interne via AutoSize dans le Timage via la chaien des OnChange mais là vous devez le faire à la main, comme le dessin du rectangle dépasse l'image initial, n'oubliez pas que l'AutoSize ne se fera pas dans votre cas

Il manque aussi le Invalidate, en fait le TImage recopie le TBitmap dans sa méthode Paint redéfinissant le Paint du TGraphicControl qui est l'implémentation pour WM_PAINT
Ajouter par dessus le DoubleBuffered et cela complique encore
En fait, cela ne dessine pas directement dans le TImage, tout est dessiné dans le TBitmap interne puis recopier dans le Canvas TControlCanvas réel du TGraphicControl qui lui n'est pas accessible, est il masqué par le Canvas du TImage qui est un raccourci vers TImage.Picture.Graphic.Handle.

C'est indispensable car à chaque WM_PAINT, le TImage doit pouvoir restituer le Graphic interne, c'est la différence majeur avec une TPaintBox qui ne fourni pas ce "cache".

n'oubliez pas de remplacer le try except par un try finally pour gérer propre le Create\Free en cas d'erreur, éventuellement un try except autour pour gérer un OutOfMemory


Vous devriez donc plutôt passer un TBitmap.Handle crée temporairement, avec la taille de travail nécessaire, votre fonction devrait retourner la taille max requise pour X, Y
Puis faire un Drawto entre le TBitmap temporaire et le TImage.Picture.Graphic avec les dimensions X, Y
Assign peut aussi faire ce travail mais la taille ça chie un peu

[Paul TOTH]

je te donne une piste... si tu mets Image1.Canvas.Rectangle(200,200,400,200); directement dans la fiche ça ne fonctionne pas non plus

[ShaiLeTroll]

je te donne une piste... si tu mets Image1.Canvas.Rectangle(200,200,400,200); directement dans la fiche ça ne fonctionne pas non plus

J'espère que cela avait été testé en direct, faut 201 pour une ligne, 202 pour deux lignes, 203 pour commencer le Brush, perso, j'avais pas testé son projet mais un des miens similaires ou j'avais gérer manuellement cela en PaintBox et pas en TImage

Et sans le LineTo après le TestScalableGraphic, il n'y aura pas le Changed qui reprend le Bitmap Interne vers le CanvasControl
Donc attention à tout ce code côté Delphi qui ajoute des efforts de Bord au contexte réel

Si l'on prend le projet fourni avec 203

avec les deux isolés, on voit bien que c'est LineTo qui va mettre à jour le TImage.

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
procedure TForm1.Button1Click(Sender: TObject);
var
  res: integer;
  hCanvas: integer;
  HInst: THandle;
  FPointer: TFarProc;
  MyFunct: TestScalableGraphic;
begin
  hCanvas := Image1.Canvas.Handle;
 
  HInst := SafeLoadLibrary('KGF.dll');
  if HInst > 0 then begin
    try
      FPointer := GetProcAddress(HInst,'TestScalableGraphic');
      if FPointer <> nil then begin
        MyFunct := TestScalableGraphic(FPointer);
        res := MyFunct(@hCanvas,Image1.Width,Image1.Height);
      end else ShowMessage(' TestScalableGraphic DLL function not found');
    finally
      FreeLibrary(HInst);
    end
  end else ShowMessage('KGF.dll library not found');
end;

Code :

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

1
2
3
4
5
procedure TForm1.Button2Click(Sender: TObject);
begin
        Image1.Canvas.MoveTo(20,20);
        Image1.Canvas.LineTo(300,100);
end;

[KlausGunther]

Oups... Merci, Paul Toth !

Le coup du rectangle de hauteur nulle est vraiment trop bête !
Donc, ça fonctionne. Je suis confus... Merci encore !