Bonjour @ toutes & tous,

Mon problème n'est malheureusement pas aussi simple que le titre pourrait le laisser penser...
Le projet en question n'est qu'un petit outil pour moi-même et uniquement, sans aucune prétention d'aucune sorte et j'ai donc cherché le moyen le plus simple mais pas le plus élégant pour atteindre mon but.
C'est presque réussi à un détail près...
L'idée est la suivante: je veux dessiner un nombre quelconque (inconnu au départ) d'objets qui vont être relié entre eux par un ou plusieurs traits que j'ai nommé "connecteur".
Dans mon fameux souci de simplicité d'écriture, j'ai trouvé la solution suivante: utiliser des objets de type TShape que je crée sur un TForm lui-même embarqué dans le TForm de l'application principale. Le truc c'est que si je dessine un TShape au delà de la surface visible sur le TForm2, celui-ci va se redimensionner automatiquement ! Autre simplicité de la chose, un TShape sait se redessiner tout seul lors d'un déplacement.
Ah oui, j'ai oublié de dire que les TShapes doivent pouvoir être déplacé à la souris.
Tout ça, j'ai réussi à le faire, le seul problème qui me reste, c'est dessiner les connecteurs. Je vous passe mes différentes tentatives infructueuses mais j'ai fini par trouver la solution au travers d'un message utilisateur "poster" après le dessin du TShape concerné par un déplacement.
Le seul problème, et non des moindres, c'est que lors du déplacement d'un TShape, le fond du TForm2 n'est pas effacé ce qui a pour conséquence de laisser une traînée lors du dessin du connecteur.
Je sais, dit comme ça, cela n'a pas l'air clair du tout alors voici le code ( et le projet test complet en PJ ) :

P.J.: Test1.zip

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
 
unit Unit1;
 
{$mode objfpc}{$H+}
 
interface
 
uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls, ExtCtrls,
  Unit2
  ;
 
type
	{ TForm1 }
  TForm1 = class(TForm)
	  Button1: TButton;
		Button2: TButton;
		GroupBox1: TGroupBox;
		procedure Button1Click(Sender: TObject);
		procedure Button2Click(Sender: TObject);
  private
        { private declarations }
  public
        { public declarations }
  end;
 
 
var
  Form1: TForm1;
 
implementation
 
{$R *.lfm}
 
{ TForm1 }
 
procedure TForm1.Button1Click(Sender: TObject);
begin
  Form2.Parent := Self;
  Form2.Align := alClient;
  Form2.AutoScroll := True;
  Form2.DoubleBuffered := True;
  Form2.Show;
end;
 
 
 
procedure TForm1.Button2Click(Sender: TObject);
begin
  Form2.DrawConnector;
end;
 
end.
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
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
 
unit Unit2;
 
{$mode objfpc}{$H+}
 
interface
 
uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls,
  LMessages, LCLIntf, LCLType
  ;
 
const
  LM_DRAW_CONNECTOR = LM_USER + 1;
 
type
	{ TForm2 }
  TForm2 = class(TForm)
  	Shape1: TShape;
	  Shape2: TShape;
    procedure Shape1MouseDown(Sender: TObject; Button: TMouseButton;Shift: TShiftState; X, Y: Integer);
    procedure Shape1MouseMove(Sender: TObject; Shift: TShiftState; X,Y: Integer);
	  procedure Shape1MouseUp(Sender: TObject; Button: TMouseButton;Shift: TShiftState; X, Y: Integer);
    procedure Shape1Paint(Sender: TObject);
  private
    Sx, Sy  : Integer;
 
    procedure WM_DRAW_CONNECTOR(var Message: TLMessage); message LM_DRAW_CONNECTOR;
 
  public
    procedure DrawConnector;
  end;
 
 
var
      Form2: TForm2;
 
implementation
 
{$R *.lfm}
 
{ TForm2 }
procedure TForm2.Shape1Paint(Sender: TObject);
const KPass: Integer = 0;
begin
  inc(KPass);
  With Shape1.BoundsRect do Shape1.Canvas.TextOut( 5, 10, Format('%d,%d,%d,%d',[Left,Top,Right,Bottom] ));
  With Shape1.ClientRect do Shape1.Canvas.TextOut( 5, 40, Format('%d,%d,%d,%d',[Left,Top,Right,Bottom] ));
  Shape1.Canvas.TextOut( 5, 70, Format('%d',[KPass] ));
  PostMessage( Handle, LM_DRAW_CONNECTOR, 0, 0 );
end;
 
 
 
procedure TForm2.WM_DRAW_CONNECTOR(var Message: TLMessage);
begin
  DrawConnector;
end;
 
 
 
procedure TForm2.Shape1MouseMove( Sender: TObject; Shift: TShiftState; X, Y: Integer );
begin
 
  // Bouton gauche enfonçé ?
  if ( ssLeft in Shift ) then
  begin
    Shape1.Pen.Color := clRed;
    Shape1.Left := Shape1.Left + (X-Sx);
    Shape1.Top := Shape1.Top + (Y-Sy);
	end;
 
end;
 
 
 
procedure TForm2.Shape1MouseUp(Sender: TObject; Button: TMouseButton;Shift: TShiftState; X, Y: Integer);
begin
  Shape1.Pen.Color := clNavy;
end;
 
 
 
procedure TForm2.Shape1MouseDown( Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer );
begin
  if ( Button = mbLeft ) then
  begin
    Sx := X;
    Sy := Y;
	end;
end;
 
 
 
procedure TForm2.DrawConnector;
begin
  Canvas.Line( Shape1.BoundsRect.Right, (Shape1.BoundsRect.Top + ( Shape1.Height div 2)),
               Shape2.BoundsRect.Left, (Shape2.BoundsRect.Top + ( Shape2.Height div 2))
             );
end;
 
 
 
end.
Une idée de comment effacer le fond du TForm2 lors du déplacement d'un TShape ?