composant flow graphique

Bonjour à tous, (après un loupé sur le fofo Pascal play again)

Je projette de créer un programme me permettant de concevoir visuellement un workflow simple.
Je pense pour ça avoir besoin de créer des composants dédiés mais je ne suis pas bien à l’aise sur ce sujet.
Voila comment j’ai identifié mon besoin
Un rectangle « action » avec un Tag pour lui donner un numéro, contenant :
- Un rectangle image pour faire un entête sympa sur lequel il y a un label qui serait la « famille » de l’action. La partie image permet de déplacer l’action dans le dessin global par glissé-déposé.
- Sous la famille un icône d’une imagelist lier géré par son index pour indiquer un statut et à coté une combobox pour choisir l’acteur de l’action.
- Aux 4 coins cardinaux une boule qui s’allume au passage de la souris (nord, sud, est, ouest) pour pouvoir créer les liens entre les actions
Un tableau d’actions pour gérer tous ça : tag 1, top1, left1, famille1, acteur1…
Un tableau de liens : tag1, sud vers tag2 nord … ce sera plus subtile peut être pour faire des détours
Le tous sauvegardé dans une base SQL
J’ai lu pas mal de lien sur la création de composants mais j’avoue être un peu perdu dans tous ça …
J’arrive à dessiner un panel qui le ferait bien à part les boules de sélection qui se trouve cachées donc je pense que le panel n’est pas ce qu’il me faut comme point de départ.

note:
je suis sous delphi Xe3
la bibliothèque TMS est hors de prix pour moi
Simple Graph Component ne correspond pas a mon sujet parce que je ne le comprends pas assez pour faire les modifications que je souhaite

si quelqu'un pouvait m'aider
merci d'avance

donc premières questions
si je crée de toutes pièces dans une form les fonctionnalités désirées est-il possible de transformer le projet en composant à postériori ?

de quelle classe dois-je partir ? est-ce un composant graphique avec un combo ou une combo avec des fioritures ?

Bonjour,
bon vu le succès de mon premier post j'avance quand même
ce ne sera surement pas un/des composant/s vu la piste suivi

j'ai utilisé une image sur laquelle je dessine mon graphique avec des
form1.Image.canvas.Rectangle
TextOut pour le texte
CopyRect pour l'icone
je stock le point top,left de l'action dans un tableau toute les actions sont standard en taille.

j'arrive à dessiner des lignes a la souris

a détecter le survole de la souris sur mes "Actions" et le point nord,sud,est,ouest le plus proche ou le survole de l'icone de l'action N°x

je souhaiterais lors du clique sur l'icone pouvoir déplacer l'action sans écraser le dessin en dessous.

quelqu'un aurait il un exemple (simple si possible) qui utiliserait un système de calque ?
genre : form1.Image.canvas.Rectangle pour calque 1 puis 2 et les manipuler
ou une autre idée ?

merci

bonjour,

Après plusieurs recherches je suis tombé sur une source "Copyright (c) 2002 Jovian31" (je ne retrouve plus le lien désolé)

ceci permettait de dessiner des balles que l'on pouvait librement déplacer a la souris et de les redimensionner. Le code bien documenté m'a permis de faire des modifications qui commencent à me rapprocher de mon but.

j'ai modifié les balles en un joli rectangle en rajoutant les propriétés qui me manquaient:

Code:

---

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

private // 3 propriétés pour gérer mon flow Fservice: string; Facteur: string; Ficone:integer;   // 3 propriétés pour gérer mon flow procedure Setservice(const Value: string); procedure Setacteur(const Value: string); procedure Seticone(const Value: integer);   public // 3 propriétés pour gérer mon flow property service: string read Fservice write Setservice; property acteur: string read Facteur write Setacteur; property icone: integer read Ficone write Seticone;   //------------------------------------------------------ constructor TBall.Create(AOwner: TBalls); begin // code d'origine ... +   // 3 propriétés pour gérer mon flow Fservice:=''; Facteur:=''; Ficone:=-1; end; //-------------------------------------------------------   // les procédures qui vont bien   procedure TBall.Setservice(const Value: string); begin if Fservice <> Value then begin Changing(self, ctAspect); Fservice := Value; Changed(self, ctASpect); end; end;   procedure TBall.Setacteur(const Value: string); begin if Facteur <> Value then begin Changing(self, ctAspect); Facteur := Value; Changed(self, ctASpect); end; end;   procedure TBall.Seticone(const Value: integer); begin if Ficone <> Value then begin Changing(self, ctAspect); Ficone := Value; Changed(self, ctASpect); end; end;   ---------------------------------------------------   // et le dessin qui va bien     procedure TBallBox.DrawBall(ABall: TBall); { Tracé d'une boule dans le buffer } var zon_ico:TBitmap; begin with FBuffer.Canvas do begin // code original { Pen.Style:= psSolid;   Pen.Color:= clBlack;   Brush.Style:= bsSolid;   Brush.Color:= ABall.Color;   Ellipse(ABall.BoundsRect);}   // contour noir bas droite pen.Color:=clBlack; Pen.Style:=psSolid; pen.Width:=1; Brush.Color:=clWhite; Rectangle(ABall.BoundsRect);   // entete grisé 1/2 hauteur Pen.Style:=psClear; Brush.Color:=ABall.Color; Rectangle(ABall.Left,ABall.Top,ABall.Left+ABall.Width,ABall.Top+(ABall.Height div 2));   // texte du service Font.Style:=[fsBold,fsUnderline]; TextOut(ABall.Left+26,ABall.Top+5,ABall.service);   // texte de l'acteur Pen.Style:=psClear; Brush.Color:=clWhite; Font.Style:=[]; TextOut(ABall.Left+8,ABall.Top+6+(ABall.Height div 2),ABall.acteur);   // l'icone une imagelist a été rajouter a l'objet Tballs zon_ico:=TBitmap.Create; images.GetBitmap(ABall.icone,zon_ico); draw(ABall.Left+6,ABall.Top+3,zon_ico);   end; end;

---

le problème reste la gestion des liens de mon workflow qui doivent en plus se redessiner si l'on bouge une étape...
je pense définir un lien par
- une étape origine
- point d'accroche origine (nord, sud, est ouest)
- une étape cible
- point d'accroche cible (nord, sud, est ouest)

Si quelqu'un a des idées pour m'aider ...
Modifier ça va, mais partir de rien

Merci de m'avoir lu déjà :D

Salut,

Pas trop le temps ni le courage d'aller sur le forum ces derniers temps, j'ai trouver ton post aujourd'hui.
Il y a un concepteur pour des bases de données livré avec ses sources, cela pourra peut-être te donner des idées.

http://www.fabforce.net/dbdesigner4/index.php

Sources :
http://www.fabforce.net/downloads.php

C'est un projet qui ne semble plus suivi, dommage.

@+

Bonjour,

je cherchais surtout a comprendre l'objectif avant de répondre (de plus il fallait que je revois le post :roll: )

il me semble que la JVCL contient un exemple et des composants pour faire ce genre de choses . Voir tout ce qui concerne Jim Cooper's Diagramming Comp dans le répertoire exemple ...\jvcl\examples\JvDiagramShape

J'ai récemment eu une pause entre deux projets par manque de spécification, je me suis occupé sous Delphi à faire un truc assez proche, voici le code

Code:

---

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 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808 809 810 811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829 830 831 832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962 963 964 965 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 985 986 987 988 989 990 991 992 993 994 995 996 997 998 999 1000 1001 1002 1003 1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019 1020 1021 1022 1023 1024 1025 1026 1027 1028 1029 1030 1031 1032 1033 1034 1035 1036 1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048 1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 1104 1105 1106 1107 1108 1109 1110 1111 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 1125 1126 1127 1128 1129 1130 1131 1132 1133 1134 1135 1136 1137 1138 1139 1140 1141 1142 1143 1144 1145 1146 1147 1148 1149 1150 1151 1152 1153 1154 1155 1156 1157 1158 1159 1160 1161 1162 1163 1164 1165 1166 1167 1168 1169 1170 1171 1172 1173 1174 1175 1176 1177 1178 1179 1180 1181 1182 1183 1184 1185 1186 1187 1188 1189 1190 1191 1192 1193 1194 1195 1196 1197 1198 1199 1200 1201 1202 1203 1204 1205 1206 1207 1208 1209 1210 1211 1212 1213 1214 1215 1216 1217 1218 1219 1220 1221 1222 1223 1224 1225 1226 1227 1228 1229 1230 1231 1232 1233 1234 1235 1236 1237 1238 1239 1240 1241 1242 1243 1244 1245 1246 1247 1248 1249 1250 1251 1252 1253 1254 1255 1256 1257 1258 1259 1260 1261 1262 1263 1264 1265 1266 1267 1268 1269 1270 1271 1272 1273 1274 1275 1276 1277 1278 1279 1280 1281 1282 1283 1284 1285 1286 1287 1288 1289 1290 1291 1292 1293 1294 1295 1296 1297 1298 1299 1300 1301 1302 1303 1304 1305 1306 1307 1308 1309 1310 1311 1312 1313 1314 1315 1316 1317 1318 1319 1320 1321 1322 1323 1324 1325 1326 1327 1328 1329 1330 1331 1332 1333 1334 1335 1336 1337 1338 1339 1340 1341 1342 1343 1344 1345 1346 1347 1348 1349 1350 1351 1352 1353 1354 1355 1356 1357 1358 1359 1360 1361 1362 1363 1364 1365 1366 1367 1368 1369 1370 1371 1372 1373 1374 1375 1376 1377 1378 1379 1380 1381 1382 1383 1384 1385 1386 1387 1388 1389 1390 1391 1392 1393 1394 1395 1396 1397 1398 1399 1400 1401 1402 1403 1404 1405 1406 1407 1408 1409 1410 1411 1412 1413 1414 1415 1416 1417 1418 1419 1420 1421 1422 1423 1424 1425 1426 1427 1428 1429 1430 1431 1432 1433 1434 1435 1436

