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
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
| unit ImageEtape;
interface
uses Classes, ExtCtrls, Controls, Windows, Forms, Messages, Math, SysUtils, Graphics;
Type
TImageEtape = Class;
TEtape = class;
TZoneEtape = (Ze_Fleche, Ze_FlechePExt, Ze_FlechePOri, Ze_Cercle, Ze_CercleP, Ze_Cadenas, Ze_CadenasP, Ze_BtnDel, Ze_BtnHidePicto, Ze_BtnEnEtape, Ze_Out);
TZoneIndex = Record
Zone : TZoneEtape;
Index : Integer;
End;
TTypePicto = (tp_CercleEtape = 1,tp_CercleVide,tp_CercleCad = 10, tp_CadRedF = 4, tp_CadenasRedO = 5, tp_CadBlackF = 6, tp_CadBlackO = 7);
TEtatEtape = (Et_Libre = 10, Et_LibreC = 12, Et_Fleche = 1, Et_Cercle = 2, Et_Cadenas = 3, Et_Complet = 99);
TMode = (M_Actif, M_Free, M_Modify);
TEtapeClickEvent = procedure(Sender : TObject; Index : integer; Zone : TZoneIndex) of object;
TMouseButtonEvent = Procedure(Sender : TObject; Button : TMouseButton; Shift : TShiftState; X, Y : integer) of object;
TMouseMoveEvent = procedure(Shift: TShiftState; X, Y: Integer) of Object;
TMouseButExEvent = Procedure(Sender : TObject; Button : TMouseButton; Shift : TShiftState; X, Y : integer; Zone : TZoneIndex) of object;
TMouseMoveExEvent = procedure(Sender : TObject; Shift: TShiftState; X, Y: Integer; Zone : TZoneIndex) of Object;
TVecteur = Record
Extremite : TPoint; //L'extremité pointue
Origine : TPoint; //L'Origine
{User} NormeMini : Integer; //Longeur minimal avant hide
Angle : Integer; //L'angle en regard de l'extremité //Utile pour les calcule des autre element
{User} AnglePointe : Integer; //la valeur de l'angle créé par le 2 petits traits formant la fleche
{User} NormePointe : Integer; //la longueur des 2 petits traits formant la fleche
PointeA, PointeB : TPoint; //Les points a relier pour faire la fleche
Visible : Boolean; //utilisation de la fleche ou non
End;
//AnglePointe,NormePointe,... mettre des valeur par defaut dans TImageEtape qui leur sont appliquées si non precisées
TPicto = Record
{User} TypePicto : TTypePicto; //{User}sauf pour le cerleEtape
{User} Rayon : Integer;
RectCirc : TRect; // Carré circonscrit au cercle
Centre : TPoint;
{User} TanMaxA,TanMaxB : Integer;
Delta : Integer;
{User} Enabled : Boolean;
{User} Visible : Boolean;
End;
TGroupe = Record {Vecteur,Cercle,Picto}
Fleche : TVecteur;
Cercle : TPicto;
Cadenas : TPicto;
End;
TNewItemEvent = Procedure(NewEtape : TEtape) Of Object;
TEtape = Class(TCollectionItem)
private
FImageEtape : TImageEtape;
FNum : Integer;
FEnabled : boolean;
FVisible : boolean;
FGroupIndex : integer;
FHint : string; //defaut Le nom de l'appareil (Commentaire)
FComm : string;
//FPen : TPen;
//FBrush : TBrush;
FFlecheDur : TVecteur;
FCercleDur : TPicto;
FCadenasDur : TPicto;
FOnClick : TNotifyEvent;
FonMouseDown : TMouseButExEvent;
FonMouseUp : TMouseButExEvent;
FOnMouseMove : TMouseMoveExEvent;
FOnMouseLeave : TMouseMoveExEvent;
FOnMouseEnter : TMouseMoveExEvent;
procedure SetNum(New : Integer);
procedure SetEnabled(New : boolean);
procedure SetVisible(New : Boolean);
procedure SetGroupIndex(New : integer);
procedure SetComment(New : String);
procedure SetFlecheDur(New : TVecteur);
procedure SetCercleDur(New : TPicto);
procedure SetCadenasDur(New : TPicto);
function IsNumStored : boolean;
function IsEnabledStored : boolean;
function IsVisibleStored : Boolean;
function IsGroupIndexStored : boolean;
function IsHintStored : boolean;
function IsCommentStored : boolean;
protected
function GetDisplayNum : Integer;
public
constructor Create(Collection : TCollection); override;
destructor Destroy; override;
procedure Assign(Source : TPersistent); override;
procedure AssignGroupe(New : TGroupe);
procedure Click;
procedure MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer; Zone : TZoneIndex);
procedure MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer; Zone : TZoneIndex);
procedure MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer; Zone : TZoneIndex);
procedure MouseEnter(Sender: TObject; Shift: TShiftState; X, Y: Integer; Zone : TZoneIndex);
procedure MouseLeave(Sender: TObject; Shift: TShiftState; X, Y: Integer; Zone : TZoneIndex);
published
property Numero : Integer read FNum write SetNum stored IsNumStored;
property Enabled : Boolean read FEnabled write SetEnabled stored IsEnabledStored;
property GroupIndex : integer read FGroupIndex write SetGroupIndex stored IsGroupIndexStored;
property Hint : string read FHint write FHint stored IsHintStored;
property Visible : Boolean read FVisible write SetVisible stored IsVisibleStored;
property Commentaire : String read FComm write SetComment stored IsCommentStored;
property Fleche : TVecteur read FFlecheDur Write SetFlecheDur;
property Cercle : TPicto read FCercleDur Write SetCercleDur;
property Cadenas : TPicto read FCadenasDur Write SetCadenasDur;
property OnClick : TNotifyEvent read FOnClick write FOnClick;
property OnMouseUp : TMouseButExEvent read FonMouseUp write FonMouseUp;
property OnMouseDown : TMouseButExEvent read FonMouseDown write FonMouseDown;
property OnMouseMove : TMouseMoveExEvent read FonMouseMove write FonMouseMove;
Property OnMouseEnter: TMouseMoveExEvent read FOnMouseEnter write FOnMouseEnter;
Property OnMouseLeave: TMouseMoveExEvent read FOnMouseLeave write FOnMouseLeave;
end;
TEtapes = Class(TCollection)
private
FImageEtape : TImageEtape;
function GetItem(Index : integer) : TEtape;
procedure SetItem(Index : integer; Value : TEtape);
protected
function GetOwner : TPersistent; override;
procedure Update(Item : TCollectionItem); override;
public
constructor Create(AnImageEtape : TImageEtape);
function Add : TEtape;
function AddItem(Item : TEtape; Index : integer) : TEtape;
function Insert(Index : integer) : TEtape;
property Items[index : integer] : TEtape read GetItem write SetItem; default;
end;
//////////////////////////////////////////////////////////////////////////////////////////
//////////////////////////////////////////////////////////////////////////////////////////
TImageEtape = class(TGraphicControl)//(TPaintBox)//(TImage)
public
constructor Create(AOwner : TComponent); override;
destructor Destroy; override;
function PointToEtapeIndex(Point : TPoint) : TZoneIndex;
function CreateRect(Centre : TPoint; Rayon : Integer): TRect;
function OffSetVect(Vecteur : TVecteur; Dx : Integer; Dy : Integer) : TVecteur;
function OffSetPicto(Picto : TPicto; Dx : Integer; Dy : Integer) : TPicto;
procedure OffSetPoint(var Point : TPoint; Dx : Integer; Dy : Integer);
function GetNextNum : Integer;
procedure SetNextNum(New : Integer);
//procedure VerifDoublon
// procedure SaveImgEtape;
// procedure LoadImgEtape(Parent : TWinControl);
// A FAIRE une procedure de RAZ pour initialisé les Elements avec des valeur "plausibles"
private
FEtapes : TEtapes;
FAutoNum : boolean; //defaut true
FClickedEtape : TZoneIndex;
FGrpVolatil : TGroupe; //On stoquera ici les valeurs des elements dessinés sur le canvas en cours de création
FOnClickEtape : TEtapeClickEvent;
FPicture : TPicture;
FMoveEnCours : TZoneIndex;
FOldMousePos : TPoint;
FItemEnter : TZoneIndex;
FTmpPoint : TPoint;
FNextNum : Integer; //Prochain numero a affecter
FOnMouseDownItem : TMouseButExEvent;
FOnMouseUpItem : TMouseButExEvent;
FOnMouseMoveItem : TMouseMoveExEvent;
FOnMouseEnterItem : TMouseMoveExEvent;
FOnMouseLeaveItem : TMouseMoveExEvent;
FOnMouseEnter : TNotifyEvent;
FOnMouseLeave : TNotifyEvent;
FOnNewItem : TNewItemEvent;
FEtatEnCours: TEtatEtape;
FMode : TMode; // nouveau groupe au moment d'un click, ou ne fait rien lors d'un click
FTypeEtape : Integer; //que veut on afficher avec le prochain clickDown Integer pour accepter les cumulation
FPoigne : Boolean; //afficher des poignées de modif en mode Modification
FTailPoign : Integer; //taille du cercle representant les poignés
procedure SetEtapes(New : TEtapes);
procedure SetTypeEtape(New : Integer);
procedure CMHintShow(var Message : TCMHintShow); message CM_HINTSHOW;
procedure SetModeNew(New : TMode);
procedure SetPicture(New : TPicture);
procedure SetTailPoign(New : Integer);
function IsAutoNumStored : boolean;
function ShiftState: TShiftState;
///les routines de tracage
Procedure TracerVecteur(Fleche : TVecteur;CanvasDest : TCanvas);
procedure CalcPointeVect(Var Fleche : TVecteur);
Procedure CentrePicto(Fleche : TVecteur; Var Picto : TPicto; PtSouris : TPoint); //renseigne Picto.Centre
Function FindAngleVecteur(Var Fleche : TVecteur; RefOrigine : Boolean = False) : Integer; //renseigne Angle dans Fleche (?passage en pointeur)
Procedure TracerPicto(Picto :TPicto; CanvasDest : TCanvas);
protected
//procedure Notification(AComponent : TComponent; Operation : TOperation); override;
//procedure AdjustSize; override;
procedure Paint; override;
procedure MouseDown(Button : TMouseButton; Shift : TShiftState; X, Y : integer); override;
procedure MouseUp(Button : TMouseButton; Shift : TShiftState; X, Y : integer); override;
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
procedure MouseDownItem(Sender : TObject; Button : TMouseButton; Shift : TShiftState; X, Y : integer; Zone : TZoneIndex); Virtual;
procedure MouseUpItem(Sender : TObject; Button : TMouseButton; Shift : TShiftState; X, Y : integer; Zone : TZoneIndex); Virtual;
procedure MouseMoveItem(Sender : TObject; Shift: TShiftState; X, Y: Integer; Zone : TZoneIndex);Virtual;
procedure DoMouseDownItem(Sender : TObject; Button : TMouseButton; Shift : TShiftState; X, Y : integer; Zone : TZoneIndex);virtual;
procedure DoMouseUpItem(Sender : TObject; Button : TMouseButton; Shift : TShiftState; X, Y : integer; Zone : TZoneIndex);virtual;
procedure DoMouseMoveItem(Sender : TObject; Shift: TShiftState; X, Y: Integer; Zone : TZoneIndex);Virtual;
procedure MouseEnterItem(Sender: TObject; Shift: TShiftState; X, Y: Integer; Zone : TZoneIndex);
procedure MouseLeaveItem(Sender: TObject; Shift: TShiftState; X, Y: Integer; Zone : TZoneIndex);
procedure DoMouseEnterItem(Sender: TObject; Shift: TShiftState; X, Y: Integer; Zone : TZoneIndex);
procedure DoMouseLeaveItem(Sender: TObject; Shift: TShiftState; X, Y: Integer; Zone : TZoneIndex);
procedure MouseEnter(var Msg: TMessage); message CM_MouseEnter;
procedure MouseLeave(var Msg: TMessage); message CM_MouseLeave;
procedure NewItem(NewEtape : TEtape);
procedure DoNewItem(NewEtape : TEtape);Virtual;
procedure ClickEtape(Index : integer);
procedure DoClickEtape(Index : integer; Zone : TZoneEtape); virtual;
published
property AutoSize default True;
property Color default clNone;
property DragKind;
property DragCursor;
property DragMode;
property ParentBiDiMode;
property ParentColor default False;
property ParentShowHint;
property Align;
property Anchors;
property BiDiMode;
property Constraints;
property DockOrientation;
property ShowHint;
property Visible;
property AutoNum : boolean read FAutoNum write FAutoNum stored IsAutoNumStored;
property Etapes : TEtapes read FEtapes write SetEtapes ;//stored False;
property ModeEtape : TMode read FMode write SetModeNew ;//stored False;
property TypeEtape : Integer read FTypeEtape write SetTypeEtape ;//stored False;
//Je sais pas trop comment ca va se passer ici pour Picture?? peut etre voir pour save filename
property Picture : TPicture read FPicture write SetPicture ;//stored True;
property ModPoignes : Boolean read FPoigne write FPoigne ;//stored false;
property ModSizePoignes : Integer read FTailPoign write SetTailPoign ;//default 3;
property OnClick;
property OnConstrainedResize;
property OnContextPopup;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnEndDock;
property OnEndDrag;
property OnMouseActivate;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnMouseWheel;
property OnMouseWheelDown;
property OnMouseWheelUp;
property OnResize;
property OnStartDock;
property OnStartDrag;
property OnClickEtape : TEtapeClickEvent read FOnClickEtape write FOnClickEtape;
property OnMouseDownItem : TMouseButExEvent read FOnMouseDownItem write FOnMouseDownItem;
property OnMouseUpItem : TMouseButExEvent read FOnMouseUpItem write FOnMouseUpItem;
property OnMouseMoveItem : TMouseMoveExEvent read FOnMouseMoveItem write FOnMouseMoveItem;
property OnMouseEnterItem : TMouseMoveExEvent read FOnMouseEnterItem write FOnMouseEnterItem;
property OnMouseLeaveItem : TMouseMoveExEvent read FOnMouseLeaveItem write FOnMouseLeaveItem;
property OnMouseEnter : TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
property OnMouseLeave : TNotifyEvent read FOnMouseLeave write FOnMouseLeave;
property OnNewItem : TNewItemEvent read FOnNewItem write FOnNewItem;
//OnNumItemChanged
end;
implementation |
[D2005perso][CreationComposant] Register impossible et ce sans message d'erreur
Tutoriel : 
Répondre avec citation
Partager