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 |
Partager