//------------------------------------------------------------------------------ (* SoLuTions is an Versatile Library for Delphi -  * -  * Copyright ou © ou Copr. "SLT Solutions", (2006) -  * contributeur : ShaiLeTroll (2013) - Migration du EPC UML Designer basé sur Greatis Designer et Greatis Script vers SLT Modeling n'utilisant que du standard Delphi (TPanel et TPaintBox)  * contributeur : ShaiLeTroll (2013) - Fusion de la SLT<2006> sous Delphi 7, SLT<2009> sous C++Builder 2007, SLT<2012> sous C++Builder XE2/XE3 vers la SLT<2013> sous Delphi XE2  * -  * ShaiLeTroll@gmail.com -  * -  * Ce logiciel est un programme informatique servant à aider les développeurs -  * Delphi avec une bibliothèque polyvalente, adaptable et fragmentable. -  * -  * Ce logiciel est régi par la licence CeCILL-C soumise au droit français et -  * respectant les principes de diffusion des logiciels libres. Vous pouvez -  * utiliser, modifier et/ou redistribuer ce programme sous les conditions -  * de la licence CeCILL-C telle que diffusée par le CEA, le CNRS et l'INRIA -  * sur le site "http://www.cecill.info". -  * -  * En contrepartie de l'accessibilité au code source et des droits de copie, -  * de modification et de redistribution accordés par cette licence, il n'est -  * offert aux utilisateurs qu'une garantie limitée. Pour les mêmes raisons, -  * seule une responsabilité restreinte pèse sur l'auteur du programme, le -  * titulaire des droits patrimoniaux et les concédants successifs. -  * -  * A cet égard l'attention de l'utilisateur est attirée sur les risques -  * associés au chargement, à l'utilisation, à la modification et/ou au -  * développement et à la reproduction du logiciel par l'utilisateur étant -  * donné sa spécificité de logiciel libre, qui peut le rendre complexe à -  * manipuler et qui le réserve donc à des développeurs et des professionnels -  * avertis possédant des connaissances informatiques approfondies. Les -  * utilisateurs sont donc invités à charger et tester l'adéquation du -  * logiciel à leurs besoins dans des conditions permettant d'assurer la -  * sécurité de leurs systèmes et ou de leurs données et, plus généralement, -  * à l'utiliser et l'exploiter dans les mêmes conditions de sécurité. -  * -  * Le fait que vous puissiez accéder à cet en-tête signifie que vous avez -  * pris connaissance de la licence CeCILL-C, et que vous en avez accepté les -  * termes. -  * -  *----------------------------------------------------------------------------*) unit SLTModelingDiagramClasses;   interface   {*$DEFINE DEBUG_SLT_MODELING*}   uses Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, System.Contnrs, Vcl.Controls, Vcl.ExtCtrls, Vcl.Graphics, Vcl.Forms, Vcl.Menus, SLT.Common.TypesEx;   type { Forward class declarations } TSLTModelingDiagram = class; TSLTModelingDiagramPanel = class; TSLTModelingDiagramLink = class; TSLTModelingDiagramLinks = class; TSLTModelingDiagramPanelClass = class of TSLTModelingDiagramPanel; TSLTModelingDiagramLinkClass = class of TSLTModelingDiagramLink; TSLTModelingDiagramLinksClass = class of TSLTModelingDiagramLinks; TSLTModelingDiagramDragLink = class;   /// <summary>Evènement se produisant avant la création d'un lien entre deux panels déjà liés ensemble.</summary> TSLTModelingDiagramBeforeCreateDuplicatedLinkEvent = procedure(Sender: TObject; Origin: TSLTModelingDiagramPanel; Target: TSLTModelingDiagramPanel; var CanCreate: Boolean) of object;   /// <summary>Classe gérant un diagramme</summary> /// <remarks>Il est conseillé de n'utiliser que cette classe comme point d'accès au diagramme</remarks> TSLTModelingDiagram = class(TObject) private FContainer: TWinControl; FStartPanel: TSLTModelingDiagramPanel; FStartPoint: TPoint; FStartDragObject: TSLTModelingDiagramDragLink; FLinks: TSLTModelingDiagramLinks; FImageList: TImageList; FImageListNewLinkIndex: Integer; FStreaming: Boolean; FOnBeforeCreateDuplicatedLink: TSLTModelingDiagramBeforeCreateDuplicatedLinkEvent; FOnSelectLink: TNotifyEvent; FSelectedLink: TSLTModelingDiagramLink;   function CreateLink(AStart: TSLTModelingDiagramPanel; AStartPoint: TPoint; AEnd: TSLTModelingDiagramPanel; AEndPoint: TPoint): TSLTModelingDiagramLink; function CreateDragLink(ANewLink: Boolean; DragOrigin: TSLTModelingDiagramPanel): TSLTModelingDiagramDragLink; function ExistsLinks(APanelStart: TSLTModelingDiagramPanel; APanelEnd: TSLTModelingDiagramPanel): Boolean; class function BuildUniqueName(AOwner: TComponent; const APrefix: string): string; class procedure CopyOwnedControls(ADiagram: TSLTModelingDiagram; ASource: TComponent; ADest: TComponent; AFilter: TClass = nil);   procedure PanelResizeEventHandler(Sender: TObject); procedure PanelStartDragEventHandler(Sender: TObject; var DragObject: TDragObject); procedure PanelDragDropHandler(Sender, Source: TObject; X, Y: Integer); procedure PanelDragOverHandler(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); procedure LinkDblClickEventHandler(Sender: TObject);     procedure DoBeforeCreateDuplicatedLink(Origin: TSLTModelingDiagramPanel; Target: TSLTModelingDiagramPanel; var CanCreate: Boolean);   procedure SetSelectedLink(const Value: TSLTModelingDiagramLink); protected function GetLinksClass(): TSLTModelingDiagramLinksClass; virtual; function GetPanelClass(): TSLTModelingDiagramPanelClass; virtual;   procedure RegisterDiagramClasses(); virtual; procedure RepaintLinksOf(ALinkedPanel: TSLTModelingDiagramPanel);   function CreateLinkAt(Sender, Source: TObject; X, Y: Integer): TSLTModelingDiagramLink; virtual; function CanCreateLinkAt(Sender, Source: TObject; X, Y: Integer; State: TDragState): Boolean; virtual;   property StartPanel: TSLTModelingDiagramPanel read FStartPanel; property StartPoint: TPoint read FStartPoint; property StartDragObject: TSLTModelingDiagramDragLink read FStartDragObject; public constructor Create(AContainer: TWinControl); destructor Destroy(); override;   /// <summary>Créer un nouveau panel à la position identifié X et Y dont le titre sera APanelCaption</summary> /// <param name="APanelCaption">Texte qui sera affiché dans la barre de titre du Panneau</param> /// <param name="X">Position horizontale exprimée en coordonnée client du Container</param> /// <param name="Y">Position verticale exprimée en coordonnée client du Container</param> function CreatePanel(const APanelCaption: string; X, Y: Integer): TSLTModelingDiagramPanel;   /// <summary>Charge un flux dans le diagramme ce qui aura pour conséquence de créer les panels et les liens</summary> /// <remarks>Ne charger pas deux fois le même stream sinon cela provoquera un conflit sur les noms de composant. /// <para>LoadFromStream permet de charger un diagramme entier mais il peut aussi servir pour copier des éléments entre plusieurs diagrammes</para></remarks> procedure LoadFromStream(AStream: TStream); /// <summary>Sauvegarde dans un flux dans le diagramme c'est à dire ses panels et ses liens</summary> procedure SaveToStream(AStream: TStream);   /// <summary>Composant qui contiendra les panels et les liens, il en sera le Parent et le Owner</summary> property Container: TWinControl read FContainer; /// <summary>Images diverses que l'on peut associer au diagramme</summary> property ImageList: TImageList read FImageList write FImageList; /// <summary>Index de l'image qui sera utilisée lors d'une opération de création de lien par un Drag'n'Drop.</summary> property ImageListNewLinkIndex: Integer read FImageListNewLinkIndex write FImageListNewLinkIndex;   /// <summary>Liste des liens</summary> property Links: TSLTModelingDiagramLinks read FLinks; /// <summary>Indique le dernier lien sélectionne</summary> property SelectedLink: TSLTModelingDiagramLink read FSelectedLink write SetSelectedLink;   /// <summary>Evènement se produisant avant la création d'un lien entre deux panels déjà liés ensemble.</summary> property OnBeforeCreateDuplicatedLink: TSLTModelingDiagramBeforeCreateDuplicatedLinkEvent read FOnBeforeCreateDuplicatedLink write FOnBeforeCreateDuplicatedLink; /// <summary>Evènement se produisant lors de la sélection d'un lien entre deux panels.</summary> property OnSelectLink: TNotifyEvent read FOnSelectLink write FOnSelectLink; end;   /// <summary>Classe gérant un panneau dans le diagramme</summary> /// <remarks>En dehors des évènements, la plupart des applications n'ont pas besoin d'utiliser TSLTModelingDiagramPanel qui est prévu pour une utilisation interne dans TSLTModelingDiagram.</remarks> TSLTModelingDiagramPanel = class(Vcl.ExtCtrls.TCustomPanel) private FDiagram: TSLTModelingDiagram;   procedure WMWindowPosChanged(var Message: TWMWindowPosChanged); message WM_WINDOWPOSCHANGED; procedure SetDiagram(const Value: TSLTModelingDiagram); protected procedure CreateParams(var Params: TCreateParams); override; public constructor Create(AOwner: TComponent); overload; override; constructor Create(ADiagram: TSLTModelingDiagram); reintroduce; overload;   /// <summary>La redéfinition de TPersistent.Assign est principalement utilisé pour le clonage d'objet durant la lecture ou écriture du panneau dans un flux de diagramme</summary> procedure Assign(Source: TPersistent); override;   /// <summary>Diagramme contenant le panneau</summary> property Diagram: TSLTModelingDiagram read FDiagram write SetDiagram;   published property Caption; end;   TSLTModelingDiagramLinkHitTest = (lhtUnknown, lhtOnTheLine); TSLTModelingDiagramLinkHitTests = set of TSLTModelingDiagramLinkHitTest;   TSLTModelingDiagramLinks = class(TCollection) strict private FDiagram: TSLTModelingDiagram; FPaintBox: TPaintBox; FPanelOwner: TComponent;   procedure SetDiagram(const Value: TSLTModelingDiagram); function GetLink(Index: Integer): TSLTModelingDiagramLink; protected function GetLinkClass(): TSLTModelingDiagramLinkClass; virtual;   procedure RepaintLinks(); function RealignPosition(): Boolean;   procedure PaintBoxEventHandler(Sender: TObject); procedure PaintBoxPopupMenuPopupEventHandler(Sender: TObject); procedure PaintBoxPopupMenuItemClickEventHandler(Sender: TObject);   procedure PopupMenuFillMenu(AMenu: TPopupMenu; ALink: TSLTModelingDiagramLink); virtual; procedure PopupMenuItemActionClick(AMenu: TMenuItem; ALink: TSLTModelingDiagramLink; var Handled: Boolean); virtual; public constructor Create(ADiagram: TSLTModelingDiagram); destructor Destroy(); override;   /// <summary>Ajoute un lien.</summary> function AddLink(): TSLTModelingDiagramLink; /// <summary>Retire un lien.</summary> procedure DeleteLink(ALink: TSLTModelingDiagramLink); /// <summary>Renvoie les informations sur l'emplacement d'un point par rapport à la zone cliente du contrôle de dessin de l'ensemble des liens.</summary> function GetHitTestInfoAt(P: TPoint): TSLTModelingDiagramLinkHitTests; overload; /// <summary>Renvoie le lien et les informations sur l'emplacement d'un point par rapport à la zone cliente du contrôle de dessin de l'ensemble des liens.</summary> function GetHitTestInfoAt(P: TPoint; out ALink: TSLTModelingDiagramLink): TSLTModelingDiagramLinkHitTests; overload;   /// <summary>Diagramme contenant les liens</summary> property Diagram: TSLTModelingDiagram read FDiagram write SetDiagram; /// <summary>Objet possédant les panneaux</summary> property PanelOwner: TComponent read FPanelOwner write FPanelOwner; /// <summary>Liens</summary> property Links[Index: Integer]: TSLTModelingDiagramLink read GetLink; default; /// <summary>Zone de dessin des liens</summary> property PaintBox: TPaintBox read FPaintBox; end;   /// <summary>Classe gérant lien entre deux panneaux dans le diagramme</summary> /// <remarks>En dehors des évènements, la plupart des applications n'ont pas besoin d'utiliser TSLTModelingDiagramLink qui est prévu pour une utilisation interne dans TSLTModelingDiagram.</remarks> TSLTModelingDiagramLink = class(TCollectionItem) strict private FLinks: TSLTModelingDiagramLinks; FPanelStart: TSLTModelingDiagramPanel; FPanelEnd: TSLTModelingDiagramPanel; FPanelStartPoint: TPoint; FPanelEndPoint: TPoint; FHitTestInfo: record Computed: Boolean; ClickZone: array of TPoint; end;   function GetDiagram(): TSLTModelingDiagram; procedure SetPanelEnd(const Value: TSLTModelingDiagramPanel); procedure SetPanelStart(const Value: TSLTModelingDiagramPanel); procedure SetPanelEndPoint(const Value: TPoint); procedure SetPanelStartPoint(const Value: TPoint); procedure SetPanelStartPointX(const Value: Integer); procedure SetPanelStartPointY(const Value: Integer); procedure SetPanelEndPointX(const Value: Integer); procedure SetPanelEndPointY(const Value: Integer);   procedure RealignPosition(); function ComputeClickZone(): Boolean; procedure RotateRectangle(const ARect: TRect; out P1, P2, P3, P4: TPoint; CenterPoint: TPoint; Angle: Extended); protected procedure Paint(); virtual; procedure PaintLink(StartP, EndP: TPoint); virtual; procedure PaintLine(StartP, EndP: TPoint; Dotted: Boolean = False; Discret: Boolean = False); procedure PaintSelection(); function GetLinePoints(OriginControl: TControl; out StartP: TPoint; out EndP: TPoint): Boolean; virtual; class function GetLineAlignBorder(): Integer; virtual; procedure ResetComputed(); virtual; public constructor Create(Collection: TCollection); override;   /// <summary>La redéfinition de TPersistent.Assign est principalement utilisé pour le clonage d'objet durant la lecture ou écriture du lien dans un flux de diagramme</summary> procedure Assign(Source: TPersistent); override;   /// <summary>Demande de dessin du lien, la Demande sera traitée de manière asynchrone. Des demandes consécutives seront regroupées pour ne générer qu'un seul traitement.</summary> procedure RepaintLink(); /// <summary>Renvoie les informations sur l'emplacement d'un point par rapport à la zone cliente du contrôle lien.</summary> function GetHitTestInfoAt(P: TPoint): TSLTModelingDiagramLinkHitTests; /// <summary>Renvoie les informations sur l'emplacement d'un point de l'écran.</summary> function GetHitTestInfoAtScreen(): TSLTModelingDiagramLinkHitTests;   /// <summary>Liste des liens</summary> property Links: TSLTModelingDiagramLinks read FLinks; /// <summary>Point en coordonnée client du Panneau d'origine PanelStart</summary> property PanelStartPoint: TPoint read FPanelStartPoint write SetPanelStartPoint; /// <summary>Point en coordonnée client du Panneau de fin PanelEnd</summary> property PanelEndPoint: TPoint read FPanelEndPoint write SetPanelEndPoint;   published /// <summary>Diagramme contenant le lien</summary> property Diagram: TSLTModelingDiagram read GetDiagram;   /// <summary>Panneau d'origine</summary> property PanelStart: TSLTModelingDiagramPanel read FPanelStart write SetPanelStart; /// <summary>Panneau de fin</summary> property PanelEnd: TSLTModelingDiagramPanel read FPanelEnd write SetPanelEnd; /// <summary>Coordonnée X du Point en coordonnée client du Panneau d'origine PanelStart</summary> property PanelStartPointX: Integer read FPanelStartPoint.X write SetPanelStartPointX; /// <summary>Coordonnée Y du Point en coordonnée client du Panneau d'origine PanelStart</summary> property PanelStartPointY: Integer read FPanelStartPoint.Y write SetPanelStartPointY; /// <summary>Coordonnée X du Point en coordonnée client du Panneau de fin PanelEnd</summary> property PanelEndPointX: Integer read FPanelEndPoint.X write SetPanelEndPointX; /// <summary>Coordonnée Y du Point en coordonnée client du Panneau de fin PanelEnd</summary> property PanelEndPointY: Integer read FPanelEndPoint.Y write SetPanelEndPointY; end;   /// <summary>Classe gérant le Drap'n'Drop pour la création de lien entre deux panneaux</summary> /// <remarks>La plupart des applications n'ont pas besoin d'utiliser TSLTModelingDiagramDragLink qui est prévu pour une utilisation interne dans TSLTModelingDiagram.</remarks> TSLTModelingDiagramDragLink = class(Vcl.Controls.TDragControlObjectEx) private FDiagram: TSLTModelingDiagram; FNewLink: Boolean; FDragImageList: TDragImageList;   protected function GetDragImages: TDragImageList; override; public constructor Create(ADiagram: TSLTModelingDiagram; DragOrigin: TSLTModelingDiagramPanel); reintroduce;   /// <summary>Indique le lien est un nouveau lien</summary> property NewLink: Boolean read FNewLink write FNewLink; end;   implementation   uses System.Math, System.TypInfo, SLT.Common.RTTI;   const MARK_CLICK_SIZE = 2; BORDER_CLICK_SIZE = 4; DBL_CLICK_EVENT_PROPERTY_NAME = 'OnDblClick'; // Do not localize   resourcestring SDragLinkTextFmt = 'Lié %s avec ...'; SMenuDeleteLink = 'Supprimer le lien';   const TAG_MENU_DELETE = -1;   type /// <summary>Classe racine du Stream généré par TSLTModelingDiagram.SaveToStream et nécessaire au bon fonctionnement de TSLTModelingDiagram.LoadFromStream.</summary> /// <remarks>La plupart des applications n'ont pas besoin d'utiliser TSLTModelingDiagramStreamRoot qui est prévu pour une utilisation interne dans TSLTModelingDiagram.</remarks> TSLTModelingDiagramStreamRoot = class(TCustomForm) private FLinks: TSLTModelingDiagramLinks; FDiagram: TSLTModelingDiagram; procedure SetDiagram(const Value: TSLTModelingDiagram); public constructor Create(AOwner: TComponent); override; destructor Destroy(); override;   property Diagram: TSLTModelingDiagram read FDiagram write SetDiagram; published property Links: TSLTModelingDiagramLinks read FLinks write FLinks; end;   { TSLTModelingDiagram }   //------------------------------------------------------------------------------ class function TSLTModelingDiagram.BuildUniqueName(AOwner: TComponent; const APrefix: string): string; var UniqueID: TLargeInteger; begin // Chaque contrôle doit avoir un nom unique au sein de la liste des Components[] de son Owner // GetTickCount pourrait fonctionner si l'on ne fait une construction du Diagram uniquement via IHM // Mais un système de retro-engineering du code pourrait provoquer des collisions de nom // QueryPerformanceCounter réduit énormement ce risque même si il reste présent // Depuis le P4, la fréquence du QueryPerformance est presque la même que celle du processeur divisé par 1000 // Cela donne donc généralement une précision 1 / 3 000 000 = 0.000 001 / 3 =~ 0.000 000 333... donc 333ns, // il y a peu de chance d'avoir un parser de code aussi performant pour effectuer le retro-engineering repeat QueryPerformanceCounter(UniqueID); Result := APrefix + IntToHex(UniqueID, SizeOf(UniqueID) * 2); until AOwner.FindComponent(Result) = nil; end;   //------------------------------------------------------------------------------ function TSLTModelingDiagram.CanCreateLinkAt(Sender, Source: TObject; X, Y: Integer; State: TDragState): Boolean; begin Result := (Source = FStartDragObject) and (Sender is TSLTModelingDiagramPanel) and (Sender <> FStartPanel); end;   //------------------------------------------------------------------------------ class procedure TSLTModelingDiagram.CopyOwnedControls(ADiagram: TSLTModelingDiagram; ASource, ADest: TComponent; AFilter: TClass = nil); var I: Integer; Component: TComponent; Control, Clone: TControl; begin // La liste Components[] fourni tous les composants possédés par le container // L'ordre de cette liste Components[] est l'ordre de création des objets // La liste Controls[] aurait pu être suffisante puisque le container joue le rôle de Owner et de Parent // mais l'ordre de cette liste Controls[] est d'abord les TControl non TWinControl puis les TWinControl for I := 0 to ASource.ComponentCount - 1 do begin Component := ASource.Components[I]; if (Component is TControl) and ((AFilter = nil) or (Component is AFilter)) then begin Control := TControl(Component); Clone := TControlClass(Control.ClassType).Create(ADest); Clone.Assign(Control); // Assign ne touche pas au Diagram, c'est une information critique qu'il faut gérer séparement ! if (AFilter = TSLTModelingDiagramPanel) or ((AFilter = nil) and (Clone is TSLTModelingDiagramPanel)) then TSLTModelingDiagramPanel(Clone).Diagram := ADiagram; end; end; end;   //------------------------------------------------------------------------------ constructor TSLTModelingDiagram.Create(AContainer: TWinControl); begin inherited Create();   FContainer := AContainer; FLinks := GetLinksClass().Create(Self); ImageListNewLinkIndex := -1; end;   //------------------------------------------------------------------------------ function TSLTModelingDiagram.CreateDragLink(ANewLink: Boolean; DragOrigin: TSLTModelingDiagramPanel): TSLTModelingDiagramDragLink; begin Result := TSLTModelingDiagramDragLink.Create(Self, DragOrigin); Result.NewLink := ANewLink; end;   //------------------------------------------------------------------------------ function TSLTModelingDiagram.CreateLink(AStart: TSLTModelingDiagramPanel; AStartPoint: TPoint; AEnd: TSLTModelingDiagramPanel; AEndPoint: TPoint): TSLTModelingDiagramLink; begin Result := FLinks.AddLink(); with Result do begin // Les paramètres PanelStartPoint et PanelEndPoint sont exprimés en coordonnée client de leur point donc respectivement PanelStart et PanelEnd Result.PanelStart := AStart; Result.PanelStartPoint := AStartPoint; Result.PanelEnd := AEnd; Result.PanelEndPoint := AEndPoint; RepaintLinksOf(AEnd); end; end;   //------------------------------------------------------------------------------ function TSLTModelingDiagram.CreateLinkAt(Sender, Source: TObject; X, Y: Integer): TSLTModelingDiagramLink; var Target: TSLTModelingDiagramPanel; CanCreate: Boolean; begin Result := nil;   if Sender is TSLTModelingDiagramPanel then begin Target := TSLTModelingDiagramPanel(Sender);   // Si lien existe déjà, on génère un évènement pour éviter des doublons non souhaités CanCreate := True; if ExistsLinks(FStartPanel, Target) then DoBeforeCreateDuplicatedLink(FStartPanel, Target, CanCreate);   // Les paramètres X et Y indiquent les coordonnées de la souris au-dessus du contrôle Sender (exprimés en coordonnée client du Panneau Target) if CanCreate then Result := CreateLink(FStartPanel, FStartPoint, Target, Point(X, Y)); end; end;   //------------------------------------------------------------------------------ function TSLTModelingDiagram.CreatePanel(const APanelCaption: string; X, Y: Integer): TSLTModelingDiagramPanel; begin Result := GetPanelClass().Create(Self); with Result do begin Caption := APanelCaption; Name := BuildUniqueName(Result.Owner, 'Panel_'); // Les paramètres X et Y sont exprimés en coordonnée client du Container Left := X; Top := Y; end; end;   //------------------------------------------------------------------------------ destructor TSLTModelingDiagram.Destroy(); begin FreeAndNil(FLinks);   inherited Destroy(); end;   //------------------------------------------------------------------------------ procedure TSLTModelingDiagram.DoBeforeCreateDuplicatedLink(Origin, Target: TSLTModelingDiagramPanel; var CanCreate: Boolean); begin if Assigned(FOnBeforeCreateDuplicatedLink) then FOnBeforeCreateDuplicatedLink(Self, Origin, Target, CanCreate); end;   //------------------------------------------------------------------------------ function TSLTModelingDiagram.ExistsLinks(APanelStart: TSLTModelingDiagramPanel; APanelEnd: TSLTModelingDiagramPanel): Boolean; var I: Integer; begin Result := False;   for I := 0 to FLinks.Count - 1 do begin with FLinks[I] do begin if (PanelStart = APanelStart) and (PanelEnd = APanelEnd) then begin Result := True; Exit; end; end; end; end;   //------------------------------------------------------------------------------ function TSLTModelingDiagram.GetLinksClass(): TSLTModelingDiagramLinksClass; begin Result := TSLTModelingDiagramLinks; end;   //------------------------------------------------------------------------------ function TSLTModelingDiagram.GetPanelClass(): TSLTModelingDiagramPanelClass; begin Result := TSLTModelingDiagramPanel; end;   //------------------------------------------------------------------------------ procedure TSLTModelingDiagram.LinkDblClickEventHandler(Sender: TObject); var MP: TPoint; NewSelected: TSLTModelingDiagramLink; ParentDblClickEventHandler: TNotifyEvent; begin if Sender = FLinks.PaintBox then begin MP := FLinks.PaintBox.ScreenToClient(Mouse.CursorPos); NewSelected := nil; if Assigned(FSelectedLink) then if lhtOnTheLine in FSelectedLink.GetHitTestInfoAt(MP) then NewSelected := FSelectedLink;   if not Assigned(NewSelected) then FLinks.GetHitTestInfoAt(MP, NewSelected);   // Change le lien sélectionné ! SelectedLink := NewSelected;   // Génère un faux double-clic sur le Container si il n'y a pas de lien a cette position if not Assigned(NewSelected) then begin // un WM_LBUTTONDBLCLK provoque malheureusement une ré-entrance et faire disparaitre le PaintBox est vilain // Les RTTI permettent d'invoquer le code du OnDblClick du Parent comme le double clic avait été fait dessus ! // Cela rend le PaintBox "transparent" comme si seuls les liens avaient une existence tangible if TSTLTypInfoRTTIWrapper.IsPublishedProperty(FLinks.PaintBox.Parent.ClassType(), DBL_CLICK_EVENT_PROPERTY_NAME) then begin ParentDblClickEventHandler := TNotifyEvent(System.TypInfo.GetMethodProp(FLinks.PaintBox.Parent, DBL_CLICK_EVENT_PROPERTY_NAME)); if Assigned(ParentDblClickEventHandler) then ParentDblClickEventHandler(FLinks.PaintBox.Parent); end; end; end else FSelectedLink := nil; end;   //------------------------------------------------------------------------------ procedure TSLTModelingDiagram.LoadFromStream(AStream: TStream); var Root: TSLTModelingDiagramStreamRoot; TopForm: TCustomForm; begin FStreaming := True; try Root := TSLTModelingDiagramStreamRoot.Create(nil); try RegisterDiagramClasses();   // Fourni un StreamReader un lien avec le Diagram en cours de dé-sérialisation // Cela permet d'utiliser le bon type de Collection Links Root.Diagram := Self;   // Chargement du Flux dans un composant temporaire // Par la suite, les composants seront clonés en affectés au Container TSTLComponentStreaming.StreamToComponent(TComponent(Root), AStream);   // Il faut d'abord chargé les Panels nommés CopyOwnedControls(Self, Root, Self.Container, TSLTModelingDiagramPanel); // Puis l'on recopie les Links qui utilisent le nom des Panels pour retrouver leurs instances // La Collection gère les nom de Panels tout comme le gère les composants entre eux dans le système de Flux Delphi Self.FLinks.Assign(Root.Links); Self.FLinks.RealignPosition(); Self.FLinks.RepaintLinks();   // Root fournit des dimensions pour la fenêtre parente du Container TopForm := GetParentForm(Self.Container, False); // Parent le plus proche if Assigned(TopForm) then TopForm.BoundsRect := Root.BoundsRect;   finally Root.Free(); end; finally FStreaming := False; end; end;   //------------------------------------------------------------------------------ procedure TSLTModelingDiagram.PanelStartDragEventHandler(Sender: TObject; var DragObject: TDragObject); begin // Démarrage d'une opération de Drag'n'Drop if (Sender is TSLTModelingDiagramPanel) then begin FStartPanel := TSLTModelingDiagramPanel(Sender); FStartPoint := FStartPanel.ScreenToClient(Mouse.CursorPos); FStartDragObject := CreateDragLink(True, FStartPanel); DragObject := FStartDragObject; end; end;   //------------------------------------------------------------------------------ procedure TSLTModelingDiagram.RegisterDiagramClasses(); begin // Pour le chargement du flux, il faut recenser les classes présentes dans le Flux // L'instance TSLTModelingDiagramStreamRoot étant créée explicitement, il n'est pas nécessaire de recenser la classe // Le chargement du Flux implique l'utilisation du constructeur hérité de TComponent (il est redéfini par override) // Il est important que les constructeurs alternatifs (reintroduce) reste qu'une simplification syntaxique et n'apporte pas de fonctionnalité importante RegisterClasses([TSLTModelingDiagramPanel, TSLTModelingDiagramLink]); end;   //------------------------------------------------------------------------------ procedure TSLTModelingDiagram.RepaintLinksOf(ALinkedPanel: TSLTModelingDiagramPanel); var I: Integer; begin if FStreaming then Exit;   for I := 0 to FLinks.Count - 1 do with FLinks[I] do if (PanelStart = ALinkedPanel) or (PanelEnd = ALinkedPanel) then FLinks[I].ResetComputed();   FLinks.RealignPosition(); FLinks.RepaintLinks(); end;   //------------------------------------------------------------------------------ procedure TSLTModelingDiagram.SaveToStream(AStream: TStream); var Root: TSLTModelingDiagramStreamRoot; TopForm: TCustomForm; begin FStreaming := True; try Root := TSLTModelingDiagramStreamRoot.Create(nil); try // Fourni un StreamWriter un lien avec le Diagram en cours de sérialisation // Cela permet d'utiliser le bon type de Collection Links Root.Diagram := Self;   // Copie l'ensemble des éléments du Diagram // Les clones obtenus utilise un ainsi un nouveau Parent et nouvel Owner, // le Flux généré n'aura ainsi aucun lien avec le Container CopyOwnedControls(nil, Self.Container, Root); // Puis l'on recopie les Links Root.Links.Assign(Self.FLinks);   // Root permet de conserver les dimensions de la fenêtre parente du Container TopForm := GetParentForm(Self.Container, False); // Parent le plus proche if Assigned(TopForm) then Root.BoundsRect := TopForm.BoundsRect;   // Ecriture du Flux du composant temporaire contenant les objets clonés depuis les objets du Container TSTLComponentStreaming.ComponentToStream(Root, AStream);   finally Root.Free(); end; finally FStreaming := False; end; end;   //------------------------------------------------------------------------------ procedure TSLTModelingDiagram.SetSelectedLink(const Value: TSLTModelingDiagramLink); begin if FSelectedLink <> Value then begin FSelectedLink := Value;   if Assigned(FSelectedLink) then begin FSelectedLink.RepaintLink(); if Assigned(FOnSelectLink) then FOnSelectLink(FSelectedLink); end; end; end;   //------------------------------------------------------------------------------ procedure TSLTModelingDiagram.PanelDragDropHandler(Sender, Source: TObject; X, Y: Integer); begin if Source = FStartDragObject then CreateLinkAt(Sender, Source, X, Y); end;   //------------------------------------------------------------------------------ procedure TSLTModelingDiagram.PanelDragOverHandler(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); begin Accept := CanCreateLinkAt(Sender, Source, X, Y, State); end;   //------------------------------------------------------------------------------ procedure TSLTModelingDiagram.PanelResizeEventHandler(Sender: TObject); begin // Resize ne concerne que le redimensionnement mais pas le changement de position if Sender is TSLTModelingDiagramPanel then RepaintLinksOf(TSLTModelingDiagramPanel(Sender)); end;   { TSLTModelingDiagramStreamRoot }   //------------------------------------------------------------------------------ constructor TSLTModelingDiagramStreamRoot.Create(AOwner: TComponent); begin inherited CreateNew(AOwner);   // Indique que les propriétés spécifiques (celles gérées manuellement via DefineProperty) ne seront pas écrites dans le Flux IsControl := True; // Permet de récupérer les informations stockées dans le Flux concernant les dimensions de la fenêtre hote Position := poDesigned; end;   //------------------------------------------------------------------------------ destructor TSLTModelingDiagramStreamRoot.Destroy(); begin FreeAndNil(FLinks);   inherited Destroy(); end;   //------------------------------------------------------------------------------ procedure TSLTModelingDiagramStreamRoot.SetDiagram(const Value: TSLTModelingDiagram); begin if FDiagram <> Value then begin FreeAndNil(FLinks); FDiagram := Value;   if Assigned(Value) then begin FLinks := TSLTModelingDiagramLinksClass(Value.Links.ClassType()).Create(nil); FLinks.PanelOwner := Self; end; end; end;   { TSLTModelingDiagramPanel }   //------------------------------------------------------------------------------ procedure TSLTModelingDiagramPanel.Assign(Source: TPersistent); begin if Source is TSLTModelingDiagramPanel then begin with TSLTModelingDiagramPanel(Source) do begin Self.Caption := Caption; Self.Name := Name; Self.Left := Left; Self.Top := Top; Self.Width := Width; Self.Height := Height; end; end else inherited Assign(Source); end;   //------------------------------------------------------------------------------ constructor TSLTModelingDiagramPanel.Create(ADiagram: TSLTModelingDiagram); begin Create(ADiagram.Container); SetDiagram(ADiagram); end;   //------------------------------------------------------------------------------ constructor TSLTModelingDiagramPanel.Create(AOwner: TComponent); begin inherited Create(AOwner); if AOwner is TWinControl then Parent := TWinControl(AOwner); ParentBackground := False; ShowCaption := False; // Le Texte sera affiche dans la Barre DragMode := dmAutomatic; ControlStyle := ControlStyle + [csDisplayDragImage]; end;   //------------------------------------------------------------------------------ procedure TSLTModelingDiagramPanel.CreateParams(var Params: TCreateParams); begin // Le Panel va se rapprocher énormément d'une fenêtre mais il reste un TPanel ! inherited CreateParams(Params); with Params do begin // Changement du Style du Panel pour qu'il soit redimensionnable et qu'il possède un titre Style := Style or (WS_THICKFRAME or WS_CAPTION); // taille du titre réduite ExStyle := ExStyle or WS_EX_TOOLWINDOW; end; end;   //------------------------------------------------------------------------------ procedure TSLTModelingDiagramPanel.SetDiagram(const Value: TSLTModelingDiagram); begin if FDiagram <> Value then begin FDiagram := Value; if Assigned(Value) then begin OnResize := Value.PanelResizeEventHandler; OnStartDrag := Value.PanelStartDragEventHandler; OnDragOver := Value.PanelDragOverHandler; OnDragDrop := Value.PanelDragDropHandler; end else begin OnResize := nil; OnStartDrag := nil; OnDragOver := nil; OnDragDrop := nil; end; end; end;   //------------------------------------------------------------------------------ procedure TSLTModelingDiagramPanel.WMWindowPosChanged(var Message: TWMWindowPosChanged); begin // Le déplacement pouvant chevaucher un TPaintBox, cela provoquera son dessin, // il est maladroit de laisser un effet de bord fournir la fonctionnalité // et comme il peut y avoir une latence, je préfère explicitement lancer le dessin if not (csLoading in ComponentState) and Assigned(FDiagram) then if Message.WindowPos.hwnd = Self.Handle then FDiagram.RepaintLinksOf(Self);   inherited; end;   { TSLTModelingDiagramLinks }   //------------------------------------------------------------------------------ function TSLTModelingDiagramLinks.AddLink(): TSLTModelingDiagramLink; begin Result := Add() as TSLTModelingDiagramLink; end;   //------------------------------------------------------------------------------ constructor TSLTModelingDiagramLinks.Create(ADiagram: TSLTModelingDiagram); begin inherited Create(GetLinkClass());   if Assigned(ADiagram) then begin FPaintBox := TPaintBox.Create(nil); // Le futur Parent devra avoir une vie plus longue sinon il sera prématurément libéré ! FPaintBox.OnPaint := PaintBoxEventHandler; FPaintBox.SetBounds(-1, -1, -1, -1); FPaintBox.ControlStyle := FPaintBox.ControlStyle + [csDisplayDragImage]; FPaintBox.PopupMenu := TPopupMenu.Create(FPaintBox); FPaintBox.PopupMenu.OnPopup := PaintBoxPopupMenuPopupEventHandler;   SetDiagram(ADiagram); PanelOwner := ADiagram.Container; end; end;   //------------------------------------------------------------------------------ procedure TSLTModelingDiagramLinks.DeleteLink(ALink: TSLTModelingDiagramLink); begin Delete(ALink.Index); RepaintLinks(); end;   //------------------------------------------------------------------------------ destructor TSLTModelingDiagramLinks.Destroy(); begin FreeAndNil(FPaintBox);   inherited Destroy(); end;   //------------------------------------------------------------------------------ function TSLTModelingDiagramLinks.GetHitTestInfoAt(P: TPoint): TSLTModelingDiagramLinkHitTests; var Dummy: TSLTModelingDiagramLink; begin Result := GetHitTestInfoAt(P, Dummy); end;   //------------------------------------------------------------------------------ function TSLTModelingDiagramLinks.GetHitTestInfoAt(P: TPoint; out ALink: TSLTModelingDiagramLink): TSLTModelingDiagramLinkHitTests; var I: Integer; Hit: TSLTModelingDiagramLinkHitTests; begin for I := 0 to Count - 1 do begin ALink := Links[I]; Hit := ALink.GetHitTestInfoAt(P); if lhtOnTheLine in Hit then begin Result := Hit; Exit; end; end;   Result := [lhtUnknown]; ALink := nil; end;   //------------------------------------------------------------------------------ function TSLTModelingDiagramLinks.GetLink(Index: Integer): TSLTModelingDiagramLink; begin Result := TSLTModelingDiagramLink(Items[Index]); end;   //------------------------------------------------------------------------------ function TSLTModelingDiagramLinks.GetLinkClass(): TSLTModelingDiagramLinkClass; begin Result := TSLTModelingDiagramLink; end;   //------------------------------------------------------------------------------ procedure TSLTModelingDiagramLinks.PaintBoxEventHandler(Sender: TObject); var I: Integer; begin if Assigned(FPaintBox) and Assigned(FPaintBox.Parent) and (Count > 0) then begin if not RealignPosition() then begin {$IFDEF DEBUG_SLT_MODELING} with FPaintBox do begin Canvas.Brush.Color := clFuchsia; Canvas.Rectangle(0, 0, Width, Height); end; {$ENDIF DEBUG_SLT_MODELING}   for I := 0 to Count - 1 do Links[I].Paint(); end else FPaintBox.Invalidate(); end; end;   //------------------------------------------------------------------------------ procedure TSLTModelingDiagramLinks.PaintBoxPopupMenuItemClickEventHandler(Sender: TObject); var Handled: Boolean; begin Handled := False; if (Sender is TMenuItem) and Assigned(FDiagram.SelectedLink) then PopupMenuItemActionClick(TMenuItem(Sender), FDiagram.SelectedLink, Handled); end;   //------------------------------------------------------------------------------ procedure TSLTModelingDiagramLinks.PaintBoxPopupMenuPopupEventHandler(Sender: TObject); var MP: TPoint; NewSelected: TSLTModelingDiagramLink; begin if Sender is TPopupMenu then begin MP := PaintBox.ScreenToClient(Mouse.CursorPos); NewSelected := nil; if Assigned(FDiagram.SelectedLink) then if lhtOnTheLine in FDiagram.SelectedLink.GetHitTestInfoAt(MP) then NewSelected := FDiagram.SelectedLink;   if not Assigned(NewSelected) then GetHitTestInfoAt(MP, NewSelected);   FDiagram.SelectedLink := NewSelected;   TPopupMenu(Sender).Items.Clear();   if Assigned(NewSelected) then PopupMenuFillMenu(TPopupMenu(Sender), NewSelected); end; end;   //------------------------------------------------------------------------------ procedure TSLTModelingDiagramLinks.PopupMenuFillMenu(AMenu: TPopupMenu; ALink: TSLTModelingDiagramLink); var mi: TMenuItem; begin mi := TMenuItem.Create(AMenu); mi.Caption := '-'; AMenu.Items.Add(mi);   mi := TMenuItem.Create(AMenu); mi.Caption := SMenuDeleteLink; mi.Tag := TAG_MENU_DELETE; mi.OnClick := PaintBoxPopupMenuItemClickEventHandler; AMenu.Items.Add(mi); end;   //------------------------------------------------------------------------------ procedure TSLTModelingDiagramLinks.PopupMenuItemActionClick(AMenu: TMenuItem; ALink: TSLTModelingDiagramLink; var Handled: Boolean); begin if AMenu.Tag = TAG_MENU_DELETE then begin DeleteLink(ALink); Handled := True; end end;   //------------------------------------------------------------------------------ function TSLTModelingDiagramLinks.RealignPosition(): Boolean; var LinkPoints: array of TPoint; StartP, EndP: TPoint; LinkRect: TRect; I, K: Integer; BorderSize: Integer; begin Result := False;   if Assigned(FPaintBox) and Assigned(FPaintBox.Parent) then begin if (Count > 0) then begin // Dimensionne le PaintBox pour qu'il puisse acceuillir l'ensemble des liens ! SetLength(LinkPoints, Count * 2); K := 0; for I := 0 to Count - 1 do begin if Links[i].GetLinePoints(FPaintBox.Parent, StartP, EndP) then begin LinkPoints[(I - K) * 2] := StartP; LinkPoints[(I - K) * 2 + 1] := EndP; end else Inc(K); end; SetLength(LinkPoints, (Count - K) * 2);   LinkRect := TRect.Union(LinkPoints); BorderSize := GetLinkClass().GetLineAlignBorder(); InflateRect(LinkRect, BorderSize, BorderSize); end else LinkRect := Rect(-1, -1, -1, -1);   if FPaintBox.BoundsRect <> LinkRect then begin FPaintBox.BoundsRect := LinkRect; for I := 0 to Count - 1 do Links[I].ResetComputed(); Result := True; end; end; end;   //------------------------------------------------------------------------------ procedure TSLTModelingDiagramLinks.RepaintLinks(); begin if Assigned(FPaintBox) and Assigned(FPaintBox.Parent) then FPaintBox.Invalidate(); end;   //------------------------------------------------------------------------------ procedure TSLTModelingDiagramLinks.SetDiagram(const Value: TSLTModelingDiagram); begin if FDiagram <> Value then begin FDiagram := Value; if Assigned(FPaintBox) then begin if Assigned(Value) then begin FPaintBox.Parent := Value.Container; FPaintBox.OnDblClick := Value.LinkDblClickEventHandler; FPaintBox.OnDragOver := Value.PanelDragOverHandler; FPaintBox.OnDragDrop := Value.PanelDragDropHandler; end else begin FPaintBox.Parent := nil; FPaintBox.OnDblClick := nil; FPaintBox.OnDragOver := nil; FPaintBox.OnDragDrop := nil; end; end; end; end;   { TSLTModelingDiagramLink }   //------------------------------------------------------------------------------ procedure TSLTModelingDiagramLink.Assign(Source: TPersistent); begin if Source is TSLTModelingDiagramLink then begin with TSLTModelingDiagramLink(Source) do begin // Il est important que le lien soit créé après les panneaux reliés // Il faut utiliser la référence de l'objet dans son Owner qui est le Container du Diagram à partir du nom d'un panneau pouvant être dans un autre diagramme if Assigned(FPanelStart) then Self.FPanelStart := Self.FLinks.PanelOwner.FindComponent(FPanelStart.Name) as TSLTModelingDiagramPanel else Self.FPanelStart := nil; if Assigned(FPanelEnd) then Self.FPanelEnd := Self.FLinks.PanelOwner.FindComponent(FPanelEnd.Name) as TSLTModelingDiagramPanel else Self.FPanelEnd := nil; Self.FPanelStartPoint := FPanelStartPoint; Self.FPanelEndPoint := FPanelEndPoint; end; end else inherited Assign(Source); end;   //------------------------------------------------------------------------------ function TSLTModelingDiagramLink.ComputeClickZone(): Boolean; var StartP, EndP: TPoint; Angle, Distance: Extended; ClickZone: TRect; P1, P2, P3, P4: TPoint; begin Result := False;   // Récupération des points au bord des panels if GetLinePoints(FLinks.PaintBox, StartP, EndP) then begin // Calcul de l'angle de rotation en considérant le point de départ comme point de rotation Angle := LineAngle(StartP, EndP); // Inversion de la rotation de la droite (on triche en calculant sa Distance, ce qui donne une droite en Angle 0°) Distance := LineDistance(StartP, EndP); EndP := Point(Floor(StartP.X + Distance), StartP.Y);   // Calcul du Rectangle sous la forme d'une simple ligne droite en Angle 0° ClickZone := Rect(StartP.X, StartP.Y, EndP.X, EndP.Y);   // Comme une ligne ne peut pas former un polygone comme le Rectangle, il faut la "grossir" en lui ajoutant la bordure InflateRect(ClickZone, BORDER_CLICK_SIZE, BORDER_CLICK_SIZE); // Rotation du Rectange RotateRectangle(ClickZone, P1, P2, P3, P4, StartP, Angle); // Mémorisation de la zone de Click SetLength(FHitTestInfo.ClickZone, 4); FHitTestInfo.ClickZone[0] := P1; FHitTestInfo.ClickZone[1] := P2; FHitTestInfo.ClickZone[2] := P3; FHitTestInfo.ClickZone[3] := P4;   Result := True; end; end;   //------------------------------------------------------------------------------ constructor TSLTModelingDiagramLink.Create(Collection: TCollection); begin inherited Create(Collection); FLinks := Collection as TSLTModelingDiagramLinks; end;   //------------------------------------------------------------------------------ class function TSLTModelingDiagramLink.GetLineAlignBorder(): Integer; begin Result := BORDER_CLICK_SIZE; end;   //------------------------------------------------------------------------------ function TSLTModelingDiagramLink.GetLinePoints(OriginControl: TControl; out StartP: TPoint; out EndP: TPoint): Boolean; begin Result := False; if Assigned(FPanelStart) and Assigned(FPanelStart.Parent) and Assigned(FPanelEnd) and Assigned(FPanelEnd.Parent) then begin // Les membres PanelStartPoint et PanelEndPoint sont exprimés en coordonnée client de leur point donc respectivement PanelStart et PanelEnd // Ce qui nous intéressent là, ce sont les coordonnées clientes dans l'OriginControl StartP := OriginControl.ScreenToClient(FPanelStart.ClientToScreen(FPanelStartPoint)); EndP := OriginControl.ScreenToClient(FPanelEnd.ClientToScreen(FPanelEndPoint)); Result := True; end; end;   //------------------------------------------------------------------------------ function TSLTModelingDiagramLink.GetDiagram(): TSLTModelingDiagram; begin Result := FLinks.Diagram; end;   //------------------------------------------------------------------------------ function TSLTModelingDiagramLink.GetHitTestInfoAt(P: TPoint): TSLTModelingDiagramLinkHitTests; begin Result := [lhtUnknown]; if not FHitTestInfo.Computed then FHitTestInfo.Computed := ComputeClickZone();   if FHitTestInfo.Computed then begin // Calcul en position cliente ! if PtInPoly(FHitTestInfo.ClickZone, P) then Result := [lhtOnTheLine]; end; end;   //------------------------------------------------------------------------------ function TSLTModelingDiagramLink.GetHitTestInfoAtScreen(): TSLTModelingDiagramLinkHitTests; begin Result := GetHitTestInfoAt(FLinks.PaintBox.ScreenToClient(Mouse.CursorPos)); end;   //------------------------------------------------------------------------------ procedure TSLTModelingDiagramLink.Paint(); var StartP, EndP: TPoint; begin // Récupération des points au bord des panels if GetLinePoints(FLinks.PaintBox, StartP, EndP) then begin // Dessin PaintSelection(); PaintLink(StartP, EndP); end; end;   //------------------------------------------------------------------------------ procedure TSLTModelingDiagramLink.PaintLine(StartP, EndP: TPoint; Dotted: Boolean = False; Discret: Boolean = False); begin with FLinks.PaintBox do begin Canvas.Brush.Style := bsClear; if Discret then begin Canvas.Pen.Mode := pmNotXor; Canvas.Pen.Color := clBlue; Canvas.Pen.Style := psDash; end else begin Canvas.Pen.Mode := pmCopy; Canvas.Pen.Color := clBlack; if Dotted then Canvas.Pen.Style := psDot else Canvas.Pen.Style := psSolid; end;   Canvas.MoveTo(StartP.X, StartP.Y); Canvas.LineTo(EndP.X, EndP.Y); end; end;   //------------------------------------------------------------------------------ procedure TSLTModelingDiagramLink.PaintLink(StartP, EndP: TPoint); begin PaintLine(StartP, EndP); end;   //------------------------------------------------------------------------------ procedure TSLTModelingDiagramLink.PaintSelection(); begin with FLinks.PaintBox do begin {$IFDEF DEBUG_SLT_MODELING} ComputeClickZone(); Canvas.Brush.Color := clRed; Canvas.Brush.Style := bsSolid; Canvas.Pen.Mode := pmCopy; Canvas.Pen.Color := clBlue; Canvas.Pen.Style := psSolid; Canvas.Polygon(FHitTestInfo.ClickZone); {$ELSE DEBUG_SLT_MODELING} if Diagram.SelectedLink = Self then begin if FHitTestInfo.Computed then begin Canvas.Brush.Style := bsClear; Canvas.Pen.Mode := pmCopy; Canvas.Pen.Color := clGray; Canvas.Pen.Style := psDot; // plus proche de petit tiret que de point ! Canvas.Polygon(FHitTestInfo.ClickZone); end; end; {$ENDIF DEBUG_SLT_MODELING} end; end;   //------------------------------------------------------------------------------ procedure TSLTModelingDiagramLink.RealignPosition(); begin if FLinks.RealignPosition() then ResetComputed(); end;   //------------------------------------------------------------------------------ procedure TSLTModelingDiagramLink.RepaintLink(); begin FLinks.RepaintLinks(); end;   //------------------------------------------------------------------------------ procedure TSLTModelingDiagramLink.ResetComputed(); begin FHitTestInfo.Computed := False; end;   //------------------------------------------------------------------------------ procedure TSLTModelingDiagramLink.RotateRectangle(const ARect: TRect; out P1, P2, P3, P4: TPoint; CenterPoint: TPoint; Angle: Extended); begin P1 := ARect.TopLeft; P2 := Point(ARect.Right, ARect.Top); P3 := ARect.BottomRight; P4 := Point(ARect.Left, ARect.Bottom); SLT.Common.TypesEx.RotateRectangle(P1, P2, P3, P4, CenterPoint, Angle); end;   //------------------------------------------------------------------------------ procedure TSLTModelingDiagramLink.SetPanelEnd(const Value: TSLTModelingDiagramPanel); begin if FPanelEnd <> Value then begin FPanelEnd := Value; RealignPosition(); end; end;   //------------------------------------------------------------------------------ procedure TSLTModelingDiagramLink.SetPanelEndPoint(const Value: TPoint); begin if FPanelEndPoint <> Value then begin FPanelEndPoint := Value; RealignPosition(); end; end;   //------------------------------------------------------------------------------ procedure TSLTModelingDiagramLink.SetPanelEndPointX(const Value: Integer); begin if FPanelEndPoint.X <> Value then begin FPanelEndPoint.X := Value; RealignPosition(); end; end;   //------------------------------------------------------------------------------ procedure TSLTModelingDiagramLink.SetPanelEndPointY(const Value: Integer); begin if FPanelEndPoint.Y <> Value then begin FPanelEndPoint.Y := Value; RealignPosition(); end; end;   //------------------------------------------------------------------------------ procedure TSLTModelingDiagramLink.SetPanelStart(const Value: TSLTModelingDiagramPanel); begin if FPanelStart <> Value then begin FPanelStart := Value; RealignPosition(); end; end;   //------------------------------------------------------------------------------ procedure TSLTModelingDiagramLink.SetPanelStartPoint(const Value: TPoint); begin if FPanelStartPoint <> Value then begin FPanelStartPoint := Value; RealignPosition(); end; end;   //------------------------------------------------------------------------------ procedure TSLTModelingDiagramLink.SetPanelStartPointX(const Value: Integer); begin if FPanelStartPoint.X <> Value then begin FPanelStartPoint.X := Value; RealignPosition(); end; end;   //------------------------------------------------------------------------------ procedure TSLTModelingDiagramLink.SetPanelStartPointY(const Value: Integer); begin if FPanelStartPoint.Y <> Value then begin FPanelStartPoint.Y := Value; RealignPosition(); end; end;   { TSLTModelingDiagramDragLink }   //------------------------------------------------------------------------------ constructor TSLTModelingDiagramDragLink.Create(ADiagram: TSLTModelingDiagram; DragOrigin: TSLTModelingDiagramPanel); begin inherited Create(DragOrigin); FDiagram := ADiagram; end;   //------------------------------------------------------------------------------ function TSLTModelingDiagramDragLink.GetDragImages(): TDragImageList; var DragBitmap: Vcl.Graphics.TBitmap; DragText: String; DragTextSize: TSize; begin if not Assigned(FDragImageList) then FDragImageList := TDragImageList.Create(Control);   Result := FDragImageList; Result.Clear();   DragBitmap := Vcl.Graphics.TBitmap.Create(); try // Il ne semble pas possible de changer l'image en cours de route, j'aurais aimé affiché le destinataire DragText := Format(SDragLinkTextFmt, [TSLTModelingDiagramPanel(Control).Caption]);   // On utilise la Font du Panneau à l'initiative du Drag'n'Drop DragBitmap.Canvas.Font := TSLTModelingDiagramPanel(Control).Font; DragBitmap.Canvas.Font.Style := DragBitmap.Canvas.Font.Style + [fsBold]; DragBitmap.Canvas.Font.Quality := fqNonAntialiased; // Sinon se mélange avec le fond ! // L'image sera placée au dessus et à gauche du curseur // Le Texte sera placé à la droite de l'image, toujours au dessus du curseur DragTextSize := DragBitmap.Canvas.TextExtent(DragText); DragBitmap.Height := Max(DragTextSize.Height, FDiagram.ImageList.Height); DragBitmap.Width := DragTextSize.Width + 4 + FDiagram.ImageList.Width; // 4 de spacing // La couleur de fond clFuchsia servira pour la transparence de l'image masquée DragBitmap.Canvas.Brush.Color := clFuchsia; DragBitmap.Canvas.FillRect(Rect(0, 0, DragBitmap.Width, DragBitmap.Height)); DragBitmap.Canvas.Font.Color := clBlue; // Grace à fqNonAntialiased, il n'y a pas de mélange entre la couleur de fond et la couleur de la fonte // Dessine le texte à la droite de l'image est un espacement de 4 pixel DragBitmap.Canvas.TextOut(FDragImageList.Width + 4, 0, DragText); if NewLink and (FDiagram.ImageListNewLinkIndex >= 0) then FDiagram.ImageList.Draw(DragBitmap.Canvas, 0, 0, FDiagram.ImageListNewLinkIndex); // l'image liste ne contiendra qu'une image et ses dimensions seront celle de cette image Result.Width := DragBitmap.Width; Result.Height := DragBitmap.Height; // Ajout de l'image+texte avec transparence, sa position pour le drag'n'drop sera au bout du curseur Result.SetDragImage(Result.AddMasked(DragBitmap, clFuchsia), FDiagram.ImageList.Width + 2, DragBitmap.Height - 2); finally DragBitmap.Free(); end end;   end.

