Je ne veut pas dessiner une ligne droite on utilisant moveto et lineto de la méthode
canvas pour cela j'ai essayé de créer un composant ligne, ce dernier peut être horizontal , vertical ou oblique notons qu’ avec l’inspecteur d’objet ou avec programmation on peut changer la source ,destination de cette ligne (le début et la fin ) ,on peut aussi changer la pente.
Le problème de code que j’ai écrits en héritant de « Tgraphiccontrol » m’oblige de définir une largeur et une longueur pour le composant, alors pour une ligne de grande pente il utilise un grand carré (comme les formes de composant shape càd dans un carré), je veut une « solution » pour que le sélectionnement de la ligne soit sur la ligne elle-même et non pas sur tous le carré.
le 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
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
unit line;
 
interface
 
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;
 
type
  Tline = class(TGraphicControl)
  private
    { Déclarations privées }
    fpen:Tpen;
    Fbrush:Tbrush;
    src:Tpoint; //source
    dest:Tpoint; //destination
 
  protected
    { Déclarations protégées }
  public
    { Déclarations publiques }
    constructor create(aowner:Tcomponent);override;
    procedure identifier(source,destination:Tpoint);
    procedure setbrush(value:Tbrush);
    procedure setpen(value:Tpen);
    procedure paint;override;
    destructor destroy;override;
    property source:Tpoint read src write src;
    property destination:Tpoint read dest write dest;
 
  published
    { Déclarations publiées }
    property pen:Tpen read fpen write setpen;
    property brush:Tbrush read Fbrush write setbrush;
    procedure stylechanged(sender:Tobject);
  end;
 
procedure Register;
 
implementation
constructor Tline.create(aowner:Tcomponent);
begin
  inherited create(aowner);
  width:=30;
  height:=30;
  src.x:=0;
  src.y:=0;
  dest.x:=width;
  dest.y:=height;
  fpen:=Tpen.create;
  fpen.onchange:=stylechanged;
  fbrush:=Tbrush.create;
  fbrush.onchange:=stylechanged;
end;
 
procedure Tline.setpen(value:Tpen);
begin
  fpen.assign(value);
end;
 
procedure Tline.setbrush(value:Tbrush);
begin
  Fbrush.assign(value);
end;
 
procedure Tline.paint;
begin
  with canvas do
  begin
    pen:=Fpen;
    brush:=Fbrush;
    moveto(src.x,src.y);
    lineto(dest.x,dest.y);
  end;
end;
 
procedure Tline.stylechanged(sender:Tobject);
begin
  invalidate;
end;
 
procedure Tline.identifier(source,destination:Tpoint);
begin
  src:=source;
  dest:=destination;
end;
 
destructor Tline.destroy;
begin
  fpen.free;
  fbrush.free;
  inherited destroy;
end;
 
procedure Register;
begin
  RegisterComponents('Reseaux', [Tline]);
end;
 
end.