---

Le source complet aujourd'hui en Delphi (j'ai encore bcp de fichier en D6 et C++Builer2007\XE2 à migrer en DelphiXe2)

Une extension par héritage pour gérer de l'UML, le diagramme de Classe
Je pense que tu peux t'inspirer de cela pour créer ton diagramme de séquence

Code:

---

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 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782

//------------------------------------------------------------------------------ (* SoLuTions is an Versatile Library for Delphi -  * -  * Copyright ou © ou Copr. "SLT Solutions", (2006) -  * contributeur : ShaiLeTroll (2013) - Migration du EPC UML Designer basé sur Greatis Designer et Greatis Script vers SLT Modeling n'utilisant que du standard Delphi (TPanel et TPaintBox)  * contributeur : ShaiLeTroll (2013) - Fusion de la SLT<2006> sous Delphi 7, SLT<2009> sous C++Builder 2007, SLT<2012> sous C++Builder XE2/XE3 vers la SLT<2013> sous Delphi XE2  * -  * ShaiLeTroll@gmail.com -  * -  * Ce logiciel est un programme informatique servant à aider les développeurs -  * Delphi avec une bibliothèque polyvalente, adaptable et fragmentable. -  * -  * Ce logiciel est régi par la licence CeCILL-C soumise au droit français et -  * respectant les principes de diffusion des logiciels libres. Vous pouvez -  * utiliser, modifier et/ou redistribuer ce programme sous les conditions -  * de la licence CeCILL-C telle que diffusée par le CEA, le CNRS et l'INRIA -  * sur le site "http://www.cecill.info". -  * -  * En contrepartie de l'accessibilité au code source et des droits de copie, -  * de modification et de redistribution accordés par cette licence, il n'est -  * offert aux utilisateurs qu'une garantie limitée. Pour les mêmes raisons, -  * seule une responsabilité restreinte pèse sur l'auteur du programme, le -  * titulaire des droits patrimoniaux et les concédants successifs. -  * -  * A cet égard l'attention de l'utilisateur est attirée sur les risques -  * associés au chargement, à l'utilisation, à la modification et/ou au -  * développement et à la reproduction du logiciel par l'utilisateur étant -  * donné sa spécificité de logiciel libre, qui peut le rendre complexe à -  * manipuler et qui le réserve donc à des développeurs et des professionnels -  * avertis possédant des connaissances informatiques approfondies. Les -  * utilisateurs sont donc invités à charger et tester l'adéquation du -  * logiciel à leurs besoins dans des conditions permettant d'assurer la -  * sécurité de leurs systèmes et ou de leurs données et, plus généralement, -  * à l'utiliser et l'exploiter dans les mêmes conditions de sécurité. -  * -  * Le fait que vous puissiez accéder à cet en-tête signifie que vous avez -  * pris connaissance de la licence CeCILL-C, et que vous en avez accepté les -  * termes. -  * -  *----------------------------------------------------------------------------*) unit SLTModelingDiagramUMLClasses;   interface   {*$DEFINE DEBUG_SLT_MODELING*}   uses Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, System.Contnrs, Vcl.Controls, Vcl.ExtCtrls, Vcl.Graphics, Vcl.Forms, Vcl.Menus, SLT.Common.TypesEx, SLTModelingDiagramClasses;   type { Forward class declarations } TSLTModelingDiagramUML = class; TSLTModelingDiagramUMLPanel = class; TSLTModelingDiagramUMLLink = class; TSLTModelingDiagramUMLLinks = class;   /// <summary>Evènement se produisant avant la création d'un lien vers un autre lien déjà liés ensemble.</summary> TSLTModelingDiagramBeforeCreateDuplicatedSubLinkEvent = procedure(Sender: TObject; Origin: TSLTModelingDiagramPanel; SubLink: TSLTModelingDiagramLink; var CanCreate: Boolean) of object;   TSLTModelingDiagramUMLType = (dtClass);   /// <summary>Classe gérant un diagramme UML</summary> /// <remarks>Il est conseillé de n'utiliser que cette classe comme point d'accès au diagramme UML</remarks> TSLTModelingDiagramUML = class(TSLTModelingDiagram) private FDiagramType: TSLTModelingDiagramUMLType; FOnBeforeCreateDuplicatedSubLink: TSLTModelingDiagramBeforeCreateDuplicatedSubLinkEvent;   function GetLinks(): TSLTModelingDiagramUMLLinks; function GetSelectedLink(): TSLTModelingDiagramUMLLink; procedure SetSelectedLink(const Value: TSLTModelingDiagramUMLLink);   function CreateSubLink(AStart: TSLTModelingDiagramPanel; AStartPoint: TPoint; ASubLink: TSLTModelingDiagramUMLLink): TSLTModelingDiagramUMLLink; function ExistsSubLinks(APanelStart: TSLTModelingDiagramPanel; ASubLink: TSLTModelingDiagramLink): Boolean;   procedure DoBeforeCreateDuplicatedSubLink(Origin: TSLTModelingDiagramPanel; SubLink: TSLTModelingDiagramLink; var CanCreate: Boolean); protected function GetLinksClass(): TSLTModelingDiagramLinksClass; override; function GetPanelClass(): TSLTModelingDiagramPanelClass; override;   procedure RegisterDiagramClasses(); override;   function CreateLinkAt(Sender, Source: TObject; X, Y: Integer): TSLTModelingDiagramLink; override; function CanCreateLinkAt(Sender, Source: TObject; X, Y: Integer; State: TDragState): Boolean; override; public constructor Create(AContainer: TWinControl);   /// <summary>Type du Diagramme UML</summary> property DiagramType: TSLTModelingDiagramUMLType read FDiagramType write FDiagramType; /// <summary>Liste des liens UML</summary> property Links: TSLTModelingDiagramUMLLinks read GetLinks; /// <summary>Indique le dernier lien sélectionne</summary> property SelectedLink: TSLTModelingDiagramUMLLink read GetSelectedLink write SetSelectedLink;   /// <summary>Evènement se produisant avant la création d'un lien vers un autre lien déjà liés ensemble.</summary> property OnBeforeCreateDuplicatedSubLink: TSLTModelingDiagramBeforeCreateDuplicatedSubLinkEvent read FOnBeforeCreateDuplicatedSubLink write FOnBeforeCreateDuplicatedSubLink; end;   TSLTModelingDiagramUMLPanelType = (ptClass);   /// <summary>Classe gérant un Elément (Classe, Objet, Acteur...) dans le diagramme UML</summary> /// <remarks>En dehors des évènements, la plupart des applications n'ont pas besoin d'utiliser TSLTModelingDiagramUMLPanel qui est prévu pour une utilisation interne dans TSLTModelingDiagramUML.</remarks> TSLTModelingDiagramUMLPanel = class(TSLTModelingDiagramPanel) strict private FPanelType: TSLTModelingDiagramUMLPanelType;   function GetDiagram(): TSLTModelingDiagramUML; procedure SetDiagram(const Value: TSLTModelingDiagramUML); public /// <summary>Diagramme UML contenant le panneau</summary> property Diagram: TSLTModelingDiagramUML read GetDiagram write SetDiagram; published /// <summary>Type du Diagramme UML</summary> property PanelType: TSLTModelingDiagramUMLPanelType read FPanelType write FPanelType; end;   TSLTModelingDiagramUMLLinkType = (ltNone, ltAssociationUnidirectional, ltAssociationBidirectional, ltAssociationClass, ltInheritance, ltImplements, ltAggregationBasic, ltAggregationComposition);   TSLTModelingDiagramUMLLinks = class(TSLTModelingDiagramLinks) strict private function GetLink(Index: Integer): TSLTModelingDiagramUMLLink; function GetDiagram(): TSLTModelingDiagramUML; procedure SetDiagram(const Value: TSLTModelingDiagramUML); private procedure DeleteRelativeLinks(ALink: TSLTModelingDiagramLink); protected function GetLinkClass(): TSLTModelingDiagramLinkClass; override; procedure PopupMenuFillMenu(AMenu: TPopupMenu; ALink: TSLTModelingDiagramLink); override; procedure PopupMenuItemActionClick(AMenu: TMenuItem; ALink: TSLTModelingDiagramLink; var Handled: Boolean); override; public /// <summary>DiagrammeUML contenant le panneau</summary> property Diagram: TSLTModelingDiagramUML read GetDiagram write SetDiagram; /// <summary>Ajoute un lien.</summary> function AddLink(): TSLTModelingDiagramUMLLink; /// <summary>Renvoie le lien et les informations sur l'emplacement d'un point par rapport à la zone cliente du contrôle de dessin de l'ensemble des liens.</summary> function GetHitTestInfoAt(P: TPoint; out ALink: TSLTModelingDiagramUMLLink): TSLTModelingDiagramLinkHitTests; overload;   /// <summary>Liens</summary> property Links[Index: Integer]: TSLTModelingDiagramUMLLink read GetLink; default; end;   /// <summary>Classe gérant lien entre deux panneaux dans le diagramme UML</summary> /// <remarks>En dehors des évènements, la plupart des applications n'ont pas besoin d'utiliser TSLTModelingDiagramUMLLink qui est prévu pour une utilisation interne dans TSLTModelingDiagramUML.</remarks> TSLTModelingDiagramUMLLink = class(TSLTModelingDiagramLink) strict private FLinkType: TSLTModelingDiagramUMLLinkType; FSubLink: TSLTModelingDiagramUMLLink; FArrowInfo: record Computed: Boolean; Triangle: array[0..2] of TPoint; end; FDiamondInfo: record Computed: Boolean; Diamond: array[0..3] of TPoint; end;   procedure SetLinkType(const Value: TSLTModelingDiagramUMLLinkType); function GetSubLinkIndex: Integer; procedure SetSubLinkIndex(const Value: Integer);   function ComputeArrow(): Boolean; function ComputeDiamond(): Boolean; private function GetLinks: TSLTModelingDiagramUMLLinks; protected procedure PaintLink(StartP, EndP: TPoint); override; procedure PaintRelation(StartP, EndP: TPoint); procedure PaintArrow(StartP, EndP: TPoint; Closed: Boolean = True); procedure PaintDiamond(StartP, EndP: TPoint; Plain: Boolean = True); function GetLinePoints(OriginControl: TControl; out StartP: TPoint; out EndP: TPoint): Boolean; override; class function GetLineAlignBorder: Integer; override; procedure ResetComputed(); override; public destructor Destroy(); override;   /// <summary>La redéfinition de TPersistent.Assign est principalement utilisé pour le clonage d'objet durant la lecture ou écriture du lien dans un flux de diagramme</summary> procedure Assign(Source: TPersistent); override;   /// <summary>Liste des liens UML</summary> property Links: TSLTModelingDiagramUMLLinks read GetLinks; /// <summary>lien avec un autre lien</summary> property SubLink: TSLTModelingDiagramUMLLink read FSubLink write FSubLink;   published /// <summary>Type du lien UML</summary> property LinkType: TSLTModelingDiagramUMLLinkType read FLinkType write SetLinkType default ltNone; /// <summary>Index lien avec un autre lien</summary> property SubLinkIndex: Integer read GetSubLinkIndex write SetSubLinkIndex default -1; end;   implementation   uses System.Math, System.TypInfo, SLT.Common.RTTI;   const ARROW_RADIUS_SIZE = 8;   resourcestring SLinkTypeNone = 'Lien indéterminé'; SLinkTypeAssociationUnidirectional = 'Association uni-directionnelle'; SLinkTypeAssociationBidirectional = 'Association bi-directionnelle'; SLinkTypeAssociationClass = 'Classe d''association'; SLinkTypeInheritance = 'Héritage'; SLinkTypeImplements = 'Implémentation'; SLinkTypeAggregationBasic = 'Aggregation'; SLinkTypeAggregationComposition = 'Composition';   const LINK_TYPE_CAPTIONS: array[TSLTModelingDiagramUMLLinkType] of PResStringRec = ( @SLinkTypeNone, @SLinkTypeAssociationUnidirectional, @SLinkTypeAssociationBidirectional, @SLinkTypeAssociationClass, @SLinkTypeInheritance, @SLinkTypeImplements, @SLinkTypeAggregationBasic, @SLinkTypeAggregationComposition);   { TSLTModelingDiagramUML }   //------------------------------------------------------------------------------ function TSLTModelingDiagramUML.CanCreateLinkAt(Sender, Source: TObject; X, Y: Integer; State: TDragState): Boolean; begin if Sender = Links.PaintBox then Result := (Source = StartDragObject) and (lhtOnTheLine in Links.GetHitTestInfoAt(Point(X, Y))) else Result := inherited CanCreateLinkAt(Sender, Source, X, Y, State); end;   //------------------------------------------------------------------------------ constructor TSLTModelingDiagramUML.Create(AContainer: TWinControl); begin inherited Create(AContainer);   FDiagramType := dtClass; end;   //------------------------------------------------------------------------------ function TSLTModelingDiagramUML.CreateLinkAt(Sender, Source: TObject; X, Y: Integer): TSLTModelingDiagramLink; var TargetLink: TSLTModelingDiagramUMLLink; CanCreate: Boolean; begin Result := inherited CreateLinkAt(Sender, Source, X, Y); if not Assigned(Result) then begin if Sender = Links.PaintBox then begin // Les paramètres X et Y indiquent les coordonnées de la souris au-dessus du contrôle Sender (exprimés en coordonnée client du PaintBox) if (lhtOnTheLine in Links.GetHitTestInfoAt(Point(X, Y), TargetLink)) and Assigned(TargetLink) and Assigned(TargetLink.PanelStart) and Assigned(TargetLink.PanelEnd) then begin // Si lien existe déjà, on génère un évènement pour éviter des doublons non souhaités CanCreate := True; if ExistsSubLinks(StartPanel, TargetLink) then DoBeforeCreateDuplicatedSubLink(StartPanel, TargetLink, CanCreate);   if CanCreate then Result := CreateSubLink(StartPanel, StartPoint, TargetLink); end; end; end; end;   //------------------------------------------------------------------------------ function TSLTModelingDiagramUML.CreateSubLink(AStart: TSLTModelingDiagramPanel; AStartPoint: TPoint; ASubLink: TSLTModelingDiagramUMLLink): TSLTModelingDiagramUMLLink; begin Result := Links.AddLink(); with Result do begin // Les paramètres PanelStartPoint et PanelEndPoint sont exprimés en coordonnée client de leur point donc respectivement PanelStart et PanelEnd Result.PanelStart := AStart; Result.PanelStartPoint := AStartPoint; Result.SubLink := ASubLink; Result.LinkType := ltAssociationClass; RepaintLinksOf(ASubLink.PanelEnd); end; end;   //------------------------------------------------------------------------------ procedure TSLTModelingDiagramUML.DoBeforeCreateDuplicatedSubLink(Origin: TSLTModelingDiagramPanel; SubLink: TSLTModelingDiagramLink; var CanCreate: Boolean); begin if Assigned(FOnBeforeCreateDuplicatedSubLink) then FOnBeforeCreateDuplicatedSubLink(Self, Origin, SubLink, CanCreate); end;   //------------------------------------------------------------------------------ function TSLTModelingDiagramUML.ExistsSubLinks(APanelStart: TSLTModelingDiagramPanel; ASubLink: TSLTModelingDiagramLink): Boolean; var I: Integer; begin Result := False;   for I := 0 to Links.Count - 1 do begin with Links[I] do begin if (PanelStart = APanelStart) and (PanelEnd = nil) then begin if Assigned(SubLink) and (SubLink.PanelStart = ASubLink.PanelStart) and (SubLink.PanelEnd = ASubLink.PanelEnd) then begin Result := True; Exit; end; end; end; end; end;   //------------------------------------------------------------------------------ function TSLTModelingDiagramUML.GetLinks(): TSLTModelingDiagramUMLLinks; begin Result := TSLTModelingDiagramUMLLinks(inherited Links); end;   //------------------------------------------------------------------------------ function TSLTModelingDiagramUML.GetLinksClass(): TSLTModelingDiagramLinksClass; begin Result := TSLTModelingDiagramUMLLinks; end;   //------------------------------------------------------------------------------ function TSLTModelingDiagramUML.GetPanelClass(): TSLTModelingDiagramPanelClass; begin Result := TSLTModelingDiagramUMLPanel; end;   //------------------------------------------------------------------------------ function TSLTModelingDiagramUML.GetSelectedLink(): TSLTModelingDiagramUMLLink; begin Result := TSLTModelingDiagramUMLLink(inherited SelectedLink); end;   //------------------------------------------------------------------------------ procedure TSLTModelingDiagramUML.RegisterDiagramClasses(); begin RegisterClasses([TSLTModelingDiagramUMLPanel, TSLTModelingDiagramUMLLink]); end;   //------------------------------------------------------------------------------ procedure TSLTModelingDiagramUML.SetSelectedLink(const Value: TSLTModelingDiagramUMLLink); begin inherited SelectedLink := Value; end;   { TSLTModelingDiagramUMLPanel }   //------------------------------------------------------------------------------ function TSLTModelingDiagramUMLPanel.GetDiagram(): TSLTModelingDiagramUML; begin Result := inherited Diagram as TSLTModelingDiagramUML; end;   //------------------------------------------------------------------------------ procedure TSLTModelingDiagramUMLPanel.SetDiagram(const Value: TSLTModelingDiagramUML); begin inherited Diagram := Value; end;   { TSLTModelingDiagramUMLLinks }   //------------------------------------------------------------------------------ function TSLTModelingDiagramUMLLinks.AddLink(): TSLTModelingDiagramUMLLink; begin Result := Add() as TSLTModelingDiagramUMLLink; end;   //------------------------------------------------------------------------------ procedure TSLTModelingDiagramUMLLinks.DeleteRelativeLinks(ALink: TSLTModelingDiagramLink); var I: Integer; begin for I := Count - 1 downto 0 do if Links[I].SubLink = ALink then Delete(I); RepaintLinks(); end;   //------------------------------------------------------------------------------ function TSLTModelingDiagramUMLLinks.GetDiagram(): TSLTModelingDiagramUML; begin Result := inherited Diagram as TSLTModelingDiagramUML; end;   //------------------------------------------------------------------------------ function TSLTModelingDiagramUMLLinks.GetHitTestInfoAt(P: TPoint; out ALink: TSLTModelingDiagramUMLLink): TSLTModelingDiagramLinkHitTests; begin Result := inherited GetHitTestInfoAt(P, TSLTModelingDiagramLink(ALink)); end;   //------------------------------------------------------------------------------ function TSLTModelingDiagramUMLLinks.GetLink(Index: Integer): TSLTModelingDiagramUMLLink; begin Result := TSLTModelingDiagramUMLLink(Items[Index]); end;   //------------------------------------------------------------------------------ function TSLTModelingDiagramUMLLinks.GetLinkClass(): TSLTModelingDiagramLinkClass; begin Result := TSLTModelingDiagramUMLLink; end;   //------------------------------------------------------------------------------ procedure TSLTModelingDiagramUMLLinks.PopupMenuFillMenu(AMenu: TPopupMenu; ALink: TSLTModelingDiagramLink); var mi: TMenuItem; ilt: TSLTModelingDiagramUMLLinkType; begin for ilt := Low(LINK_TYPE_CAPTIONS) to High(LINK_TYPE_CAPTIONS) do begin mi := TMenuItem.Create(AMenu); mi.Caption := LoadResString(LINK_TYPE_CAPTIONS[ilt]); mi.Tag := Ord(ilt); mi.OnClick := PaintBoxPopupMenuItemClickEventHandler; mi.Enabled := ilt <> ltAssociationClass; mi.RadioItem := True; mi.GroupIndex := 1; if ALink is TSLTModelingDiagramUMLLink then mi.Checked := ilt = TSLTModelingDiagramUMLLink(ALink).LinkType; mi.AutoCheck := True; AMenu.Items.Add(mi); end;   inherited PopupMenuFillMenu(AMenu, ALink); end;   //------------------------------------------------------------------------------ procedure TSLTModelingDiagramUMLLinks.PopupMenuItemActionClick(AMenu: TMenuItem; ALink: TSLTModelingDiagramLink; var Handled: Boolean); begin inherited PopupMenuItemActionClick(AMenu, ALink, Handled);   if not Handled and (ALink is TSLTModelingDiagramUMLLink) then begin if AMenu.Checked then Diagram.SelectedLink.LinkType := TSLTModelingDiagramUMLLinkType(AMenu.Tag); Handled := True; end end;   //------------------------------------------------------------------------------ procedure TSLTModelingDiagramUMLLinks.SetDiagram(const Value: TSLTModelingDiagramUML); begin inherited Diagram := Value; end;   { TSLTModelingDiagramUMLLink }   //------------------------------------------------------------------------------ procedure TSLTModelingDiagramUMLLink.Assign(Source: TPersistent); begin if Source is TSLTModelingDiagramUMLLink then begin inherited Assign(Source);   with TSLTModelingDiagramUMLLink(Source) do begin Self.FLinkType := FLinkType; // l'Index sert pour le lien avec un sous-lien, le Assign recopie dans le même ordre ! if Assigned(FSubLink) then Self.SubLinkIndex := FSubLink.Index else Self.SubLinkIndex := -1; end; end else inherited Assign(Source); end;   //------------------------------------------------------------------------------ function TSLTModelingDiagramUMLLink.ComputeArrow(): Boolean; var StartP, EndP: TPoint; Angle: Extended; P1, P2, P3: TPoint; begin Result := False;   // Récupération des points au bord des panels if GetLinePoints(Links.PaintBox, StartP, EndP) then begin // Calcul de l'angle de rotation en considérant le point de fin comme point de rotation Angle := LineAngle(EndP, StartP);   P1 := Point(EndP.X - ARROW_RADIUS_SIZE, EndP.Y - ARROW_RADIUS_SIZE); P2 := Point(EndP.X, EndP.Y); P3 := Point(EndP.X + ARROW_RADIUS_SIZE, EndP.Y - ARROW_RADIUS_SIZE);   // Rotation du Triangle RotateTriangle(P1, P2, P3, EndP, Angle + DegToRad(90)); FArrowInfo.Triangle[0] := P1; FArrowInfo.Triangle[1] := P2; FArrowInfo.Triangle[2] := P3; Result := True; end; end;   //------------------------------------------------------------------------------ function TSLTModelingDiagramUMLLink.ComputeDiamond(): Boolean; var StartP, EndP: TPoint; Angle: Extended; P1, P2, P3, P4: TPoint; begin Result := False;   // Récupération des points au bord des panels if GetLinePoints(Links.PaintBox, StartP, EndP) then begin // Calcul de l'angle de rotation en considérant le point de fin comme point de rotation Angle := LineAngle(EndP, StartP);   P1 := Point(EndP.X, EndP.Y); P2 := Point(EndP.X - ARROW_RADIUS_SIZE, EndP.Y - ARROW_RADIUS_SIZE); P3 := Point(EndP.X - ARROW_RADIUS_SIZE * 2, EndP.Y); P4 := Point(EndP.X - ARROW_RADIUS_SIZE, EndP.Y + ARROW_RADIUS_SIZE); // Rotation du Triangle RotateDiamond(P1, P2, P3, P4, EndP, Angle + DegToRad(180)); FDiamondInfo.Diamond[0] := P1; FDiamondInfo.Diamond[1] := P2; FDiamondInfo.Diamond[2] := P3; FDiamondInfo.Diamond[3] := P4; Result := True; end; end;   //------------------------------------------------------------------------------ destructor TSLTModelingDiagramUMLLink.Destroy(); begin Links.DeleteRelativeLinks(Self);   inherited Destroy(); end;   //------------------------------------------------------------------------------ class function TSLTModelingDiagramUMLLink.GetLineAlignBorder(): Integer; begin Result := inherited GetLineAlignBorder() + ARROW_RADIUS_SIZE; end;   //------------------------------------------------------------------------------ function TSLTModelingDiagramUMLLink.GetLinePoints(OriginControl: TControl; out StartP: TPoint; out EndP: TPoint): Boolean; var ScreenStartP, ScreenEndP, ScreenEndO, MinP, TmpP: TPoint; MinDistance: Integer; Angle: Extended;   procedure CheckMinDistance(); var Distance: Integer; begin Distance := Floor(LineDistance(ScreenStartP, TmpP)); if Distance < MinDistance then begin MinDistance := Distance; MinP := TmpP; end; end;   begin Result := False; if Assigned(PanelStart) and Assigned(PanelStart.Parent) and Assigned(PanelEnd) and Assigned(PanelEnd.Parent) then begin // Les membres PanelStartPoint et PanelEndPoint sont exprimés en coordonnée client de leur point donc respectivement PanelStart et PanelEnd // Ce qui nous intéressent là, ce sont les coordonnées clientes dans l'OriginControl ScreenStartP := PanelStart.ClientToScreen(PanelStartPoint); ScreenEndP := PanelEnd.ClientToScreen(PanelEndPoint); ScreenEndO := PanelEnd.Parent.ClientToScreen(Point(PanelEnd.Left, PanelEnd.Top));   MinDistance := MaxInt;   // Start et End Left TmpP.X := ScreenEndO.X; TmpP.Y := ScreenEndP.Y; CheckMinDistance();   // Start et End Top TmpP.X := ScreenEndP.X; TmpP.Y := ScreenEndO.Y; CheckMinDistance();   // Start et End Right TmpP.X := ScreenEndO.X + PanelEnd.Width; TmpP.Y := ScreenEndP.Y; CheckMinDistance();   // Start et End Bottom TmpP.X := ScreenEndP.X; TmpP.Y := ScreenEndO.Y + PanelEnd.Height; CheckMinDistance();   StartP := OriginControl.ScreenToClient(ScreenStartP); EndP := OriginControl.ScreenToClient(MinP); Result := True; end else begin if Assigned(PanelStart) and Assigned(PanelStart.Parent) and Assigned(FSubLink) then begin // Points du sous-lien FSubLink.GetLinePoints(OriginControl, ScreenStartP, ScreenEndP);   // Calcul de l'angle de rotation en considérant le point de départ du sous-lien comme point de rotation Angle := LineAngle(ScreenStartP, ScreenEndP); // Calcul d'une ligne faisant la moitié du sous-lien partant du point de départ du sous-lien MinDistance := Floor(LineDistance(ScreenStartP, ScreenEndP)) div 2; ScreenEndP := RotatePoint(Point(ScreenStartP.X + MinDistance, ScreenStartP.Y), ScreenStartP, Angle);   StartP := OriginControl.ScreenToClient(PanelStart.ClientToScreen(PanelStartPoint)); EndP := ScreenEndP; Result := True; end; end; end;   //------------------------------------------------------------------------------ function TSLTModelingDiagramUMLLink.GetLinks(): TSLTModelingDiagramUMLLinks; begin Result := TSLTModelingDiagramUMLLinks(inherited Links); end;   //------------------------------------------------------------------------------ function TSLTModelingDiagramUMLLink.GetSubLinkIndex(): Integer; begin if Assigned(FSubLink) then Result := FSubLink.Index else Result := -1; end;   //------------------------------------------------------------------------------ procedure TSLTModelingDiagramUMLLink.PaintArrow(StartP, EndP: TPoint; Closed: Boolean = True); begin with Links.PaintBox do begin if not FArrowInfo.Computed then FArrowInfo.Computed := ComputeArrow();   if FArrowInfo.Computed then begin if Closed then begin Canvas.Brush.Color := clWhite; Canvas.Brush.Style := bsSolid; end else Canvas.Brush.Style := bsClear;   Canvas.Pen.Mode := pmCopy; Canvas.Pen.Color := clBlack; Canvas.Pen.Style := psSolid; if Closed then Canvas.Polygon(FArrowInfo.Triangle) else Canvas.Polyline(FArrowInfo.Triangle); end; end; end;   //------------------------------------------------------------------------------ procedure TSLTModelingDiagramUMLLink.PaintDiamond(StartP, EndP: TPoint; Plain: Boolean = True); begin with Links.PaintBox do begin if not FDiamondInfo.Computed then FDiamondInfo.Computed := ComputeDiamond();   if FDiamondInfo.Computed then begin if Plain then begin Canvas.Brush.Color := clBlack; Canvas.Brush.Style := bsSolid; end else begin Canvas.Brush.Color := clWhite; Canvas.Brush.Style := bsSolid; end;   Canvas.Pen.Mode := pmCopy; Canvas.Pen.Color := clBlack; Canvas.Pen.Style := psSolid; Canvas.Polygon(FDiamondInfo.Diamond); end; end; end;   //------------------------------------------------------------------------------ procedure TSLTModelingDiagramUMLLink.PaintLink(StartP, EndP: TPoint); begin PaintRelation(StartP, EndP); end;   //------------------------------------------------------------------------------ procedure TSLTModelingDiagramUMLLink.PaintRelation(StartP, EndP: TPoint); begin case FLinkType of ltNone : begin PaintLine(StartP, EndP, False, True); end;   ltAssociationUnidirectional : begin PaintLine(StartP, EndP); PaintArrow(StartP, EndP, False); end;   ltAssociationBidirectional : begin PaintLine(StartP, EndP); end;   ltAssociationClass : begin PaintLine(StartP, EndP, True); end;   ltInheritance : begin PaintLine(StartP, EndP); PaintArrow(StartP, EndP); end;   ltImplements : begin PaintLine(StartP, EndP, True); PaintArrow(StartP, EndP); end;   ltAggregationBasic : begin PaintLine(StartP, EndP); PaintDiamond(StartP, EndP, False); end;   ltAggregationComposition : begin PaintLine(StartP, EndP); PaintDiamond(StartP, EndP); end; end; end;   //------------------------------------------------------------------------------ procedure TSLTModelingDiagramUMLLink.ResetComputed(); begin inherited ResetComputed();   FArrowInfo.Computed := False; FDiamondInfo.Computed := False; end;   //------------------------------------------------------------------------------ procedure TSLTModelingDiagramUMLLink.SetLinkType(const Value: TSLTModelingDiagramUMLLinkType); begin if FLinkType <> Value then begin FLinkType := Value; RepaintLink(); end; end;   //------------------------------------------------------------------------------ procedure TSLTModelingDiagramUMLLink.SetSubLinkIndex(const Value: Integer); begin if (0 <= Value) and (Value < Links.Count) then FSubLink := Links.Links[Value] as TSLTModelingDiagramUMLLink else FSubLink := nil; end;           end.

---

Bonjour,
et merci a ceux qui m'ont répondu :D
je me demandais si j'allais pas laisser tomber, il me manque quelques bases j'avoue... :oops:

Citation:

---

Envoyé par SergioMaster

Bonjour,

je cherchais surtout a comprendre l'objectif avant de répondre (de plus il fallait que je revois le post :roll: )

il me semble que la JVCL contient un exemple et des composants pour faire ce genre de choses . Voir tout ce qui concerne Jim Cooper's Diagramming Comp dans le répertoire exemple ...\jvcl\examples\JvDiagramShape

---

j'ai fouillé la jvcl mais je ne trouve pas "JvDiagramShape" ... un addon ou une autre version ?

ShaiLeTroll
j'ai téléchargé ton source mais pour le moment suis plus comme une poule qui a trouvé un couteau ^^

j'ouvre PackageSLTLite160.dproj (je suppose que c'est un composant ?) et lorsque je compile j'ai une erreur: "[dcc32 Erreur fatale] PackageSLTLite160.dpk(40): E2202 Package 'dac160' requis non trouvé"

il doit me manquer une brique. En cherchant sur Google (le meilleur amis du développeur autodidacte ^^) je tombe sur "http://forums.devart.com/viewtopic.php?t=23531"
avant de faire des bétises sur ma machine si tu pouvais me préciser de quoi il retourne ? copier/coller sans piger au moins un minimum j'aime pas trop ... ok ça ne devait visiblement pas être ça ...

bon je vois bien qu'il y a des exemples mais il faut un pré-requi (oui je sais on en revient a la poule avec son couteau ou un castore avec du papier tue-mouche ^^) il me faut installer un composant pour que ça marche ?

Merci de votre aide

JY

tu n'es pas obligé d'installer le Package
Surtout qu'il est loin d'être fini, je fusionne tant bien que mal plusieurs versions qui ont évolué différemment (en D7 et en C++BuilderXE3 vers DXE2)

Tu prend le projet SLTModeling.dproj
Tu n'as que deux dépendances, facile c'est les uses en SLT.*
Tu ajoutes au projet '..\SLT\Common\SLT.Common.TypesEx.pas'
et '..\SLT\Common\SLT.Common.RTTI.pas'

Normalement cela suffit pour le compiler le projet
Tu peux intégrer librement les unités dans un autre projet
'..\SLT Modeling\src\classes\SLTModelingDiagramClasses.pas'
'..\SLT Modeling\src\classes\SLTModelingDiagramUMLClasses.pas'
'..\SLT\Common\SLT.Common.TypesEx.pas'
'..\SLT\Common\SLT.Common.RTTI.pas'

tu peux aussi utiliser '..\SLT Modeling\src\ihm\SLTModelingDiagramFrm.pas'
mais je te conseille de faire ta propre fenêtre pour comprendre comme s'utilise la classe TSLTModelingDiagramUML





Si tu veux installer le package
il n'y a pas de composant dedans pour le moment,
c'est juste que cela génère le DCU
Cela n'a pas un grand intérêt !

Il te faut retirer du Package le fichier 'SLT.DB.Provider_ODAC.pas'
sinon cela provoque une dépendance à ODAC de Devart.

Dans les Variables :

Code:

---

INSTALLDIR_SoLuTionLib=C:\Dev\SoLuTion

---

C:\Dev\ c'est ta racine des sources, je te laisse choisir


Dans les chemins de bibliothèque :

Code:

---

1 2 3 4 5 6 7

$(INSTALLDIR_SoLuTionLib)\SLT\Common $(INSTALLDIR_SoLuTionLib)\SLT\DB $(INSTALLDIR_SoLuTionLib)\SLT\ETL $(INSTALLDIR_SoLuTionLib)\SLT\Tools $(INSTALLDIR_SoLuTionLib)\SLT\Controls\VCL $(INSTALLDIR_SoLuTionLib)\SLT\Persistence $(INSTALLDIR_SoLuTionLib)\SLT\Dependency\JEDI\JWA

---

Citation:

---

Envoyé par JYH

j'ai fouillé la jvcl mais je ne trouve pas "JvDiagramShape" ... un addon ou une autre version ?

---

une vieille version ? peut être , j'en ai plusieurs sur mon disque j'ai regardé la 3.34

Bonjour,

ShaiLeTroll :

J’ai testé ta solution qui a l’air bien sympa mais j’avoue être un peu perdu dans tous ça, je n’ai pas le niveau pour y voir clair rapidement, je vais donc garder ça sous le coude le temps de regarder sur la jvcl… de toute façon je suis certain d’apprendre des trucs avant de revenir sur ton code (qui au passage est bien commenté :ccool:)

SergioMaster :

ma version est encore plus vielle 3.00 mais j’ai téléchargé une plus récente et trouvé l’exemple dont tu parles.
Si j’ai bien pigé, l’exemple utilise l’unité « JvDiagramShape » qu’il me faut comprendre pour voir si cela va me dépanner. Le code n’est pas simple non plus mais il n’y a que 2 unités à décortiquer.

Merci à vous 2 de m'aider, je regarde ça ce WE je vous tiendrais au courant.

Nb: à relire la signature de ShaiLeTroll je suis tenté de piocher dans tous les sources que je lis et repartir d’une feuille blanche afin de mieux comprendre les mécanismes en jeu…
Mon niveau en Delphi se limite trop à poser des composants sur une forme pour alimenter des bases de données SQL.
J'entends, j'oublie. Je vois, je me souviens. Je fais, je comprends. (confucius aussi ?)


JY

Citation:

---

Envoyé par JYH

Repartir d’une feuille blanche afin de mieux comprendre les mécanismes en jeu…

---

C'est une très bonne idée !
D'ailleurs mon code est plus expérimental qu'autre chose !
En fait, c'est parti du début d'utiliser un TPanel déplaçable (WS_THICKFRAME) à la place de TForm avec Parent suite à un module dans le progiciel que je maintenais où j'ai justement fait un système de suivi de mouvement de personne avec des vignettes TForm
J'avais déjà bidouillé cela avec TPanel en C++ en jouant sur WS_SIZEBOX et WM_SYSCOMMAND\SC_MOVE

Puis comme je suis nul en Sinus\Cosinus cela m'a demandé quelques efforts surtout au début que j'avais oublié que mes fonctions D7 utilisaient des degrés converti en radians et mes fonctions BCB2007 tout en radian :mouarf:

Je me fais une sorte de bibliothèque d'astuce avec une démo avec un objectif utile (avant j'avais un tas de truc que je ne retrouvais jamais dans mon appli d'expérimentation)
Puis je transforme ces astuces quand cela est possible en classes réutilisables !

Citation:

---

Envoyé par JYH

Mon niveau en Delphi se limite trop à poser des composants sur une forme pour alimenter des bases de données SQL.

---

Tu n'es vraiment pas le seul, c'est un grand classique avec Delphi, le RAD ou rien !

Bonjour,
Pour continuer mon projet je compte partir de cette source comme inspiration première :

http://delphi.developpez.com/telecha...ttern-Observer

Gros avantage, 3 unités de moins de 300 lignes chaque:
BallRenderer, BallsImpl et ObserverPattern (le dernier me semble le plus obscur pour le moment)

1) Faire quelques modifications pour tracer des rectangles avec des propriétés supplémentaires
2) Renommer les différentes class pour coller à mon projet, ce qui m’obligera à parcourir tous les liens et interactions
3) Dessiner les liens et les enregistrer

Bonne piste ? Un avis ?

JY

Citation:

---

Envoyé par JYH

ObserverPattern (le dernier me semble le plus obscur)

---

C'est l'application d'une Design Pattern - l'Observateur !
Ce n'est pas le graphisme qui est intéressant dans ce tutoriel mais la mise en œuvre du patron de conception !

Ne devais-tu pas te lancer "d’une feuille blanche" ?

Tu vas avoir tellement d'inspiration qu'au final, cela sera plus proche de la bidouille !

Depuis un mois que tu bosses dessus, tu aurais tenté un truc par toi même cela aurait été fini et je le dis d'expérience puisque j'ai codé TSLTModelingDiagramUML en un peu plus de deux jours entre deux projets professionnels.