Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

  1. #21
    Membre expert
    Citation Envoyé par jurassic pork Voir le message

    EDIT : OK c'est bon maintenant en installant les paquets dt mais en voulant installer tous les paquets ensuite lazarus ne s'ouvre plus
    Il faut faire attention à l'ordre d'installation des paquets, el mieux c'est d'abord de compiler les paquets "rt" dans l'ordre que je donne, puis installer un à un les paquets "dt"
    d'abord "bzscene_tools_dt" puis "bzscene_image_dt"

    si Lazarus ne s'ouvre plus c'est un des paquets "DT" qui coince. Je parierai sur "bzscene_audio_rt / bzscene_audio_dt" qui est capricieux, donc laisse tomber celui-ci pour le moment.

    PS : Il faut également que tu installes les DLL surtout "FreeType" dans "c:\Windows\system32" pour les 64 bits et dans "c:\Windows\sysWOW64" pour les 32 bits
    Si tu as voulu installer "bzscene_audio_rt" c'est surement qu'il faille copier la DLL de BASS (car celle-ci n'est pas chargée dynamiquement,. J'y travail)
    Toutes les DLL requisent pour Windows sont présentes dans le dossier "Externals" de BZScene.

    Pour Linux, il faudra installer les bibliothèques requises via ton gestionnaire de dépôt.
    • "L'Homme devrait mettre autant d'ardeur à simplifier sa vie qu'il met à la compliquer" - Henri Bergson
    • "Bien des livres auraient été plus clairs s'ils n'avaient pas voulu être si clairs" - Emmanuel Kant
    • "La simplicité est la sophistication suprême" - Léonard De Vinci
    • "Ce qui est facile à comprendre ou à faire pour toi, ne l'est pas forcément pour l'autre." - Mon pèrei

    Mes projets sur Github - Blog - Site DVP

  2. #22
    Expert confirmé
    Ok maintenant je peux ouvrir le projet mais quand je veux compiler j'ai cette erreur :
    unit1.pas(747,34) Error: identifier idents no member "InCircle"
    Jurassic computer : Sinclair ZX81 - Zilog Z80A à 3,25 MHz - RAM 1 Ko - ROM 8 Ko

  3. #23
    Membre expert
    Citation Envoyé par jurassic pork Voir le message
    Ok maintenant je peux ouvrir le projet mais quand je veux compiler j'ai cette erreur :
    Décidement, désolé, pour les soucis, (je ne pensais pas que vous alliez vouloir tester BZScene ) oups Effectivement cette méthode n'est pas présente , je l'ai rajouté pendant la game jam

    Remplaces

    Code :Sélectionner tout -Visualiser dans une fenêtre à part
    if (FMousePos.AsVector2f.InCircle(Node.Position.XY, 8)) then


    par

    Code :Sélectionner tout -Visualiser dans une fenêtre à part
    if PointInCircle(FMousePos.X; FMousePos.Y, Node.Position.X, Node.Position.Y, 8) then  // méthode présente dans l'unité BZGraphic
    • "L'Homme devrait mettre autant d'ardeur à simplifier sa vie qu'il met à la compliquer" - Henri Bergson
    • "Bien des livres auraient été plus clairs s'ils n'avaient pas voulu être si clairs" - Emmanuel Kant
    • "La simplicité est la sophistication suprême" - Léonard De Vinci
    • "Ce qui est facile à comprendre ou à faire pour toi, ne l'est pas forcément pour l'autre." - Mon pèrei

    Mes projets sur Github - Blog - Site DVP

  4. #24
    Membre averti
    Ce que j'ai besoin: du simple
    Bjr à vous,

    J'ai besoin de quelque chose de simple.

    Mes noeuds sont structurés de la manière suivante, le graphe étant orienté:
    TNumeroArc et TNumeroNoeud sont des integer
    Code :Sélectionner tout -Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
     
    type TGrapheNoeud = record
      IDStation: TIDStation; // il s'agit ici d'une étiquette représentant un nombre Int64
      X  : double;
      Y  : double;
      Z  : double;
      ListeArcsSortants    : array of TNumeroArc; 
      ListeArcsEntrants    : array of TNumeroArc;
    end;

    et mes arcs:
    Code :Sélectionner tout -Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
     
    type TGrapheArc = record
      IdxNoeudDepart  : TNumeroNoeud;
      IdxNoeudArrivee : TNumeroNoeud;
      Longueur        : double; // le poids, ici la longueur de l'arc
      Azimut          : double;
      Pente           : double;
    end;



    Mon objet TGraphe comporte deux tableaux dynamiques dont la taille est le nombre de noeuds:

    FArrayDistancesMin: array of double; dont les éléments sont initialisés à +Infini
    Cette liste est triée selon les étiquettes, elle comporte une fonction de recherche dicho:
    Code :Sélectionner tout -Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
     
    function TGraphe.FindNoeudByIDStation(const IDS: TIDStation; out ST: TGrapheNoeud; out IndexOf: TNumeroNoeud): boolean;
      function FindDepth(const I1, I2: TNumeroNoeud; const QIDX: TIDStation): TNumeroNoeud;
      var
        PVT: integer;
        C1 : TGrapheNoeud;
      begin
        Result := -1;
        // coupure en deux => calcul index médian
        PVT := (I2 + I1) div 2;
        // début > fin >> sortie directe avec erreur
        if (I1 > I2) then Exit(-1);
        C1 := GetNoeud(PVT); //GetBasePoint(PVT);
        // comparaison. Si vrai >> sortie avec numéro d'index
        if (C1.IDStation = QIDX) then Exit(PVT);
        // sinon, recherche en profondeur avec un niveau supplémentaire
        if (QIDX < C1.IDStation) then
        begin
          Result := FindDepth(I1, PVT-1, QIDX);
          Exit;
        end;
        Result := FindDepth(PVT+1, I2, QIDX);
      end;
    begin
      Result := false;
      IndexOf := FindDepth(0, GetNbNoeuds() - 1, IDS);
      if (IndexOf >= 0) then
      begin
        ST     := GetNoeud(IndexOf);
        Exit(True);
      end;
    end;


    et le tableau
    FArrayNoeudsVisites: array of boolean; dont les éléments sont initialisés à false

    Au démarrage de ma recherche, je procède aux initialisations suivantes:
    Code :Sélectionner tout -Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
     
      Result := false;
      FLeCheminTrouve.ClearListe();
      // sécurité: On met les distances minimales à +Inf et le statut Visité à False
      ResetTableauDistancesMin();
      ResetTableauNoeudsVisites();   
      // Recherche des noeuds de départ et d'arrivée
      Q1 := FindNoeudByIDStation(MakeTIDStation(Ser1, St1), QNoeudDepart, IdxNoeudDepart);
      if (Not Q1) then Exit(SetLastError(ERR_GRAPHE_NODE_NOT_FOUND, Format('Noeud "%d.%d" introuvable', [Ser1, St1])));
      Q1 := FindNoeudByIDStation(MakeTIDStation(Ser2, St2), QNoeudArrivee, IdxNoeudArrivee);
      if (Not Q1) then Exit(SetLastError(ERR_GRAPHE_NODE_NOT_FOUND, Format('Noeud "%d.%d" introuvable', [Ser2, St2])));
      FAfficherMessage(Format('%s.RechercherPlusCourtChemin(): %d: %d.%d -> %d: %d.%d', [ClassName, IdxNoeudDepart, Ser1, St1, IdxNoeudArrivee, Ser2, St2]));
      // Stations identiques -->[ ]
      Q1 := (Ser1 = Ser2) and (St1 = St2);
      if (Q1) then Exit(SetLastError(ERR_GRAPHE_SAME_START_END, '-- Les stations de départ et arrivée sont identiques'));
     
     
      // Le noeud courant est le noeud de départ
      QIdxNoeudCourant := IdxNoeudDepart;
      QNoeudCourant    := GetNoeud(QIdxNoeudCourant);
      // affichage de l'acquittement
      FAfficherMessage(Format('%s.RechercherPlusCourtChemin(): Acquittement %d: %d.%d -> %d: %d.%d', [ClassName, IdxNoeudDepart, Ser1, St1, IdxNoeudArrivee, Ser2, St2]));
      // La distance du noeud de départ est mise à 0.00
      FArrayDistancesMin[QIdxNoeudCourant] := 0.00;
      // Doit-on marquer 'Visité' le noeud de départ ici ?
      FArrayNoeudsVisites[IdxNoeudDepart] := True;
      // Pour contrôle
      ListerLesNoeuds('Après initialisation de la première itération', false);


    Dans le while:
    Code :Sélectionner tout -Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
     
    while (Not NoeudsTousVisites()) do
      begin
        //FAfficherMessage(format('Passe %d - Noeud traité: %d ', []));
        if (NbPasses > 200) then break;  // Butée d'arrêt pour éviter les boucles infinis lors de la mise au point
        // Recherche le noeud non visité le plus proche
        QIdxNoeudCourant := RechercherIdxNearestNodeOf(QNoeudCourant, QDistanceMinNoeudVoisin);    // Noeud non visité de distance minimale
        // Sécurité: On quitte si le noeud n'est pas trouvé (ne devrait jamais se produire)
        if (QIdxNoeudCourant = -1) then
        begin
          exit(SetLastError(ERR_GRAPHE_NODE_NOT_FOUND, 'Noeud non trouvé'));
        end;
        // Si le nouveaud noeud est le noeud d'arrivée, on sort de la boucle
        if (QIdxNoeudCourant = IdxNoeudArrivee) then
        begin
          FAfficherMessage(Format('%d == %d', [QNoeudCourant.IDStation , QNoeudArrivee.IDStation]));
          FArrayNoeudsVisites[QIdxNoeudCourant] := True;
          break;
        end;
        // le noeud courant devient le plus proche qui a été trouvé
        QNoeudCourant := GetNoeud(QIdxNoeudCourant);
        FArrayNoeudsVisites[QIdxNoeudCourant] := True;
        // Pour les arcs sortants
        NbArcsSortants := Length(QNoeudCourant.ListeArcsSortants);
        if (NbArcsSortants > 0) then
        begin
          FAfficherMessage(Format('%d: %d arcs sortants', [QNoeudCourant.IDStation, NbArcsSortants]));
          for a := 0 to NbArcsSortants - 1 do
          begin
            qIdxArc   := QNoeudCourant.ListeArcsSortants[a];
            QArc      := GetArc(qIdxArc);
            // On attrappe le successeur
            QIdxNoeudSuccesseur := QArc.IdxNoeudArrivee;
            QST1                := GetNoeud(QIdxNoeudSuccesseur);
            QDistance1 := FArrayDistancesMin[QIdxNoeudCourant]    + QArc.Longueur;
            QDistance2 := FArrayDistancesMin[QIdxNoeudSuccesseur] + QArc.Longueur;
            if (QDistance2 < QDistance1) then
            begin
              FArrayDistancesMin[QIdxNoeudSuccesseur]  := QDistance1;
              FArrayNoeudsVisites[QIdxNoeudSuccesseur] := True;
              // mise à jour du prédécesseur
              QArc.IdxNoeudDepart := QIdxNoeudCourant;
              PutArc(a, QArc);
              FAfficherMessage(Format('Changement du noeud courant: %d devient %d', [QNoeudCourant.IDStation, QST1.IDStation]));
              QIdxNoeudCourant := QIdxNoeudSuccesseur;
              QNoeudCourant := GetNoeud(QIdxNoeudCourant);
              // on met à jour le tableau des distances
              FArrayDistancesMin[QIdxNoeudSuccesseur]  += QDistanceMinNoeudVoisin;
            end;
          end;
        end;
        Inc(NbPasses);
        // pour contrôle après la passe
        ListerLesNoeuds(Format('Passe %d', [NbPasses]));
        // Afficher le graphe
        FAfficherGraphe();
      end;

  5. #25
    Membre expert
    Citation Envoyé par JP CASSOU Voir le message
    Bjr à vous,

    J'ai besoin de quelque chose de simple.

    Mes noeuds sont structurés de la manière suivante, le graphe étant orienté:
    TNumeroArc et TNumeroNoeud sont des integer

    Code :Sélectionner tout -Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
     
    type TGrapheNoeud = record
      IDStation: TIDStation; // il s'agit ici d'une étiquette représentant un nombre Int64
      X  : double;
      Y  : double;
      Z  : double;
      ListeArcsSortants    : array of TNumeroArc; 
      ListeArcsEntrants    : array of TNumeroArc;
    end;

    et mes arcs:
    Code :Sélectionner tout -Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
     
    type TGrapheArc = record
      IdxNoeudDepart  : TNumeroNoeud;
      IdxNoeudArrivee : TNumeroNoeud;
      Longueur        : double; // le poids, ici la longueur de l'arc
      Azimut          : double;
      Pente           : double;
    end;




    Avec le code que j'ai donné il n'y pas plus simple :
    Il faut juste, faire quelques adaptions dans les classes de bases

    Code :Sélectionner tout -Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
     
      TNumeroNoeud = Integer;
      TArrayOfNumeroNoeud = Array of TNumeroNoeud 
      TNode = Class
      private
        FOwner : TGraphNode;
     
        FPosition : TBZVector;  // = X, Y, Z on peut remplacer aussi par Latitude, Longitude, Elevation
     
        FNodeLinkList : TNodeLinkList;
        FNodeIndex : Integer;
     
               FIDStation : Integer;
     
        procedure SetOwner(const AValue: TGraphNode);
        function geNodeLink(Index : Integer): TNodeLink;
     
        procedure seNodeLink(Index : Integer; const AValue: TNodeLink);
     
              function getArcsSortants : TArrayOfNumeroNoeud;
              function getArcEntrants : TArrayOfNumeroNoeud;
     
      public
        constructor Create(AOwner : TGraphNode; APosition : TBZVector);
        destructor Destroy; override;
     
        function AddNodeLink(anIndex : Integer) : TNodeLink; overload;
     
     
        property Owner : TGraphNode read FOwner write SetOwner;
        property Position : TBZVector read FPosition write FPosition;
        property NodeIndex : Integer read FNodeIndex write FNodeIndex;
        property LinkNode[Index : Integer] : TNodeLink read geNodeLink write seNodeLink;
        property NodeLinkList : TNodeLinkList read FNodeLinkList;
     
                 property IDStation : Integer read FIDSTation write FIDStation;
     
                 property ListeArcsSortants  :  TArrayOfNumeroNoeud read getArcsSortants ; // Ca correspond a "NodeLinkList"   ou a récupérer via "NodeLinkList" et la propriété "TargetIndex"
                 property ListeArcsEntrants   : TArrayOfNumeroNoeud read getArcEntrants;   // A récupérer via "FOwner"pour chaque noeud, on va chercher les liens dans le "NodeLinkList", qui pointe "TargetIndex" vers ce noeud "NodeIndex"
      end;   
     
      { TNodeLink }
      TNodeLink = class
      private
        FOwner : TNodeLinkList;
        FTargetNodeIndex : Integer;
     
                        // FDistance : Single; // = Longueur On peut le garder mémoire
                       FAzimut          : double;
                       FPente           : double;
     
        procedure SetTargetNodeIndex(const AValue: Integer);
        procedure SetOwner(const AValue: TNodeLinkList);
        function getDistance: Single;
        function getNode: TNode;
        function getParentNode: TNode;
     
                    function GetAzimut : Double;
                    function GetPente : Double;
     
     
      public
        constructor Create(AOwner : TNodeLinkList; ATargetNodeIndex : Integer);
        destructor Destroy; override;
     
        property TargetNodeIndex : Integer read FTargetNodeIndex write SetTargetNodeIndex;
        property Owner : TNodeLinkList  read FOwner write setOwner;
     
                 property Distance : Single read getDistance;   //FDistance = Longueur
     
        property Node : TNode read getNode;
        property ParentNode : TNode read getParentNode;
     
                property Azimut : Double read getAzimut;
                property Pente : Double read getPente;
      end;


    Ensuite tu peux rajouter des méthodes globales, dans TGraphNode pour simplifier la gestion de tout ce petit monde

    Pour ce qui est de

    Code :Sélectionner tout -Visualiser dans une fenêtre à part
    1
    2
    3
     
      IdxNoeudDepart  : TNumeroNoeud;
      IdxNoeudArrivee : TNumeroNoeud;


    Je ferai une simple liste répertoriant les stations

    Code :Sélectionner tout -Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
     
    Type
      TStation = record
        IDStation : Integer;
        IdxNoeudDepart  : TNumeroNoeud;  // je pas trop à quoi ca sert car la station est fixe
        IdxNoeudArrivee : TNumeroNoeud; 
      end;
     
      TListeStation = Array of TStation;


    Ce qui permettrai d'appeler la methode de recherche (à modifier légerement pour rechercher le noeud en fonction de IDStation [c]GraphNode.Dijkstra(ListeStation['BoutDuMonde"].IDStation, ListeStation['BoutDuMonde"].IdxNoeudArrive[4]);

    Du moins quelques chose dans le genre, et j'engloberai tout ca dans une classe "TGestionLignesMetro" avec des méthodes pour ajouter des lignes et des stations.
    • "L'Homme devrait mettre autant d'ardeur à simplifier sa vie qu'il met à la compliquer" - Henri Bergson
    • "Bien des livres auraient été plus clairs s'ils n'avaient pas voulu être si clairs" - Emmanuel Kant
    • "La simplicité est la sophistication suprême" - Léonard De Vinci
    • "Ce qui est facile à comprendre ou à faire pour toi, ne l'est pas forcément pour l'autre." - Mon pèrei

    Mes projets sur Github - Blog - Site DVP

  6. #26
    Membre averti
    Quand je dis 'simple', c'est sans utilisation de la librairie BZ, dans un premier temps

    Citation Envoyé par BeanzMaster Voir le message
    Avec le code que j'ai donné il n'y pas plus simple :
    Il faut juste, faire quelques adaptions dans les classes de bases

    Code :Sélectionner tout -Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
     
      TNumeroNoeud = Integer;
      TArrayOfNumeroNoeud = Array of TNumeroNoeud 
      TNode = Class
      private
        FOwner : TGraphNode;
     
        FPosition : TBZVector;  // = X, Y, Z on peut remplacer aussi par Latitude, Longitude, Elevation
     
        FNodeLinkList : TNodeLinkList;
        FNodeIndex : Integer;
     
               FIDStation : Integer;
     
        procedure SetOwner(const AValue: TGraphNode);
        function geNodeLink(Index : Integer): TNodeLink;
     
        procedure seNodeLink(Index : Integer; const AValue: TNodeLink);
     
              function getArcsSortants : TArrayOfNumeroNoeud;
              function getArcEntrants : TArrayOfNumeroNoeud;
     
      public
        constructor Create(AOwner : TGraphNode; APosition : TBZVector);
        destructor Destroy; override;
     
        function AddNodeLink(anIndex : Integer) : TNodeLink; overload;
     
     
        property Owner : TGraphNode read FOwner write SetOwner;
        property Position : TBZVector read FPosition write FPosition;
        property NodeIndex : Integer read FNodeIndex write FNodeIndex;
        property LinkNode[Index : Integer] : TNodeLink read geNodeLink write seNodeLink;
        property NodeLinkList : TNodeLinkList read FNodeLinkList;
     
                 property IDStation : Integer read FIDSTation write FIDStation;
     
                 property ListeArcsSortants  :  TArrayOfNumeroNoeud read getArcsSortants ; // Ca correspond a "NodeLinkList"   ou a récupérer via "NodeLinkList" et la propriété "TargetIndex"
                 property ListeArcsEntrants   : TArrayOfNumeroNoeud read getArcEntrants;   // A récupérer via "FOwner"pour chaque noeud, on va chercher les liens dans le "NodeLinkList", qui pointe "TargetIndex" vers ce noeud "NodeIndex"
      end;   
     
      { TNodeLink }
      TNodeLink = class
      private
        FOwner : TNodeLinkList;
        FTargetNodeIndex : Integer;
     
                        // FDistance : Single; // = Longueur On peut le garder mémoire
                       FAzimut          : double;
                       FPente           : double;
     
        procedure SetTargetNodeIndex(const AValue: Integer);
        procedure SetOwner(const AValue: TNodeLinkList);
        function getDistance: Single;
        function getNode: TNode;
        function getParentNode: TNode;
     
                    function GetAzimut : Double;
                    function GetPente : Double;
     
     
      public
        constructor Create(AOwner : TNodeLinkList; ATargetNodeIndex : Integer);
        destructor Destroy; override;
     
        property TargetNodeIndex : Integer read FTargetNodeIndex write SetTargetNodeIndex;
        property Owner : TNodeLinkList  read FOwner write setOwner;
     
                 property Distance : Single read getDistance;   //FDistance = Longueur
     
        property Node : TNode read getNode;
        property ParentNode : TNode read getParentNode;
     
                property Azimut : Double read getAzimut;
                property Pente : Double read getPente;
      end;


    Ensuite tu peux rajouter des méthodes globales, dans TGraphNode pour simplifier la gestion de tout ce petit monde

  7. #27
    Membre expert
    Citation Envoyé par JP CASSOU Voir le message
    Quand je dis 'simple', c'est sans utilisation de la librairie BZ, dans un premier temps
    Tu n'est pas obligé, d'utiliser BZScene.
    C'est sure il y a un peu de travail à faire pour l'adaptation.
    Tu va quand même pas me dire que mon code est super dure à comprendre et à lire ? si ?

    TNode = Class ça c'est du pascal pure et dure et pas besoin de BZScene

    Tu utilises déja des listes générique type TListeSimple<T> = class(TFPList) dans ton code, il suffit juste d'adapter, non ?
    Je pense que c'est à ta porté, de remplacer TNodeLinkList = class(specialize TBZBaseArray<TNodeLink>) par ta liste générique type TListeSimple<T> = class(TFPList) non ?
    Je t'apporte déja une solution gratuitement, c'est déja pas mal non ?

    Donc soit tu adaptes mon code a tes contraintes, soit tu adaptes l'aglo que je t'ai fournis à ton code. Tu as tous les éléments en main.

    Après tu fais comme tu veux, c'est toi qui voit.

    A+

    Jérôme
    • "L'Homme devrait mettre autant d'ardeur à simplifier sa vie qu'il met à la compliquer" - Henri Bergson
    • "Bien des livres auraient été plus clairs s'ils n'avaient pas voulu être si clairs" - Emmanuel Kant
    • "La simplicité est la sophistication suprême" - Léonard De Vinci
    • "Ce qui est facile à comprendre ou à faire pour toi, ne l'est pas forcément pour l'autre." - Mon pèrei

    Mes projets sur Github - Blog - Site DVP

  8. #28
    Expert confirmé
    hello,
    Citation Envoyé par BeanzMaster Voir le message
    Décidement, désolé, pour les soucis, (je ne pensais pas que vous alliez vouloir tester BZScene ) oups Effectivement cette méthode n'est pas présente , je l'ai rajouté pendant la game jam

    Remplaces

    Code :Sélectionner tout -Visualiser dans une fenêtre à part
    if (FMousePos.AsVector2f.InCircle(Node.Position.XY, 8)) then


    par

    Code :Sélectionner tout -Visualiser dans une fenêtre à part
    if PointInCircle(FMousePos.X; FMousePos.Y, Node.Position.X, Node.Position.Y, 8) then  // méthode présente dans l'unité BZGraphic
    Arf j'avais encore des erreurs de compilation sur le code de substitution :
    il y avait un ; au lieu d'un , après le 1 er argument mais plus difficile Node.Position.X, Node.Position.Y sont des singles alors qu'on doit passer des Longint ( obligé de caster ) :
    Code :Sélectionner tout -Visualiser dans une fenêtre à part
    1
    2
          if PointInCircle(FMousePos.X, FMousePos.Y,
                    integer(Node.Position.X), integer(Node.Position.Y), 8) then


    j'arrive enfin à compiler le programme mais quand je l'exécute j'ai directement un :
    Execution stopped

    ce qui explique pourquoi quand je lance l'exécutable du zip rien ne se passe.

    comme antivirus j'ai windows defender qui n'a pas l'air de broncher.

    EDIT : Bon finalement en mode debug j'ai un message d'erreur comme quoi il n'arrive pas à charger la dll freetype . Comme je suis en Lazarus 32 bits j'ai mis la dll 32 bits de externals dans SYSWOW64 et même dans le répertoire du projet mais toujours le message d'erreur avec après un execution stopped

    EDIT2 : Bon j'ai été chercher la dll freetype sur le net ici et là ça fonctionne donc elle est peut-être mauvaise dans ton zip.

    EDIT3: Bon le cast en integer n'était pas une bonne idée car la fonction ne fonctionnait pas. Finalement dans BzGraphics j'ai créé une nouvelle fonction :

    Code :Sélectionner tout -Visualiser dans une fenêtre à part
    function PointInCircleSingle(const px,py,cx,cy: Single; const Radius:Integer): boolean; inline;


    appelée comme ceci :
    Code :Sélectionner tout -Visualiser dans une fenêtre à part
    1
    2
            if PointInCircleSingle(FMousePos.AsVector2f.X, FMousePos.AsVector2f.Y,
                      Node.Position.X, Node.Position.Y, 8) then


    et là ça fonctionne

    Ami calmant, J.P
    Jurassic computer : Sinclair ZX81 - Zilog Z80A à 3,25 MHz - RAM 1 Ko - ROM 8 Ko

  9. #29
    Membre averti
    Citation Envoyé par BeanzMaster Voir le message
    Tu n'est pas obligé, d'utiliser BZScene.
    C'est sure il y a un peu de travail à faire pour l'adaptation.
    Tu va quand même pas me dire que mon code est super dure à comprendre et à lire ? si ?

    TNode = Class ça c'est du pascal pure et dure et pas besoin de BZScene

    Tu utilises déja des listes générique type TListeSimple<T> = class(TFPList) dans ton code, il suffit juste d'adapter, non ?
    Je pense que c'est à ta porté, de remplacer TNodeLinkList = class(specialize TBZBaseArray<TNodeLink>) par ta liste générique type TListeSimple<T> = class(TFPList) non ?
    Je t'apporte déja une solution gratuitement, c'est déja pas mal non ?

    Donc soit tu adaptes mon code a tes contraintes, soit tu adaptes l'aglo que je t'ai fournis à ton code. Tu as tous les éléments en main.

    Après tu fais comme tu veux, c'est toi qui voit.

    A+

    Jérôme
    Bsr,

    J'ai cherché dans les sources de BZScene (https://github.com/jdelauney/BZScene...er/Source/Core) mais je ne trouve pas les unités concernant les graphes.
    cdlt

  10. #30
    Membre averti
    Bsr,

    Je ne m'en sors toujours pas, et çà me gonfle. C'est du pénible +++

    Je précise que je ne dois utiliser que les éléments suivants (çà m'est imposé)

    - Une liste des noeuds
    - Une liste des arcs
    - Un tableau 0.. n-1 des distances
    - Un tableau 0 .. n-1 des sommets visités

    Code :Sélectionner tout -Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
     
    type TNumeroArc   = type Integer;
    type TIDStation = type Int64;
    type TGrapheNoeud = record
      IDStation: TIDStation;
      X  : double;
      Y  : double;
      Z  : double;
      ListeArcsSortants    : array of TNumeroArc;
      ListeArcsEntrants    : array of TNumeroArc;
    end;
    type TGrapheArc = record
      IdxNoeudDepart  : TNumeroNoeud;
      IdxNoeudArrivee : TNumeroNoeud;
      Longueur        : double;   // le poids, ici la longueur de l'arc
      Azimut          : double;   // pour la détermination du cap de la visée suivante
      Pente           : double;
    end;


    Je suis sur le sujet depuis plusieurs jours et je n'avance pas.
    La sous-traitance est sérieusement envisagée. J'ai un concours interne (pas en info) demain.

    La fonction RechercherPlusCourtChemin() modifiée
    Code :Sélectionner tout -Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    90
    91
    92
    93
    94
    95
    96
    97
     
    function TGraphe.RechercherPlusCourtChemin(const Ser1, St1, Ser2, St2: integer): boolean;
    var
      QDistanceMinNoeudVoisin: Double;  // distance du noeud le plus proche du noeud courant
      QNoeudDepart, QNoeudArrivee, QNoeudCourant, QST1: TGrapheNoeud;
      IdxNoeudDepart, IdxNoeudArrivee: TNumeroNoeud;
      //QIdxPredecesseur, QIdxNoeudSuccesseur: TNumeroNoeud;
     
      i, QIdxNoeudCourant, a, NbArcsSortants, NbPasses: integer;
      Q1: Boolean;
      QArc: TGrapheArc;
      qIdxArc: TNumeroArc;
      QDistance1, QDistance2: double;
    begin
      Result := false;
      FLeCheminTrouve.ClearListe();
      // sécurité: On met les distances minimales à +Inf et le statut Visité à False
      ResetTableauDistancesMin();
      ResetTableauNoeudsVisites();
      SetLastError(0, '');
      // Recherche des noeuds de départ et d'arrivée
      Q1 := FindNoeudByIDStation(MakeTIDStation(Ser1, St1), QNoeudDepart, IdxNoeudDepart);
      if (Not Q1) then Exit(SetLastError(ERR_GRAPHE_NODE_NOT_FOUND, Format('Noeud "%d.%d" introuvable', [Ser1, St1])));
      Q1 := FindNoeudByIDStation(MakeTIDStation(Ser2, St2), QNoeudArrivee, IdxNoeudArrivee);
      if (Not Q1) then Exit(SetLastError(ERR_GRAPHE_NODE_NOT_FOUND, Format('Noeud "%d.%d" introuvable', [Ser2, St2])));
      FAfficherMessage(Format('%s.RechercherPlusCourtChemin(): %d: %d.%d -> %d: %d.%d', [ClassName, IdxNoeudDepart, Ser1, St1, IdxNoeudArrivee, Ser2, St2]));
      // Stations identiques -->[ ]
      Q1 := (Ser1 = Ser2) and (St1 = St2);
      if (Q1) then Exit(SetLastError(ERR_GRAPHE_SAME_START_END, '-- Les stations de départ et arrivée sont identiques'));
      // Le noeud courant est le noeud de départ
      QIdxNoeudCourant := IdxNoeudDepart;
      QNoeudCourant    := GetNoeud(QIdxNoeudCourant);
      FAfficherMessage(Format('%s.RechercherPlusCourtChemin(): Acquittement %d: %d.%d -> %d: %d.%d', [ClassName, IdxNoeudDepart, Ser1, St1, IdxNoeudArrivee, Ser2, St2]));
     
      FArrayDistancesMin[QIdxNoeudCourant] := 0.00;                    // La distance du noeud de départ est mise à 0.00
      FArrayNoeudsVisites[IdxNoeudDepart]  := True;                     // Doit-on marquer 'Visité' le noeud de départ ici ?
      // Pour contrôle
      ListerLesNoeuds('Après initialisation de la première itération', false);
     
      NbPasses := 0;
      FAfficherMessage(format('Juste avant le while: Station courante %d [%d]', [QIdxNoeudCourant, QNoeudCourant.IDStation]));
      while (Not NoeudsTousVisites()) do
      begin
        FAfficherMessage(format('Passe %d - Noeud traité: %d [QNoeudCourant%d]', [NbPasses, QIdxNoeudCourant, QNoeudCourant.IDStation]));
        FAfficherMessage('=======================');
        if (NbPasses > 20) then break;  // Butée d'arrêt pour éviter les boucles infinis lors de la mise au point
        // Pour les arcs sortants
        NbArcsSortants := Length(QNoeudCourant.ListeArcsSortants);
        if (NbArcsSortants > 0) then
        begin
          FAfficherMessage(Format('%d: %d arcs sortants', [QNoeudCourant.IDStation, NbArcsSortants]));
          QDistanceMinNoeudVoisin := Infinity;
          for a := 0 to NbArcsSortants - 1 do
          begin
            qIdxArc   := QNoeudCourant.ListeArcsSortants[a];
            QArc      := GetArc(qIdxArc);
              if (not FArrayNoeudsVisites[QArc.IdxNoeudArrivee]) then
              begin
                QDistanceMinNoeudVoisin := Min(QDistanceMinNoeudVoisin, QArc.Longueur);
                //QST1       := GetNoeud(QArc.IdxNoeudArrivee); //GetNoeud(QIdxNoeudSuccesseur);
                QDistance1 := FArrayDistancesMin[QIdxNoeudCourant]     + QArc.Longueur;
                QDistance2 := FArrayDistancesMin[QArc.IdxNoeudArrivee] + QArc.Longueur;
                if (QDistance1 < QDistance2) then
                begin
                  QArc.IdxNoeudDepart := QIdxNoeudCourant;  // mise à jour du prédécesseur
                  QIdxNoeudCourant := QArc.IdxNoeudArrivee; // MAJ du noeud suivant
                  PutArc(qIdxArc, QArc);
                  //FAfficherMessage(Format('Changement du noeud courant:  %d devient  %d', [QST1.IDStation, QNoeudCourant.IDStation]));
                end;
              end;
          end;
          FArrayDistancesMin[QIdxNoeudCourant]  += QDistanceMinNoeudVoisin;
          FArrayNoeudsVisites[QIdxNoeudCourant] := True;
          QNoeudCourant := GetNoeud(QIdxNoeudCourant);  // Si le nouveau noeud est le noeud d'arrivée, on sort de la boucle
          if (QIdxNoeudCourant = IdxNoeudArrivee) then
          begin
            FAfficherMessage(Format('%d == %d', [QNoeudCourant.IDStation , QNoeudArrivee.IDStation]));
            FArrayNoeudsVisites[QIdxNoeudCourant] := True;
            break;
          end;
        end;
     
     
        FAfficherMessage(Format('Noeud courant: %d %d', [QIdxNoeudCourant, QNoeudCourant.IDStation]));
        Inc(NbPasses);
        // pour contrôle après la passe
        //ListerLesNoeuds(Format('Passe %d', [NbPasses]));
        // Afficher le graphe
        FAfficherGraphe();
      end;
      FAfficherGraphe();
      FAfficherMessage(Format('%d passes', [NbPasses]));
      //****************************************************************************
      exit;
      FAfficherMessage('Parcours terminé');
      //*)
    end;


    La sortie :
    Code :Sélectionner tout -Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
     
    Traitement du graphe
    TGraphe.RechercherPlusCourtChemin(): 1: 1.1 -> 9: 2.2
    TGraphe.RechercherPlusCourtChemin(): Acquittement 1: 1.1 -> 9: 2.2
     
    Après initialisation de la première itération
    15 noeuds (0,00, 0,00) -> 550,00, 350,00
     0: 100000: 1.0 0,00, 0,00: 1 arcs entrants, 1 arcs sortants, DistMini: +Inf, Visité: non
     1: 100001: 1.1 10,00, 10,00: 3 arcs entrants, 3 arcs sortants, DistMini: 0,00, Visité: OUI
     2: 100002: 1.2 100,00, 0,00: 2 arcs entrants, 2 arcs sortants, DistMini: +Inf, Visité: non
     3: 100003: 1.3 200,00, 0,00: 3 arcs entrants, 3 arcs sortants, DistMini: +Inf, Visité: non
     4: 100004: 1.4 300,00, 0,00: 2 arcs entrants, 2 arcs sortants, DistMini: +Inf, Visité: non
     5: 100005: 1.5 300,00, 100,00: 2 arcs entrants, 2 arcs sortants, DistMini: +Inf, Visité: non
     6: 100006: 1.6 300,00, 200,00: 3 arcs entrants, 3 arcs sortants, DistMini: +Inf, Visité: non
     7: 100007: 1.7 550,00, 350,00: 1 arcs entrants, 1 arcs sortants, DistMini: +Inf, Visité: non
     8: 200001: 2.1 200,00, 101,00: 2 arcs entrants, 2 arcs sortants, DistMini: +Inf, Visité: non
     9: 200002: 2.2 100,00, 100,00: 2 arcs entrants, 2 arcs sortants, DistMini: +Inf, Visité: non
     10: 200003: 2.3 100,00, 200,00: 3 arcs entrants, 3 arcs sortants, DistMini: +Inf, Visité: non
     11: 200004: 2.4 26,00, 200,00: 2 arcs entrants, 2 arcs sortants, DistMini: +Inf, Visité: non
     12: 300001: 3.1 0,00, 100,00: 2 arcs entrants, 2 arcs sortants, DistMini: +Inf, Visité: non
     13: 400001: 4.1 200,00, 200,00: 3 arcs entrants, 3 arcs sortants, DistMini: +Inf, Visité: non
     14: 400002: 4.2 200,00, 250,00: 1 arcs entrants, 1 arcs sortants, DistMini: +Inf, Visité: non
     
    Juste avant le while: Station courante 1 [100001]
    Passe 0 - Noeud traité: 1 [QNoeudCourant100001]
    =======================
    100001: 3 arcs sortants
    Noeud courant: 2 100002
    Passe 1 - Noeud traité: 2 [QNoeudCourant100002]
    =======================
    100002: 2 arcs sortants
    Noeud courant: 2 100002
    Passe 2 - Noeud traité: 2 [QNoeudCourant100002]
    =======================
    100002: 2 arcs sortants
    Noeud courant: 2 100002
    Passe 3 - Noeud traité: 2 [QNoeudCourant100002]
    =======================
    100002: 2 arcs sortants
    Noeud courant: 2 100002
    Passe 4 - Noeud traité: 2 [QNoeudCourant100002]
    =======================
    100002: 2 arcs sortants
    Noeud courant: 2 100002
    Passe 5 - Noeud traité: 2 [QNoeudCourant100002]
    =======================
    100002: 2 arcs sortants
    Noeud courant: 2 100002
    Passe 6 - Noeud traité: 2 [QNoeudCourant100002]
    =======================
    100002: 2 arcs sortants
    Noeud courant: 2 100002
    Passe 7 - Noeud traité: 2 [QNoeudCourant100002]
    =======================
    100002: 2 arcs sortants
    Noeud courant: 2 100002
    Passe 8 - Noeud traité: 2 [QNoeudCourant100002]
    =======================
    100002: 2 arcs sortants
    Noeud courant: 2 100002
    Passe 9 - Noeud traité: 2 [QNoeudCourant100002]
    =======================
    100002: 2 arcs sortants
    Noeud courant: 2 100002
    Passe 10 - Noeud traité: 2 [QNoeudCourant100002]
    =======================
    100002: 2 arcs sortants
    Noeud courant: 2 100002
    Passe 11 - Noeud traité: 2 [QNoeudCourant100002]
    =======================
    100002: 2 arcs sortants
    Noeud courant: 2 100002
    Passe 12 - Noeud traité: 2 [QNoeudCourant100002]
    =======================
    100002: 2 arcs sortants
    Noeud courant: 2 100002
    Passe 13 - Noeud traité: 2 [QNoeudCourant100002]
    =======================
    100002: 2 arcs sortants
    Noeud courant: 2 100002
    Passe 14 - Noeud traité: 2 [QNoeudCourant100002]
    =======================
    100002: 2 arcs sortants
    Noeud courant: 2 100002
    Passe 15 - Noeud traité: 2 [QNoeudCourant100002]

  11. #31
    Membre expert
    Citation Envoyé par JP CASSOU Voir le message
    Bsr,

    J'ai cherché dans les sources de BZScene (https://github.com/jdelauney/BZScene...er/Source/Core) mais je ne trouve pas les unités concernant les graphes.
    cdlt

    Salut tout est dans le zip. Après concernant l'affichage c'est comme travailler avec un TBItmap native et le Canvas pen,.color, pen.Style, moveto, lineto...., sinon les unités utilisées pour le graphisme sont dan sources/core (bzcolors, bzprahic) et dans le dossier sources/images (bzbitmap)
    • "L'Homme devrait mettre autant d'ardeur à simplifier sa vie qu'il met à la compliquer" - Henri Bergson
    • "Bien des livres auraient été plus clairs s'ils n'avaient pas voulu être si clairs" - Emmanuel Kant
    • "La simplicité est la sophistication suprême" - Léonard De Vinci
    • "Ce qui est facile à comprendre ou à faire pour toi, ne l'est pas forcément pour l'autre." - Mon pèrei

    Mes projets sur Github - Blog - Site DVP

  12. #32
    Membre expert
    Citation Envoyé par JP CASSOU Voir le message
    Bsr,

    Je ne m'en sors toujours pas, et çà me gonfle. C'est du pénible +++

    Je précise que je ne dois utiliser que les éléments suivants (çà m'est imposé)

    - Une liste des noeuds
    - Une liste des arcs
    - Un tableau 0.. n-1 des distances
    - Un tableau 0 .. n-1 des sommets visités

    - Une liste des noeuds OK
    - Une liste des arcs OK Ce sont bien des liaisons que l'on parle, c'est que le Noeud A pointe vers B, C, E, Z, Q etc.... ?
    - Un tableau 0.. n-1 des distances OK
    - Un tableau 0 .. n-1 des sommets visités : Ca correspond à quoi au chemin parcouru par ton metro, pour savoir si il est deja passé par une station ? ou c'est juste une obligation d'implementation pour l'algo ?
    • "L'Homme devrait mettre autant d'ardeur à simplifier sa vie qu'il met à la compliquer" - Henri Bergson
    • "Bien des livres auraient été plus clairs s'ils n'avaient pas voulu être si clairs" - Emmanuel Kant
    • "La simplicité est la sophistication suprême" - Léonard De Vinci
    • "Ce qui est facile à comprendre ou à faire pour toi, ne l'est pas forcément pour l'autre." - Mon pèrei

    Mes projets sur Github - Blog - Site DVP

  13. #33
    Membre expert
    Hello JP
    Citation Envoyé par jurassic pork Voir le message
    hello,


    Arf j'avais encore des erreurs de compilation sur le code de substitution :
    il y avait un ; au lieu d'un , après le 1 er argument mais plus difficile Node.Position.X, Node.Position.Y sont des singles alors qu'on doit passer des Longint ( obligé de caster ) :
    Code :Sélectionner tout -Visualiser dans une fenêtre à part
    1
    2
          if PointInCircle(FMousePos.X, FMousePos.Y,
                    integer(Node.Position.X), integer(Node.Position.Y), 8) then


    Citation Envoyé par jurassic pork Voir le message

    EDIT3: Bon le cast en integer n'était pas une bonne idée car la fonction ne fonctionnait pas. Finalement dans BzGraphics j'ai créé une nouvelle fonction :

    Code :Sélectionner tout -Visualiser dans une fenêtre à part
    function PointInCircleSingle(const px,py,cx,cy: Single; const Radius:Integer): boolean; inline;


    appelée comme ceci :
    Code :Sélectionner tout -Visualiser dans une fenêtre à part
    1
    2
     
    if PointInCircleSingle(FMousePos.AsVector2f.X, FMousePos.AsVector2f.Y,  Node.Position.X, Node.Position.Y, 8) then


    et là ça fonctionne
    Ce n'est pas bien de caster, sur des type single, double , cela occasionne souvent des erreurs dans les nombres
    le mieux c'est d'utiliser Round ou Trunc

    Code :Sélectionner tout -Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
     
    var
     nb : TBZPoint; // ou TBZVector2i
     
      np := Node.Position.XY.Round;
      if PointInCircle(FMousePos.X, FMousePos.Y, np.X, np.Y, 8) then


    Hum c'est bizarre que tu as du tout passer en single voici ma version actuelle de PointInCircle(j'ai peut être modifié depuis ma dernière mise à jour du dépot)

    Code :Sélectionner tout -Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    function PointInCircle(const px,py,cx,cy: Integer; const Radius:Integer): boolean; inline;
    var x,y: single;
    begin
      x := cx - px;
      y := cy - py;
      result := (x * x + y * y) < (radius * radius);
    end;



    Citation Envoyé par jurassic pork Voir le message

    EDIT : Bon finalement en mode debug j'ai un message d'erreur comme quoi il n'arrive pas à charger la dll freetype . Comme je suis en Lazarus 32 bits j'ai mis la dll 32 bits de externals dans SYSWOW64 et même dans le répertoire du projet mais toujours le message d'erreur avec après un execution stopped

    EDIT2 : Bon j'ai été chercher la dll freetype sur le net ici et là ça fonctionne donc elle est peut-être mauvaise dans ton zip.

    Ami calmant, J.P
    Non dans le zip il n'y avait pas la DLL, j'ai oublié de l'ajouter
    Sinon toutes les DLLs nécessaires pour BZScene (à un moment ou un autre, suivant les fonctionnalités utilisées) pour Windows 32 et 64 sont dans le dossier \BZScene\Externals\Windows\ et x86 pour le 32 bit et x64 pour les 64bit

    Par contre c'est vrai je n'ai pas beaucoup testé BZScene en 32 bits, n'hésites pas à me dire si tu as des erreurs. Si jamais tu as des exemples d'utilisations de BZScene ici et

    A+

    Jérôme
    • "L'Homme devrait mettre autant d'ardeur à simplifier sa vie qu'il met à la compliquer" - Henri Bergson
    • "Bien des livres auraient été plus clairs s'ils n'avaient pas voulu être si clairs" - Emmanuel Kant
    • "La simplicité est la sophistication suprême" - Léonard De Vinci
    • "Ce qui est facile à comprendre ou à faire pour toi, ne l'est pas forcément pour l'autre." - Mon pèrei

    Mes projets sur Github - Blog - Site DVP

  14. #34
    Expert confirmé
    hello Jérôme,
    Citation Envoyé par BeanzMaster Voir le message

    Non dans le zip il n'y avait pas la DLL, j'ai oublié de l'ajouter
    Sinon toutes les DLLs nécessaires pour BZScene (à un moment ou un autre, suivant les fonctionnalités utilisées) pour Windows 32 et 64 sont dans le dossier \BZScene\Externals\Windows\ et x86 pour le 32 bit et x64 pour les 64bit

    Par contre c'est vrai je n'ai pas beaucoup testé BZScene en 32 bits, n'hésites pas à me dire si tu as des erreurs. Si jamais tu as des exemples d'utilisations de BZScene ici et

    e
    oops ce n'est pas dans le zip mais dans la librairie bzscene-master que j'avais pris la dll ( donc dll 32 bits à vérifier)

    Ami calmant, J.P
    Jurassic computer : Sinclair ZX81 - Zilog Z80A à 3,25 MHz - RAM 1 Ko - ROM 8 Ko

  15. #35
    Membre expert
    Citation Envoyé par jurassic pork Voir le message
    hello Jérôme,


    oops ce n'est pas dans le zip mais dans la librairie bzscene-master que j'avais pris la dll ( donc dll 32 bits à vérifier)

    Ami calmant, J.P
    Bizarre, bref j'ai essayé avec la version x64 du lien que tu fournis et elle ne fonctionne pas chez moi

    Dans le doute voici un zip tout neuf avec ma DLL x64 et ta DLL x86

    Merci

    A+

    Jérôme
    • "L'Homme devrait mettre autant d'ardeur à simplifier sa vie qu'il met à la compliquer" - Henri Bergson
    • "Bien des livres auraient été plus clairs s'ils n'avaient pas voulu être si clairs" - Emmanuel Kant
    • "La simplicité est la sophistication suprême" - Léonard De Vinci
    • "Ce qui est facile à comprendre ou à faire pour toi, ne l'est pas forcément pour l'autre." - Mon pèrei

    Mes projets sur Github - Blog - Site DVP

  16. #36
    Expert confirmé
    je viens d'essayer le nouveau zip : il fonctionne

    pour la dll peut être la version de vs utilisée pour la compilation :

    pour celle de Kingdread

    Compiled with MS Visual Studio 2013.


    Ami calmant, J.P
    Jurassic computer : Sinclair ZX81 - Zilog Z80A à 3,25 MHz - RAM 1 Ko - ROM 8 Ko

  17. #37
    Membre averti
    Erreur pénible +++ dans l'adaptation des unités de BeanMaster
    Bjr à tous,

    J'ai choisi d'adapter les unités de graphes de BZ dans mon projet

    Je rencontre une erreur pénible +++++ ici:

    Code :Sélectionner tout -Visualiser dans une fenêtre à part
    1
    2
     
    bzgraphesclasses.pas(490,17) Error: Incompatible types: got "TClass" expected "TBZClassNode"


    Les unités adaptées (le système d'envoi des PJ dans DVP, c'est de la merde

    Code :Sélectionner tout -Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    90
    91
    92
    93
    94
    95
    96
    97
    98
    99
    100
    101
    102
    103
    104
    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
     
    unit BZGraphesClasses;
     
    {$mode delphi}{$H+}
     
     
     { Algo Dijkstra : https://ksvi.mff.cuni.cz/~dingle/2017/lecture_10.html }
     
    interface
     
    uses
      Classes, SysUtils, math,
      UnitGraphesTypes,
      BZArrayClasses;
     
     
    type
      TBZGraphNode    = class;
      TBZNodeLink     = class;
      TBZNodeLinkList = class;
      //noeud
      TBZClassNode = Class
      private
        FOwner        : TBZGraphNode;
     
        FNodeLinkList : TBZNodeLinkList;
        FNodeIndex    : Integer;
        // data
        FIDStation    : TIDStation;
        FCoordNoeudX  : double;
        FCoordNoeudY  : double;
        FCoordNoeudZ  : double;
     
        procedure SetOwner(const AValue: TBZGraphNode);
        function  GetNodeLink(const Index : Integer): TBZNodeLink;
     
        procedure SetNodeLink(Index : Integer; const AValue: TBZNodeLink);
      public
        constructor Create(AOwner : TBZGraphNode; const QIDStation: TIDStation; const X, Y, Z: double);
        destructor  Destroy; override;
     
        function AddNodeLink(anIndex : Integer) : TBZNodeLink; overload;
        //function AddLinkNode(aNode : TNode) : TNodeLink; overload;
     
        property Owner : TBZGraphNode read FOwner write SetOwner;
     
        property IDStation     : TIDStation read FIDStation write FIDStation;
        property X  : double read FCoordNoeudX write FCoordNoeudX;
        property Y  : double read FCoordNoeudY write FCoordNoeudY;
        property Z  : double read FCoordNoeudZ write FCoordNoeudZ;
     
     
     
        property NodeIndex : Integer read FNodeIndex write FNodeIndex;
        property LinkNode[Index : Integer] : TBZNodeLink read GetNodeLink write SetNodeLink;
        property NodeLinkList : TBZNodeLinkList read FNodeLinkList;
      end;
    // arc
      TBZNodeLink = class
      private
        FOwner : TBZNodeLinkList;
        FTargetNodeIndex : Integer;
       // FDistance : Single;
     
        procedure SetTargetNodeIndex(const AValue: Integer);
        procedure SetOwner(const AValue: TBZNodeLinkList);
        function  getDistance(): double;
        function  getNode(): TBZClassNode;
        function  getParentNode(): TBZClassNode;
     
      public
        constructor Create(AOwner : TBZNodeLinkList; ATargetNodeIndex : Integer);
        destructor Destroy; override;
     
        property TargetNodeIndex : Integer read FTargetNodeIndex write SetTargetNodeIndex;
        property Owner           : TBZNodeLinkList  read FOwner write setOwner;
        property Distance        : double read getDistance;   //FDistance;
        property Node            : TBZClassNode read getNode;
        property ParentNode      : TBZClassNode read getParentNode;
      end;
     
     
     
      { TGraphNode }
      TOnGraphNodeTravelNode = procedure (Sender : TObject; Node : TBZClassNode; ADistance : double) of object;
      TOnGraphNodeVerboseCall = procedure (Sender : TObject; msg : String) of object;
      //TBZGraphNode = class(specialize TBZBaseList<TClass>)
      TBZGraphNode = class(TBZBaseList<TClass>)
     
      private
     
        FOnGraphNodeTravelNode   : TOnGraphNodeTravelNode;
        FOnGraphNodeVerboseCall  : TOnGraphNodeVerboseCall;
     
        function getNode(Index : Integer): TBZClassNode;
        procedure setNode(Index : Integer; const AValue: TBZClassNode);
     
      protected
        //function CompareValue(Const elem1, elem2) : Integer;  override;
     
        procedure DoOnTravelNode(Sender : TObject; Anode : TBZClassNode; ADistance : double);
        procedure DoVerboseCall(const s :String);
      public
        constructor Create;
        destructor Destroy; override;
     
        function AddNode(ANode : TBZClassNode) : Integer; overload;
        function AddNode(const QIDStation: TIDStation; const QX, QY, QZ: double) : TBZClassNode; overload;
     
        function Dijkstra(FromIndex, ToIndex : Integer; out ShortestPath : TBZIntegerList) : Single;
     
        property Node[Index : Integer] : TBZClassNode read getNode write setNode;
     
        property OnTravelNode : TOnGraphNodeTravelNode read FOnGraphNodeTravelNode write FOnGraphNodeTravelNode;
        property OnVerboseCall  : TOnGraphNodeVerboseCall read FOnGraphNodeVerboseCall write FOnGraphNodeVerboseCall;
      end;
       // liste des arcs partant ou arrivant au noeud
      TBZNodeLinkList = class(TBZBaseList<TBZNodeLink>)
      private
        FOwner : TBZClassNode;
        procedure SetOwner(const AValue: TBZClassNode);
      protected
        function CompareValue(Const elem1, elem2: TBZNodeLink) : Integer;  override;
      public
        constructor Create(AOwner : TBZClassNode); overload;
        destructor Destroy; override;
     
        function NewNodeLink(ToIndex : Integer) : TBZNodeLink;
        function AddNodeLink(aNodeLink : TBZNodeLink) : Integer;
     
        property Owner : TBZClassNode read FOwner write SetOwner;
      end;
     
     
    implementation
     
    {$R *.lfm}
     
    {%region=====[ TPriorityQueueHeap ]=============================================}
     
    Const
      cNone = -MaxInt;
     
    type
      TDynIntegerArray = Array of Integer;
      TDynSingleArray = Array of Single;
     
      { TPriorityQueueHeap }
     
      TPriorityQueueHeap = Class
      public
     
        Count: integer;
        Heap: TDynIntegerArray;      // binary heap holding values minimized by priority
        Priority: TDynSingleArray;  // each value's priority, or None if absent
        Position: TDynIntegerArray;  // each value's position in the heap array, or None if absent
     
        Constructor Create(n : Integer);
        Destructor Destroy; override;
     
        procedure Swap(var i, j: integer);
        function IsEmpty : Boolean;
        procedure MoveDown(Index: integer);
        procedure MoveUp(Index: integer);
        function InsertPriority(Index : Integer; APriorityValue : Single) : Integer;
        function RemoveSmallest(out APriorityValue : Single) : Integer;
        function IsExist(Index : Integer) : Boolean;
        function getPriority(Index : Integer) : Single;
        function DecreasePriority(Index : Integer; APriorityValue : Single) : Integer;
        function getParentIndex(Index : Integer) : Integer;
        function getLeftChildIndex(Index : Integer) : Integer;
        function getRightChildIndex(Index : Integer) : Integer;
     
      end;
     
     
    Constructor TPriorityQueueHeap.Create(n: Integer);
    var
      i: integer;
    begin
      Self.Count := 0;
      setLength(Self.Heap, 1);
      setLength(Self.Priority, n);
      setLength(Self.Position, n);
      for i := 0 to n - 1 do
        begin
          Self.priority[i] := cNone;
          Self.position[i] := cNone;
        end;
    end;
     
    Destructor TPriorityQueueHeap.Destroy;
    begin
      setLength(Self.Heap, 0);
      setLength(Self.Priority, 0);
      setLength(Self.Position, 0);
      Finalize(Self.Priority);
      Finalize(Self.Position);
      Finalize(Self.Heap);
      inherited Destroy;
    end;
     
    procedure TPriorityQueueHeap.Swap(var i, j: integer);
    var
      k: integer;
    begin
      k := i;
      i := j;
      j := k;
    end;
     
    function TPriorityQueueHeap.IsEmpty : Boolean;
    begin
      Result := (Self.Count = 0);
    end;
     
    // Move the value at index i downward until its children are larger than it
    procedure TPriorityQueueHeap.MoveDown(Index: integer);
    var
      l, r, smallest: integer;
    begin
      l := Self.getLeftChildIndex(Index);
      r := Self.getRightChildIndex(Index);
      smallest := Index;
     
      if (l < Self.Count) and (Self.Priority[Self.Heap[l]] < Self.Priority[Self.Heap[Index]]) then smallest := l;
      if (r < Self.Count)  and (Self.Priority[Self.Heap[r]] < Self.Priority[Self.Heap[smallest]]) then smallest := r;
     
      if smallest <> Index then  // some child is smaller
        begin
          Self.swap(Self.Heap[Index], Self.Heap[smallest]);
          Self.swap(Self.Position[Self.Heap[Index]], Self.Position[Self.Heap[smallest]]);
          Movedown(smallest);
        end;
    end;
     
    // Move the value at index i upward until its parent is smaller than it
    procedure TPriorityQueueHeap.MoveUp(Index : integer);
    var
      p: integer;
    begin
      if Index = 0 then exit;
      p := Self.getParentIndex(Index);
      if (Self.Priority[Self.Heap[Index]] < Self.Priority[Self.Heap[p]]) then // smaller than parent
        begin
          Self.Swap(Self.Heap[Index], Self.Heap[p]);
          Self.Swap(Self.Position[Self.Heap[index]], Self.Position[Self.Heap[p]]);
          Self.MoveUp(p);
        end;
    end;
     
    function TPriorityQueueHeap.InsertPriority(Index: Integer; APriorityValue: Single) : Integer;
    begin
      Result := 0;
      if (Self.Priority[Index] <> cNone) then
      begin
        Result := -1;
        Exit; // value is already in queue;
      end;
     
      if (Self.Count >= length(Self.Heap)) then  // array is full
      begin
        setLength(Self.Heap, length(Self.Heap) * 2);
      end;
      Self.Count := Self.Count + 1;
      Self.Heap[Self.Count - 1] := Index;
      Self.Position[Index] := Self.Count - 1;
      Self.Priority[Index] := APriorityValue;
      Self.MoveUp(Self.Count - 1);
    end;
     
    function TPriorityQueueHeap.RemoveSmallest(out APriorityValue : Single) : Integer;
    var
      smallest: integer;
    begin
      smallest := Self.Heap[0];
      Result := smallest;
      APriorityValue := Self.Priority[smallest];
      Self.Priority[smallest] := cNone;
      Self.Position[smallest] := cNone;
     
      Self.Heap[0] := Self.Heap[Self.Count - 1];
      Self.Position[Self.Heap[0]] := 0;
      Self.Count := Self.Count - 1;
      Self.MoveDown(0);
    end;
     
    function TPriorityQueueHeap.IsExist(Index : Integer) : Boolean;
    begin
      Result := (Self.Priority[Index] <> cNone);
    end;
     
    function TPriorityQueueHeap.getPriority(Index : Integer) : Single;
    begin
      Result := Self.Priority[Index];
    end;
     
    function TPriorityQueueHeap.DecreasePriority(Index : Integer; APriorityValue : Single) : Integer;
    begin
      Result := 0;
      if Self.Priority[Index] = cNone then Result := - 1; // value is not in queue;
      if Self.Priority[Index] < APriorityValue then Result := -2; // existing priority is lower
     
      if (Result < 0) then Exit;
     
      Self.Priority[Index] := APriorityValue;
      MoveUp(Self.Position[Index]);
    end;
     
    function TPriorityQueueHeap.getParentIndex(Index : Integer) : Integer;
    begin
      Result := (Index - 1) div 2;
    end;
     
    function TPriorityQueueHeap.getLeftChildIndex(Index : Integer) : Integer;
    begin
      Result := 2 * Index + 1;
    end;
     
    function TPriorityQueueHeap.getRightChildIndex(Index : Integer) : Integer;
    begin
      Result := 2 * Index + 2;
    end;
     
    {%endregion%}
     
    {%region=====[ TNode ]==========================================================}
     
    constructor TBZClassNode.Create(AOwner: TBZGraphNode; const QIDStation: TIDStation; const X, Y, Z: double);
    begin
      FOwner := AOwner;
      FIDStation   := QIDStation;
      FCoordNoeudX := X;
      FCoordNoeudY := Y;
      FCoordNoeudZ := Z;
     
      FNodeLinkList := TBZNodeLinkList.Create(Self);
      FNodeIndex := -1;
      //if Assigned(FOwner) or (FOwner <> nil) then
      //begin
      //  Idx := FOwner.AddNode(Self);
      //  FNodeIndex := Idx;
      //end;
    end;
     
    destructor TBZClassNode.Destroy;
    begin
      FreeAndNil(FNodeLinkList);
      inherited Destroy;
    end;
     
    function TBZClassNode.GetNodeLink(const Index : Integer): TBZNodeLink;
    begin
      Result := FNodeLinkList.Items[Index];
    end;
     
    procedure TBZClassNode.SetNodeLink(Index : Integer; const AValue: TBZNodeLink);
    begin
      Assert(((Index >= FNodeLinkList.Count)  or (Index < 0)), 'EdgeLIst : Index hors limite');
      AValue.Owner := FNodeLinkList;
      FNodeLinkList.Items[Index] := AValue;
    end;
     
    procedure TBZClassNode.SetOwner(const AValue: TBZGraphNode);
    begin
      if FOwner = AValue then Exit;
      FOwner := AValue;
    end;
     
    function TBZClassNode.AddNodeLink(anIndex: Integer): TBZNodeLink;
    Var
     aNodeLink : TBZNodeLink;
    begin
      Assert(((anIndex >= FOwner.Count) or (anIndex < 0)), 'Node :  Edge Node Index hors limite');
      aNodeLink := TBZNodeLink.Create(FNodeLinkList, anIndex);
      FNodeLinkList.AddNodeLink(aNodeLink);
      Result := aNodeLink;
    end;
     
     
    {%endregion%}
     
    {%region=====[ TNodeLink ]======================================================}
     
    constructor TBZNodeLink.Create(AOwner: TBZNodeLinkList; ATargetNodeIndex: Integer);
    begin
      FOwner := AOwner;
      FTargetNodeIndex := ATargetNodeIndex;
      //if FTargetNodeIndex = 0 then FDistance := 0
      //else FDistance := -1;
    end;
     
    destructor TBZNodeLink.Destroy;
    begin
      inherited Destroy;
    end;
     
    procedure TBZNodeLink.SetOwner(const AValue: TBZNodeLinkList);
    begin
      if FOwner = AValue then Exit;
      FOwner := AValue
    end;
     
    function TBZNodeLink.getDistance(): double;
    var
      QParentNode, QCurrNode: TBZClassNode;
    begin
      QParentNode := getParentNode();
      QCurrNode   := getNode();
      Result := sqrt((QCurrNode.X - QCurrNode.Y) ** 2 +
                     (QCurrNode.Y - QCurrNode.Y) ** 2 +
                     (QCurrNode.Z - QCurrNode.Z));
     
    end;
     
    function TBZNodeLink.getNode: TBZClassNode;
    begin
      result :=FOwner.Owner.Owner.Node[FTargetNodeIndex];
    end;
     
    function TBZNodeLink.getParentNode: TBZClassNode;
    begin
      Result := FOwner.Owner;
    end;
     
    procedure TBZNodeLink.SetTargetNodeIndex(const AValue: Integer);
    begin
      if FTargetNodeIndex = AValue then Exit;
      FTargetNodeIndex := AValue;
    end;
     
    {%endregion%}
     
    {%region=====[ TNodeLinkList ]==================================================}
     
    constructor TBZNodeLinkList.Create(AOwner: TBZClassNode);
    begin
      inherited Create(16);
      FOwner := AOwner;
    end;
     
    destructor TBZNodeLinkList.Destroy;
    begin
      inherited Destroy;
    end;
     
    function TBZNodeLinkList.NewNodeLink(ToIndex: Integer): TBZNodeLink;
    Var
      aNodeLink : TBZNodeLink;
    begin
      aNodeLink := TBZNodeLink.Create(Self, ToIndex);
      Self.AddNodeLink(aNodeLink);
      Result := aNodeLink;
    end;
     
    function TBZNodeLinkList.AddNodeLink(aNodeLink: TBZNodeLink): Integer;
    begin
      aNodeLink.Owner := Self;
      Result := Self.Add(aNodeLink);
    end;
     
    procedure TBZNodeLinkList.SetOwner(const AValue: TBZClassNode);
    begin
      if FOwner = AValue then Exit;
      FOwner := AValue;
    end;
     
    function TBZNodeLinkList.CompareValue(Const elem1, elem2: TBZNodeLink): Integer;
    begin
      if      elem1.TargetNodeIndex = elem2.TargetNodeIndex then Result :=  0
      else if elem1.TargetNodeIndex < elem2.TargetNodeIndex then Result := -1
      else                                                       Result :=  1;
    end;
     
    {%endregion%}
     
    {%region=====[ TGraphNode ]=====================================================}
     
    constructor TBZGraphNode.Create;
    begin
      inherited Create(16);
    end;
     
    destructor TBZGraphNode.Destroy;
    begin
      inherited Destroy;
    end;
     
    function TBZGraphNode.getNode(Index : Integer): TBZClassNode;
    begin
      Result := Self.Items[Index];
    end;
     
    procedure TBZGraphNode.setNode(Index : Integer; const AValue: TBZClassNode);
    begin
      Assert(((Index >= Self.Count) or (Index < 0)), 'GraphNode : Index hors limite');
      Self.Items[Index] := AValue;
    end;
     
    function TBZGraphNode.CompareValue(Const elem1, elem2): Integer;
    begin
      Result := 0;
      (*
      if      elem1.NodeIndex = elem2.NodeIndex then Result :=  0
      else if elem1.NodeIndex < elem2.NodeIndex then Result := -1
      else                                           Result :=  1;
      //*)
    end;
     
    procedure TBZGraphNode.DoOnTravelNode(Sender : TObject; Anode: TBZClassNode; ADistance: double);
    begin
      if Assigned(FOnGraphNodeTravelNode) then FOnGraphNodeTravelNode(Self, ANode, ADistance);
    end;
     
    procedure TBZGraphNode.DoVerboseCall(const s: String);
    begin
      if Assigned(FOnGraphNodeVerboseCall) then FOnGraphNodeVerboseCall(Self, s);
    end;
     
    function TBZGraphNode.AddNode(const QIDStation: TIDStation; const QX, QY, QZ: double): TBZClassNode;
    Var
      aNode : TBZClassNode;
      Idx : Integer;
    begin
      aNode := TBZClassNode.Create(Self, QIDStation, QX, QY, QZ);
      aNode.IDStation := QIDStation;
      aNode.X := QX;
      aNode.Y := QY;
      aNode.Z := QZ;
     
      Idx := Self.AddNode(aNode);
      aNode.NodeIndex := Idx;
      Result := aNode;
    end;
     
    function TBZGraphNode.AddNode(ANode: TBZClassNode): Integer;
    begin
      Result := Self.Add(aNode);
    end;
     
    function TBZGraphNode.Dijkstra(FromIndex, ToIndex: Integer; out ShortestPath: TBZIntegerList): Single;
    var
      queue : TPriorityQueueHeap;
      pred : array of integer;
      i, j, cnt : integer;
      edge : TBZNodeLink;
      Dist, DMin : Single;
      DistTmp : Single;
    begin
      ShortestPath := TBZIntegerList.Create(16);
      cnt := Self.Count;
      Queue := TPriorityQueueHeap.Create(cnt);
      Dist := 0;
      for i := 0 to (cnt - 1) do
      begin
        Queue.InsertPriority(i, MaxInt);
      end;
      setLength(pred{%H-}, cnt);
      Queue.DecreasePriority(FromIndex, 0);
      i := FromIndex;
     
      DoOnTravelNode(Self, Self.Items[i], Dist);
     
      // Première partie : recherche des chemins les plus court pour chaque noeud
      while not(Queue.isEmpty) do
      begin
        i := Queue.RemoveSmallest({ out } Dist);
        DoOnTravelNode(Self, Self.Items[i], Dist);
     
        if (i = ToIndex) then
        begin
          DoVerboseCall('===========================================================');
          DoVerboseCall('Level 4 - Tous chemins vers le noeud ' + i.ToString + ' ont été traités');
          break;
        end;
     
        if (Self.Items[i].NodeLinkList.Count > 0) then
        begin
          for j := 0 to (Self.Items[i].NodeLinkList.Count - 1) do
          begin
            Edge := Self.Items[i].LinkNode[j];
            DistTmp := Dist + Edge.Distance;
     
            DoVerboseCall('---------------------------------------------------------');
            DoVerboseCall('Level 1 - du noeud ' + i.ToString + ' vers noeud ' + Edge.TargetNodeIndex.ToString + ' --> Distance = ' + Edge.Distance.ToString);
     
            if (Queue.IsExist(Edge.TargetNodeIndex) and (DistTmp < Queue.getPriority(Edge.TargetNodeIndex))) then
            begin
              Queue.DecreasePriority(Edge.TargetNodeIndex, DistTmp);
              pred[Edge.TargetNodeIndex] := i;
              DMin := DistTmp;
              DoVerboseCall('Level 2 ---> C''est le chemin le plus court  du noeud ' + i.ToString + ' vers le noeud ' + Edge.TargetNodeIndex.ToString);
            end;
          end;
          if (i <> FromIndex) then
          begin
            DoverboseCall('[INFO] La distance  du noeud '+ FromIndex.ToString + ' vers le noeud ' + Edge.TargetNodeIndex.ToString + ' via le noeud '+ i.ToString +' est de : ' + DMin.ToString);
          end;
     
          DoVerboseCall('===========================================================');
          DoVerboseCall('Level 3 - Tous les chemins du noeud ' + i.ToString + ' ont été traités');
          DoVerboseCall('===========================================================');
        end;
      end;
     
      // Deuxieme partie : Extraction du chemin le plus court trouvé
      if (i = ToIndex) and (DistTmp < MaxInt) then
      begin
        Result := DistTmp;
        i := ToIndex;
        DoVerboseCall('Level 5 - Extraction du chemin le plus court du noeud ' + FromIndex.ToString + ' vers le noeud ' + ToIndex.ToString);
        While (pred[i] <> i) and (i <> FromIndex) do
        begin
          DoVerboseCall('Level 6 - Ajout du noeud ' + i.ToString);
          ShortestPath.Add(i);
          i := pred[i];
        end;
        DoVerboseCall('Level 6 - Ajout du noeud ' + FromIndex.ToString);
        ShortestPath.Add(FromIndex);
      end
      else result := -1;
     
      FreeAndNil(Queue);
    end;
     
    {%endregion%}
     
    { TMainForm }
     
    procedure TMainForm.FormCreate(Sender: TObject);
    begin
      FGraphNode := TGraphNode.Create;
      FGraphNode.OnTravelNode := @DoOnTavelNode;
      FGraphNode.OnVerboseCall := @DoOnVerboseCall;
      FDisplayBuffer := TBZBitmap.Create(PnlView.Width, pnlView.height);
      FSelectedNodeIndex := -1;
      FSelectedNodeLinkIndex := -1;
      FRenderShortestPath := False;
    end;
     
    procedure TMainForm.FormDestroy(Sender: TObject);
    begin
      if Assigned(FShortestPath) then  FreeAndNil(FShortestPath);
      FreeAndNil(FDisplayBuffer);
      FreeAndNil(FGraphNode);
    end;
     
    procedure TMainForm.FormPaint(Sender: TObject);
    begin
      RenderGraph;
      FDisplayBuffer.DrawToCanvas(pnlView.Canvas, pnlView.ClientRect);
    end;
     
    procedure TMainForm.FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    begin
      FMousePos.Create(x,y);
     
      if (ssLeft in Shift) then
      begin
        FMouseDown := True;
        if (ssShift in Shift) then
        begin
          if  (FSelectedNodeIndex <> -1) then FNodeAction := naAddLink
          else FNodeAction := naNone;
        end
        else
        begin
          if (FSelectedNodeIndex = -1) then
          begin
            FNodeAction := naAdd;
          end
          else FNodeAction := naNone;
        end;
      end
      else FNodeAction := naNone;
    end;
     
    procedure TMainForm.FormMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    Var
     NodePos : TBZVector;
     Node : TNode;
     NodeToLink : TNode;
    begin
      if FMouseDown then
      begin
        if (FNodeAction = naAdd) then
        begin
          FMousePos.Create(x,y);
          NodePos.CreatePoint(x, y, 0);
          AddNode(NodePos);
        end
        else if (FNodeAction = naAddLink) then
        begin
          if (FSelectedNodeLinkIndex <> -1) then
          begin
            Node := FGraphNode.Node[FSelectedNodeIndex];
            NodeToLink := FGraphNode.Node[FSelectedNodeLinkIndex];
            LinkNode(Node, NodeToLink, False);
          end;
        end;
      end;
      FSelectedNodeIndex := -1;
      FSelectedNodeLinkIndex := -1;
      FNodeAction := naNone;
      FMouseDown := False;
      pnlView.Repaint;
    end;
     
    procedure TMainForm.FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    Var
      idx : Integer;
      Node : TNode;
      np : TBZPoint;
    begin
      FMousePos.Create(x,y);
      if FMouseDown then
      begin
        if ((Shift = [ssLeft, ssShift]) and (FNodeAction =  naAddLink)) then
        begin
          FSelectedNodeLinkIndex := -1;
          for idx := 0 to FGraphNode.Count-1 do
          begin
            Node := FGraphNode.Node[Idx];
            np := Node.Position.XY.Round;
            if PointInCircle(FMousePos.X, FMousePos.Y, np.X, np.Y, 8) then //(FMousePos.AsVector2f.InCircle(Node.Position.XY, 8)) then
            begin
              FSelectedNodeLinkIndex := Idx;
              Break;
            end;
          end;
        end;
      end
      else
      begin
        FSelectedNodeIndex := -1;
        for idx := 0 to FGraphNode.Count-1 do
        begin
          Node := FGraphNode.Node[Idx];
          np := Node.Position.XY.Round;
          if PointInCircle(FMousePos.X, FMousePos.Y, np.X, np.Y, 8) then //(FMousePos.AsVector2f.InCircle(Node.Position.XY, 8)) then
          begin
            FSelectedNodeIndex := Idx;
            Break;
          end;
        end;
      end;
      pnlView.Repaint;
    end;
     
    procedure TMainForm.btnFindShortestPathClick(Sender: TObject);
    Var
      i, j : Integer;
      Node : TNode;
      NodeLink : TNodeLink;
      s : String;
      Dist : Single;
    begin
      FRenderShortestPath := False;
      mmoDebug.clear;
      mmoDebug.Lines.Add('==========================================================');
      mmoDebug.Lines.Add('Graph construit avec ' + (FGraphNode.count.ToString) + ' noeuds');
      mmoDebug.Lines.Add('==========================================================');
      mmoDebug.Lines.Add('');
      for i := 0 to (FGraphNode.count - 1) do
      begin
        Node := FGraphNode.Items[i];
        mmoDebug.Lines.Add('Noeud ' + i.ToString);
        if (Node.NodeLinkList.Count > 0) then
        begin;
          for j := 0 to (Node.NodeLinkList.Count - 1) do
          begin
            mmoDebug.Lines.Add('----------------------------------------------------------');
            NodeLink := Node.LinkNode[j];
            mmoDebug.Lines.Add('   Lien ' + j.ToString);
            mmoDebug.Lines.Add('     -> vers le noeud : '+ NodeLink.TargetNodeIndex.ToString);
            mmoDebug.Lines.Add('             Distance : ' + NodeLink.Distance.ToString);
          end;
        end;
        mmoDebug.Lines.Add('==========================================================');
      end;
      mmoDebug.Lines.Add('');
      mmoDebug.Lines.Add('Début la recherche du chemin le plus court');
      mmoDebug.Lines.Add('==========================================================');
      Dist := FGraphNode.Dijkstra(speFromNodeIndex.Value, speToNodeIndex.Value, FShortestPath);
      mmoDebug.Lines.Add('Fin la recherche du chemin le plus court');
      mmoDebug.Lines.Add('==========================================================');
      if (Dist > 0) then
      begin
        mmoDebug.Lines.Add('Le plus court chemin du noeud ' + speFromNodeIndex.Value.ToString + ' vers le noeud ' + speToNodeIndex.Value.ToString);
        s := '';
        for i :=(FShortestPath.Count - 1) downto 0  do
        begin
          s := s + FShortestPath.Items[i].ToString;
          if (i > 0) then s := s + ', ';
        end;
        mmoDebug.Lines.Add('Passe par les noeuds : ' + s);
        mmoDebug.Lines.Add('La distance total est de : ' + Dist.ToString);
        FRenderShortestPath := True;
        pnlView.Repaint;
      end
      else
      begin
        mmoDebug.Lines.Add('Aucun chemin trouvé');
      end;
    end;
     
    procedure TMainForm.DoOnTavelNode(Sender: TObject; Node: TNode; ADistance: Single);
    var
      s : String;
    begin
      s:= '[INFO] Traitement du noeuds ' + Node.NodeIndex.ToString + ' - Distance par rapport au point de départ : ' + ADistance.ToString;
      mmoDebug.Append(s);
    end;
     
    procedure TMainForm.DoOnVerboseCall(Sender: TObject; msg: String);
    begin
      mmoDebug.Append(msg);
    end;
     
    procedure TMainForm.BZThreadTimer1Timer(Sender: TObject);
    begin
      //RenderGraph;
      pnlView.Repaint;
    end;
     
    procedure TMainForm.FormShow(Sender: TObject);
    begin
      //BZThreadTimer1.Enabled := True;
    end;
     
    procedure TMainForm.AddNode(aPosition: TBZVector);
    Var
     aNode : TNode;
    begin
      aNode := FGraphNode.AddNode(aPosition);
      FSelectedNodeIndex := aNode.NodeIndex;
      Caption := 'Ajout d''un noeud à l''index : ' + FSelectedNodeIndex.ToString + '/' + FGraphNode.Count.ToString;
      speToNodeIndex.Value := FSelectedNodeIndex;
    end;
     
    procedure TMainForm.RemoveNode(Index: Integer);
    begin
      FGraphNode.Delete(Index);
    end;
     
    procedure TMainForm.LinkNode(FromNode, ToNode: TNode; Const Bidi: Boolean);
    begin
      FromNode.AddNodeLink(ToNode.NodeIndex);
      if Bidi then ToNode.AddNodeLink(FromNode.NodeIndex);
    end;
     
    procedure TMainForm.MoveNode(aNode: TNode; NewPosition: TBZVector);
    begin
      FGraphNode.Node[aNode.NodeIndex].Position := NewPosition;
    end;
     
    function TMainForm.FindNodeFromPosition(aPosition: TBZVector): TNode;
    Var
     aNode : TNode;
    begin
      Result := Nil;
      FGraphNode.MoveFirst;
      aNode := FGraphNode.Current;
      While Not(FGraphNode.IsEndOfArray) do
      begin
        if (aNode.Position = aPosition) then
        begin
          Result := aNode;
          Break;
        end;
        FGraphNode.MoveNext;
        aNode := FGraphNode.Current;
      end;
    end;
     
    procedure TMainForm.RenderGraph;
    Var
     idx : Integer;
     Node  : TNode;
     NodeLink : TNodeLink;
     
     pA, pB : TBZFloatPoint;
     
      procedure RenderNode(aNode : TNode; IsSelected : Boolean);
      begin
        with FDisplayBuffer.Canvas do
        begin
          Antialias := True;
          Pen.Style := ssSolid;
          if IsSelected then Pen.Color := clrAqua else Pen.Color := clrWhite;
          Brush.Style := bsSolid;
          if IsSelected then Brush.Color := clrYellow else Brush.Color := clrSilver;
          Circle(aNode.Position.XY, 8);
          Font.Color := clrBlack;
          Font.Size := 8;
          TextOut(Round(aNode.Position.XY.X - ((4 * aNode.NodeIndex.ToString.Length) - 2)), Round(aNode.Position.XY.Y + 4), aNode.NodeIndex.ToString);
        end;
      end;
     
      procedure RenderRubberLineLink;
      begin
        if (FNodeAction = naAddLink) then
        begin
          //(FSelectedNodeIndex <> -1) then
          begin
            Node := FGraphNode.Node[FSelectedNodeIndex];
            with FDisplayBuffer.Canvas do
            begin
              Pen.Style := ssSolid;
              Pen.Width := 3;
              Pen.Color := clrSkyBlue;
              pA := Node.Position.XY;
              pA.x := pA.x - 1;
              MoveTo(pA);
              pB := FMousePos.AsVector2f;
              LineTo(pB);
              //if (FSelectedNodeLinkIndex <> -1) then LineTo(NodeLink.Position.XY) else
            end;
          end;
        end;
      end;
     
      procedure RenderNodeLinks;
      Var
       i, j, k  : Integer;
       isBidi : Boolean;
      begin
        for i := 0 to (FGraphNode.Count - 1) do
        begin
          Node := FGraphNode.Node[i];
          if (Node.NodeLinkList.Count > 0) then
          begin
     
            for j := 0 to (Node.NodeLinkList.Count - 1) do
            begin
              NodeLink := Node.LinkNode[J];
              isBidi := false;
              if (NodeLink.Node.NodeLinkList.Count > 0) then
              begin
                for k := 0 to (NodeLink.Node.NodeLinkList.Count - 1) do
                begin
                  if (NodeLink.Node.LinkNode[k].TargetNodeIndex = Node.NodeIndex) then
                  begin
                    isBidi := True;
                    Break;
                  end;
                end;
              end;
     
              with FDisplayBuffer.Canvas do
              begin
                Pen.Style := ssSolid;
                Pen.Width := 3;
                pA := Node.Position.XY;
                pB := NodeLink.Node.Position.XY;
                if not(IsBidi) then
                begin
                  Pen.Color := clrOrange;
                  MoveTo(pA);
                  LineTo(pB);
                end
                else
                begin
                  //Pen.Color := clrOrange;
                  //pA := pA - 3;
                  //pb := pB - 3;
                  //MoveTo(pA);
                  //LineTo(pB);
                  Pen.Color := clrBlue;
                  MoveTo(pA);
                  LineTo(pB);
                end;
     
              end;
            end;
          end;
        end;
      end;
     
      procedure RenderShortestPath;
      var
        i : Integer;
      begin
     
        for i := 1 to (FShortestPath.Count - 1) do
        begin
          with FDisplayBuffer.Canvas do
          begin
             Pen.Style := ssSolid;
             Pen.Width := 3;
             pA := FGraphNode.Items[FShortestPath.Items[i - 1]].Position.XY;
             pB := FGraphNode.Items[FShortestPath.Items[i]].Position.XY;
             Pen.Color := clrLightMagenta;
             MoveTo(pA);
             LineTo(pB);
          end;
        end;
      end;
     
    begin
      FDisplayBuffer.RenderFilter.DrawGrid(clrGray15, clrGray35, clrGray25, clrRed, clrGreen, 10);
     
      if FGraphNode.Count > 0 then
      begin
        RenderNodeLinks;
        RenderRubberLineLink;
        if FRenderShortestPath then RenderShortestPath;
        for idx := 0 to FGraphNode.Count-1 do
        begin
          Node := FGraphNode.Node[Idx];
          if (Idx = FSelectedNodeIndex) or (Idx = FSelectedNodeLinkIndex) then RenderNode(Node, True)
          else RenderNode(Node, False);
        end;
      end;
    end;
     
     
    {%endregion%}
     
    end.


    et

    Code :Sélectionner tout -Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    90
    91
    92
    93
    94
    95
    96
    97
    98
    99
    100
    101
    102
    103
    104
    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
     
    (*
      @abstract(Contient des classes génériques pour manipuler des
      tableaux "Array" a travers un pointeur.)
     
      Contient des classes pour manipuler des tableaux 1D de type Byte, Integer, Single et Double. @br
      Contient des classes pour manipuler des tableaux 2D de type Byte, Integer, Single et Double.
     
      -------------------------------------------------------------------------------------------------------------
     
      @created(24/02/2019)
      @author(J.Delauney (BeanzMaster))
      @bold(Historique) : @br
      @unorderedList(
        @item(Creation : 24/02/2019)
      )
     
      -------------------------------------------------------------------------------------------------------------
     
      @bold(Notes <img src="images/smilies/icon_smile.gif" border="0" alt="" title=":)" class="inlineimg" />@br
     
      -------------------------------------------------------------------------------------------------------------
     
      @bold(Dependances) : BZSceneStrConsts, BZLogger si DEBUGLOG est activé @br
     
      -------------------------------------------------------------------------------------------------------------
     
       @bold(Credits <img src="images/smilies/icon_smile.gif" border="0" alt="" title=":)" class="inlineimg" />@br
         @unorderedList(
           @item(J.Delauney (BeanzMaster))
         )
     
      -------------------------------------------------------------------------------------------------------------
     
      @bold(LICENCE) : MPL / LGPL @br
     
      ------------------------------------------------------------------------------------------------------------- *)
    unit BZArrayClasses;
     
    //==============================================================================
    {$mode delphi}{$H+}
     
    // Options de débogage pour que les logs soient fonctionnels, nous devons définir
    // les options de compilations dans les unités des paquets. Car les options relatif à
    // un projet ne sont pas propagé dans les unités d'un paquet.
    {.$DEFINE DEBUG}
    {.$DEFINE DEBUGLOG}
     
    //==============================================================================
     
    interface
     
    uses
      Classes, SysUtils;
     
    //==============================================================================
     
    const
      { Granularité de croissance minimum d'un tableau }
      cDefaultListGrowthDelta = 16;
     
      { Lorsque la liste est plus petite que cInsertionSort_CutOff, nous utilisons InsertionSort au lieu d'appeler
       tout autre algorithme de tri, de manière récursive.
       8 et 64 semblent être les limites inférieures et supérieures où les performances se dégradent, donc
       quelque chose entre 16 et 48 &#8203;&#8203;donne probablement les meilleures performances
       D'après mes tests 42 est une bonne valeur médiane. }
      cInsertionSort_CutOff   = 42;
     
      { Lorsque la liste est plus petite que cQuickSort_CutOff, nous utilisons l'algorithme QuickSort au lieu de DualQuickSort }
      cQuickSort_CutOff       = 500;
     
    type
      { Déclaration pour définir un tableau dynamique de single }
      TBZDynSingleArray = Array of Single;
      { Déclaration pour définir un tableau dynamique de single }
      TBZDynIntegerArray = Array of Integer;
      { Déclaration pour définir un tableau dynamique de single }
      TBZDynByteArray = Array of Byte;
     
      { Ordre de trie Ascendant ou descendant }
      TBZSortOrder = (soAscending, soDescending);
     
      { Classe de base générique pour gérer un tableau de n'importe quel type, tableau statique et pointeur.
    ****Fournis quelques fonctions utiles et communes  ajouter, supprimer, accès aux données.
        Prend également en charge l'accès en mode LIFO (Stack)  }
    type TBZBaseList<T> = Class
      private
        FTagString : string;
        type
          PT = ^T;
          TArr = array of T;
        procedure SetCount(AValue : Int64);
     
      protected
        {$CODEALIGN RECORDMIN=16}
        FData: TArr;  //Le pointeur de liste de base (non typé)
        {$CODEALIGN RECORDMIN=4}
     
        FCapacity:Int64;
        FDataSize:Int64;
        FItemSize:Int64; // Doit être défini dans les sous-classes
        FGrowthDelta: Integer;
        FParentData: Pointer;
        FHandle: Int64;
     
        FRevision: LongWord;
        FCount: Int64;
     
        FPosition: Int64;
        FFirstDone: Boolean;
     
        Function GetData: Pointer; inline;
        Function GetDataArray: TArr; inline;
     
        function GetValue(const Position: Int64): T;
        procedure SetValue(const Position : Int64; const AValue : T);
     
        function GetMutable(const Position: Int64): PT;
        procedure IncreaseCapacity();
     
        procedure SetCapacity(const NewCapacity: Int64); virtual;
     
        function CompareValue(Const elem1, elem2: T) : Integer; virtual;
     
        procedure AnyQuickSort( idxL, idxH : Integer; Dir : TBZSortOrder); //CompareValue: TBZArraySortCompareValue); //var SwapBuf : pByte);
        procedure AnyInsertionSort(idxL, idxH : Integer; Dir : TBZSortOrder); //CompareValue: TBZArraySortCompareValue);
        procedure AnyDualPivotQuickSort(idxL, idxH : Integer; Dir : TBZSortOrder); // CompareValue : TBZArraySortCompareValue);
     
      public
        { Creation d'un nouveau tableau vide}
        constructor Create; overload;//override;
        { Creation d'un nouveau tableau de "Reserved" éléments }
        constructor Create(Reserved: Int64); overload;
        { Créer un nouveau tableau avec un nombre d'éléments Réservés et un propriétaire }
        constructor CreateParented(AParentData: Pointer; Reserved: Int64); overload;
        { Libère et détruit le tableau }
        destructor Destroy; override;
     
        { Renvoie la taille totale du tableau }
        function DataSize(): Int64; // size of the list
        { Renvoie la taille d'un élément }
        function ItemSize(): Longint;
     
        { Ajoute un nouvel élément }
        function Add(const Value: T):Int64;
        { Ajoute un nouvel élément si celui-ci n'es pas déja présent dans le tableau. Retourne -1 si l'élément n'est pas ajouté }
        function AddNoDup(const Value: T):Int64;
        { Insert un nouvel élément à la position "Position" }
        procedure Insert(Position: Int64; const Value: T);
        { Efface un  élément à la position "Position" }
        procedure Delete(Position : Int64);
        { Echange la posiotion des éléments "Index1" et "Index2" }
        procedure Exchange(index1, index2: Int64);
        { Inverse le tableau }
        procedure Reverse(); inline;
     
        //procedure AddNulls(nbVals: Cardinal); inline;
        //procedure InsertNulls(Position : Int64; nbVals: Cardinal); inline;
     
        { Vide la liste sans altérer la capacité. }
        procedure Flush();
        { Vide la liste et libère les éléments }
        procedure Clear();
        { Ajoute un nouvel élément en haut tableau }
        procedure Push(const Value: T);
        { Récupère l'élément en haut du tableau }
        function Pop: T;
        { Retourne le premier élément du tableau }
        function First: T;
        { Retourne le dernier élément du tableau }
        function Last(): T;
        { Renvoie l'élément suivant du tableau, relatif à la position actuelle }
        function Next(): T;
        { Renvoie l'élément précédent du tableau, relatif à la position actuelle }
        function Prev(): T;
        { Renvoie l'élément actuel du tableau, relatif à la position actuelle }
        function Current : T;
        { Déplacer la position actuelle dans le tableau à la prochaine }
        function MoveNext():Boolean;
        { Déplacer la position actuelle dans le tableau à la précédente }
        function MovePrev():Boolean;
        { Déplacer la position actuelle dans le tableau vers le premier élément }
        function MoveFirst():Boolean;
        { Déplacer la position actuelle dans le tableau vers le dernier élément }
        function MoveLast():Boolean;
        { Renvoie la position actuelle dans le tableau }
        function GetPosition() : Int64;
        { Se placer à la postion "Pos" en fonction de StartAt@br
          @param(Valeurs possible pour StartAt  :@br
          @unorderedlist(
            @item( 0 = Depuis le début (defaut) )
            @item( 1 = Depuis la position actuelle)
            @item( 2 = En partant de la fin)
          )}
        function Seek(const pos : Int64; const StartAt : Byte = 0) : boolean;
        { Se placer à n'importe quelle position dans le tableau (equivalent a seek(position, 0)}
        function MoveTo(const Position:Int64) : Boolean;
        { Vérifie si la fin du tableau est atteinte}
        function IsEndOfArray() : Boolean;
        { Retourne l'index de l'élément "SearchItem". Dans le cas ou celui n'existe pas retourne -1 }
        function IndexOf(const SearchItem : T): Integer;
        { Renvoie l'élélement suivant de l'élément "anItem", Si l'élément n'existe pas le premier élément du tableau est retourné }
        function GetNextFrom(const anItem : T) : T;
     
        // Array Rasterizer
        // function Scan(CallBack):Boolean;
        // function ScanNext(CallBack):Boolean;
        // function ScanPrev(CallBack):Boolean;
     
        // function ScanMany(nbItem,CallBack):Boolean;
        // function ScanTo(Position,CallBack):Boolean;
     
        // function ScanAll(CallBack):Boolean;
        // function ScanRange(From, To, CallBack):Boolean;
     
        // Array Utils
     
       // function CompareItems(Index1, index2, CompareValue): Integer; virtual;
     
        { Trie le tableaux par ordre croissant ou décroissant.
          L'algorithme de tri utilisé dépend du nombre d'éléments en fonction des constantes  cInsertion_CutOff et cQuickSort_CutOff. @br
          Si la liste à un nombre d'éléments inférieur à 42 le tri par insertion est utilisé. @br
          Si la liste à un nombre d'éléments inférieur ou égale à 500 le tri rapide "QuickSort" est utilisé. @br
          Si non, c'est le tri rapide à double pivot "DualPivotQuickSort" qui est utilisé. }
        procedure Sort(Const Direction : TBZSortOrder = soAscending);  virtual;
        { Trie le tableau avec l'algorithme de trie rapide "QuickSort" version "Stable" }
        procedure QuickSort(Const Direction : TBZSortOrder = soAscending); virtual;
        { Trie le tableau avec l'algorithme de trie rapide à double pivot version "Stable", c'est l'algorithme utilisé par défaut par la méthode Sort }
        procedure DualQuickSort(Const Direction : TBZSortOrder = soAscending); virtual;
        { Trie le tableau avec l'algorithme d'insertion }
        procedure InsertionSort(Const Direction : TBZSortOrder = soAscending); virtual;
     
        { Mélange les éléments du tableau aléatoirement. Il vous faudra appeler la méthode Randomize en premier }
        procedure Shuffle();
     
        // procedure Merge(AnotherArray: TBZBaseList<T>);
        // function Clone : TBZBaseList<T>;
        // function Extract(From, Nb : Int64): TBZBaseList<T>;
     
        // Extra funcs for management
        // function InsertItemsAt(Pos:Int64; AnArray : TBZBaseList<T>):Boolean;
        // function InsertItemsAtEnd
        // function InsertItemsAtFirst
        // procedure DeleteItems(Index: Int64r; nbVals: Cardinal); inline;
     
        { Nombre d'éléments dans la liste. Lors de l'attribution d'un nombre, les éléments ajoutés sont réinitialisés à zéro. }
        property Count: Int64 read FCount write SetCount;
        { Capacité du tableau actuel. Non persistant. }
        property Capacity: Int64 read FCapacity write SetCapacity;
        { Granularité de croissance. Pas persistant. }
        property GrowthDelta: Integer read FGrowthDelta write FGrowthDelta;
        { Augmenter de un après chaque changement de contenu. }
        property Revision: LongWord read FRevision write FRevision;
        { Renvoie le propriétaire s'il existe }
        property ParentData : Pointer read FParentData;
        { Renvoie le tableau sous forme de pointeur }
        property Data : Pointer read GetData;
        property DataArray : TArr read GetDataArray;
        { Renvoie le handle du tableau }
        property Handle : Int64 read FHandle;
     
        { Accès aux éléments du tableau }
        property Items[i : Int64]: T read getValue write SetValue;// default;
        { Accès à l'élément dans le tableau en tant que pointeur générique }
        property Mutable[i : Int64]: PT read getMutable;
        { Tag utilisateur }
        property TagString: string read FTagString write FTagString;
      end;
     
      {
      //generic TBZBaseListMap3D<T> = class(specialize TBZBaseList<T>)
      //private
      //  function GetValue3D(x, y, z : Int64): T;
      //  procedure SetValue3D(x, y, z : Int64; AValue: T);
      //published
      //public
      //  constructor Create(Rows, Cols, DCols : Int64); overload;
      //  constructor CreateParented(AParentData: Pointer; Rows, Cols, DCols: Int64); overload;
      //  property Items[x,y,z : Int64]: T read GetValue3D write SetValue3D;
      //end;
      //
      //generic TBZBaseListMap4D<T> = class(specialize TBZBaseList<T>)
      //private
      //  function GetValue4D(x, y, z, w : Int64): T;
      //  procedure SetValue4D(x, y, z, w : Int64; AValue: T);
      //published
      //public
      //  constructor Create(Rows, Cols, DCols, TCols: Int64); overload;
      //  constructor CreateParented(AParentData: Pointer; Rows, Cols, DCols, TCols: Int64); overload;
      //  property Items[x,y,z,w : Int64]: T read GetValue4D write SetValue4D;
      //end;
     
    Type
      { Tableau générique de type Byte à une Dimension }
    type TBZIntegerList = class(TBZBaseList<Integer>)
      private
      protected
        function CompareValue(Const elem1, elem2: integer) : Integer;  override;
      public
    end;
    type TBZDoubleList = class(TBZBaseList<double>)
      private
      protected
        function CompareValue(Const elem1, elem2: double) : Integer;  override;
      public
    end;
    implementation
     
    //==============================================================================
     
    {%region%=====[ TBZBaseList ]=================================================}
     
    constructor TBZBaseList<T>.Create;
    begin
      inherited Create;
      FCapacity:=0;
     // FItemSize:=Sizeof(T); // Must be defined in subclasses  ????
      FGrowthDelta:= cDefaultListGrowthDelta;
      FParentData:=nil;
      FHandle:=0;
      //FIsDirty:=false;
      FRevision:=0;
      FCount:=0;
      FPosition:=0;
      FFirstDone:=false;
    end;
     
    constructor TBZBaseList<T>.Create(Reserved : Int64);
    begin
      Create;
      FDataSize:=Reserved;//*ItemSize;
      SetCapacity(Reserved);
      //SetCount(Reserved);
    end;
     
    constructor TBZBaseList<T>.CreateParented(AParentData : Pointer; Reserved : Int64);
    begin
      Create(Reserved);
      FParentData := AParentData;
    end;
     
    destructor TBZBaseList<T>.Destroy;
    begin
      {$IFDEF DEBUG}
        {$IFDEF DEBUGLOG}
          GlobalLogger.LogNotice('>>> TBZBaseList.Destroy');
        {$ENDIF}
      {$ENDIF}
      Clear;
      //SetLength(FData, 0);
      FData := nil;
      inherited Destroy;
    end;
     
    procedure TBZBaseList<T>.SetCount(AValue : Int64);
    begin
      {$ifdef DEBUG}
        {$IFDEF DEBUGLOG}
          GlobalLogger.LogNotice('>>> TBZBaseList.SetCount');
          GlobalLogger.LogStatus('>>> AValue = ' + AValue.ToString);
        {$ENDIF}
        Assert(AValue >= 0);
      {$endif}
      if FCount = AValue then Exit;
      if AValue> FCapacity then SetCapacity(AValue);
      FCount := AValue;
      Inc(FRevision);
    end;
     
    Function TBZBaseList<T>.GetData : Pointer;
    begin
      Result := @FData;
    end;
     
    Function TBZBaseList<T>.GetDataArray : TArr;
    begin
      Result := FData;
    end;
     
    function TBZBaseList<T>.GetValue(const Position : Int64) : T;
    begin
      Result := FData[Position];
    end;
     
    procedure TBZBaseList<T>.SetValue(const Position : Int64; const AValue : T);
    begin
      if (Position >= FCapacity) then IncreaseCapacity;
      FData[Position] := AValue;
    end;
     
    function TBZBaseList<T>.GetMutable(const Position : Int64) : PT;
    begin
      Result := @FData[Position];
    end;
     
    procedure TBZBaseList<T>.IncreaseCapacity();
    begin
      if (FCapacity = 0) then SetCapacity(1)
      else
      begin
        if (FCount >= FCapacity) then SetCapacity(FCapacity + FGrowthDelta);
      end;
    end;
     
    procedure TBZBaseList<T>.SetCapacity(const NewCapacity : Int64);
    begin
      if (FCapacity = newCapacity) then exit;
      FCapacity := newCapacity;
      SetLength(FData, FCapacity);
      Inc(FRevision);
    end;
     
    function TBZBaseList<T>.CompareValue(Const elem1, elem2: T) : Integer;
    begin
      result := 0;
    end;
     
    function TBZBaseList<T>.DataSize() : Int64;
    begin
      Result := FCount * ItemSize; //FDataSize;
    end;
     
    function TBZBaseList<T>.ItemSize() : Longint;
    begin
      Result := Sizeof(T); //FItemSize;
    end;
     
    function TBZBaseList<T>.Add(const Value : T) : Int64;
    begin
      Result := FCount;
      if (Result >= FCapacity) then self.IncreaseCapacity();
      FData[Result] := Value;
      Inc(FCount);
    end;
     
    function TBZBaseList<T>.AddNoDup(const Value : T) : Int64;
    Var
      pos : Integer;
      isNew : Boolean;
    begin
      Result := -1;
      pos := 0;
      isNew := True;
      while ((pos < FCount) and (isNew = true)) do
      begin
        if FData[pos] = Value then isNew := False;
        inc(pos);
      end;
      if IsNew then
      begin
        {$IFDEF DEBUG}
          {$IFDEF DEBUGLOG}
            GlobalLogger.LogHint('>>>> New value');
          {$ENDIF}
        {$ENDIF}
        Result := FCount;
        if (Result >= FCapacity) then IncreaseCapacity;
        FData[Result] := Value;
        Inc(FCount);
      end;
    end;
     
    procedure TBZBaseList<T>.Insert(Position : Int64; const Value : T);
    begin
      if FCount = FCapacity then IncreaseCapacity;
      if Position < FCount then
        System.Move(FData[Position], FData[Position + 1], (FCount - Position) * ItemSize);
      FData[Position] := Value;
      Inc(FCount);
    end;
     
    procedure TBZBaseList<T>.Delete(Position : Int64);
    begin
      if (Position < (FCount - 1)) then
      begin
        Dec(FCount);
        System.Move(FData[(Position + 1)], FData[Position], (FCount - Position) * ItemSize);
      end
      else Dec(FCount);
      Inc(FRevision);
    end;
     
    procedure TBZBaseList<T>.Exchange(index1, index2 : Int64);
    var
      temp : T;
    begin
      if Index1 = Index2 then Exit;
      temp := FData[index1];
      FData[index1] := FData[index2];
      FData[index2] := temp;
      Inc(FRevision);
    end;
     
    procedure TBZBaseList<T>.Reverse;
    var
      s, e: Integer;
    begin
      s := 0;
      e := FCount - 1;
      while s < e do
      begin
        Exchange(s, e);
        Inc(s);
        Dec(e);
      end;
      Inc(FRevision);
    end;
     
    //procedure TBZBaseList.AddNulls(nbVals : Cardinal);
    //begin
    //
    //end;
    //
    //procedure TBZBaseList.InsertNulls(Position : Int64; nbVals : Cardinal);
    //begin
    //
    //end;
     
    procedure TBZBaseList<T>.Flush;
    begin
      SetCount(0);
    end;
     
    procedure TBZBaseList<T>.Clear;
    begin
      SetCount(0);
      SetCapacity(0);
    end;
     
    //procedure TBZBaseList.AdjustCapacityToAtLeast(const size: Integer);
    //begin
    //  if FCapacity < Size then SetCapacity(size);
    //end;
     
    procedure TBZBaseList<T>.Push(const Value : T);
    begin
      self.Add(Value);
    end;
     
    function TBZBaseList<T>.Pop() : T;
    begin
      Result := FData[FCount-1];
     Delete(FCount-1);
    end;
     
    function TBZBaseList<T>.First() : T;
    begin
      Result := FData[0];
    end;
     
    function TBZBaseList<T>.Last() : T;
    begin
      Result := Pop();
    end;
     
    function TBZBaseList<T>.Next() : T;
    begin
      if (FPosition < FCount) then //Inc(FPosition);
        Result := FData[FPosition + 1]
      else Result := FData[FPosition];
    end;
     
    function TBZBaseList<T>.Prev() : T;
    begin
      if (FPosition > 0) then  //Dec(FPosition);
       Result := FData[FPosition - 1]
      else Result := FData[FPosition];
    end;
     
    function TBZBaseList<T>.Current() : T;
    begin
      Result := FData[FPosition];
    end;
     
    function TBZBaseList<T>.MoveNext() : Boolean;
    begin
      Result := false;
      if (FPosition >= FCount-1) then exit;
      Result := True;
      Inc(FPosition);
    end;
     
    function TBZBaseList<T>.MovePrev() : Boolean;
    begin
      Result := false;
      if (FPosition <= 0 ) then exit;
      Result := True;
      Dec(FPosition);
    end;
     
    function TBZBaseList<T>.MoveFirst() : Boolean;
    begin
      result := true;
      FPosition := 0;
    end;
     
    function TBZBaseList<T>.MoveLast() : Boolean;
    begin
      result := true;
      FPosition := FCount-1;
    end;
     
    function TBZBaseList<T>.GetPosition() : Int64;
    begin
      Result := FPosition;
    end;
     
    function TBZBaseList<T>.Seek(const pos : Int64; const StartAt : Byte=0) : boolean;
    var
      newpos : Int64;
    begin
      result := true;
      Case StartAt of
        0: newpos := Pos; // From Beginning
        1:
        begin
          newpos := (FPosition-1) + Pos; // From Current positon
          if newpos >= FCount then
          begin
            //newpos := FCount-1;
            result := false;
          end;
        end;
        2:
        begin
          newpos := (FCount-1) - Pos; // From End;
          if newpos=0 then
          begin
            //newpos := 0;
            result := false;
          end;
        end;
        else newpos := pos;
      end;
      if result then FPosition := newpos;
    end;
     
    function TBZBaseList<T>.MoveTo(const Position:Int64) : Boolean;
    begin
     
      result:= Self.Seek(Position, 0);
    end;
     
    function TBZBaseList<T>.IsEndOfArray() : Boolean;
    begin
      result := (FPosition >= FCount);
    end;
     
    function TBZBaseList<T>.IndexOf(const SearchItem : T) : Integer;
    var
      i: Integer;
    begin
      if FCount <= 0 then Result := -1
      else
      begin
        Result := -1;
        for i  := 0 to FCount - 1 do
          if FData[i] = SearchItem then
          begin
            Result := i;
            Exit;
          end;
      end;
    end;
     
    function TBZBaseList<T>.GetNextFrom(const anItem : T) : T;
    begin
      if FCount <= 0 then exit;
      Result := FData[((Self.indexOf(anItem) + 1) mod Self.Count)];
    end;
     
    { Le "Dual Pivot QuickSort" est plus légèrement plus rapide que le QuickSort classique (dans la majorité des cas).
    Sur la papier, le DualPivotQuickSort à 1.9nlnn+O(n) comparaisons, ce qui est 5% de moins que les comparaisons 2nlnn+O(n)  de l'algorithme Quicksort classique à pivot unique.
    Cependant, il a besoin de 0.6nlnn+O(n) échanges de valeurs alors qu'avec le Quicksort classique il en faut 1/3nlnn+O(n).
    Il existe une version en Java optimisée de cet algorithmequi donne de meilleurs résultats, mais celle-ci est complexe à mettre en place
    cf : http://hg.openjdk.java.net/jdk8/jdk8/jdk/file/tip/src/share/classes/java/util/DualPivotQuicksort.java }
    procedure TBZBaseList<T>.AnyDualPivotQuickSort(idxL, idxH : Integer; Dir : TBZSortOrder);
    var
      idx, lpi, rpi : Integer;
      nb, li, hi  : Integer;
      SwapTemp, p, q, ak : T;
     
    begin
     
      if (idxH <= idxL) then Exit;
      nb := idxH - idxL;
     
      if nb < cInsertionSort_CutOff then
      begin
        AnyInsertionSort(idxL, idxH, Dir);
        Exit;
      end;
      //else if nb <= cQuickSort_CutOff then
      //begin
      //  AnyQuickSort(idxL, idxH, Dir);
      //  Exit;
      //end;
     
      li := idxL;
      hi := idxH;
     
      // Debut de la partition
      if Dir = soAscending then
      begin
        if (CompareValue(FData[hi], FData[li]) < 0) then
        begin
          SwapTemp := FData[li];
          FData[li] := FData[hi];
          FData[hi] := SwapTemp;
        end;
      end
      else
      begin
        if (CompareValue(FData[hi], FData[li]) > 0) then
        begin
          SwapTemp := FData[li];
          FData[li] := FData[hi];
          FData[hi] := SwapTemp;
        end;
      end;
     
      p := FData[li];
      q := FData[hi];
     
      lpi := li + 1;
      rpi := hi - 1;
      idx := lpi;
     
      if Dir = soAscending then
      begin
        While (idx <= rpi) do
        begin
          ak := FData[idx];
          if (CompareValue(ak, p) < 0) then
          begin
            FData[idx] := FData[lpi];
            FData[lpi] := ak;
            inc(lpi);
          end
          else if (CompareValue(ak, q) >= 0) then
          begin
            While ((CompareValue(FData[rpi], q) > 0) and (idx < rpi)) do Dec(rpi);
            FData[idx] := FData[rpi];
            FData[rpi] := ak;
            dec(rpi);
            if (CompareValue(ak, p) < 0) then
            begin
              FData[idx] := FData[lpi];
              FData[lpi] := ak;
              inc(lpi);
            end;
          end;
          inc(idx);
        end;
      end
      else
      begin
        While (idx <= rpi) do
        begin
          ak := FData[idx];
          if (CompareValue(ak, p) > 0) then
          begin
            FData[idx] := FData[lpi];
            FData[lpi] := ak;
            inc(lpi);
          end
          else if (CompareValue(ak, q) <= 0) then
          begin
            While ((CompareValue(FData[rpi], q) < 0) and (idx < rpi)) do Dec(rpi);
            FData[idx] := FData[rpi];
            FData[rpi] := ak;
            dec(rpi);
            if (CompareValue(ak, p) > 0) then
            begin
              FData[idx] := FData[lpi];
              FData[lpi] := ak;
              inc(lpi);
            end;
          end;
          inc(idx);
        end;
      end;
     
      Dec(lpi);
      Inc(rpi);
     
      SwapTemp := FData[lpi];
      FData[lpi] := FData[li];
      FData[li] := SwapTemp;
     
      SwapTemp := FData[rpi];
      FData[rpi] := FData[hi];
      FData[hi] := SwapTemp;
      // Fin de la partition
     
      AnyDualPivotQuickSort(li,lpi - 1, Dir);
      if DIr = soAscending then
      begin
        if (CompareValue(FData[lpi], FData[rpi]) < 0) then AnyDualPivotQuickSort(lpi + 1, rpi - 1, Dir);
      end
      else
      begin
        if (CompareValue(FData[lpi], FData[rpi]) > 0) then AnyDualPivotQuickSort(lpi + 1, rpi - 1, Dir);
      end;
      AnyDualPivotQuickSort(rpi + 1, hi, Dir);
    end;
     
    procedure TBZBaseList<T>.AnyQuickSort(idxL, idxH : Integer; Dir : TBZSortOrder);
    var
      li, hi : Integer;
      TP : Integer;
      mi    : Integer;
      SwapBuf : T;
    begin
      if (idxL >= idxH) then exit;
      if (idxH - idxL) < cInsertionSort_CutOff then
      begin
        AnyInsertionSort(IdxL, idxH, Dir);//, CompareValue);
        Exit;
      end;
     
      if idxL<>0 then mi := (idxL + idxH) div 2
      else mi := (((idxL+1) + idxH) div 2) - 1;
      li := idxL;
      hi := idxH;
     
      SwapBuf := FData[li];
      FData[li] := FData[mi];
      FData[mi] := SwapBuf;
     
      TP := idxL;
      inc(li);
     
     
      if dir = soAscending then
      begin
        repeat
          if (CompareValue( FData[li], FData[idxL] ) < 0) then
          begin
            inc(TP);
            SwapBuf := FData[TP];
            FData[TP] := FData[li];
            FData[li] := SwapBuf;
          end;
          inc(li);
        until li>hi;
      end
      else
      begin
        repeat
          if (CompareValue( FData[li], FData[idxL] ) > 0) then
          begin
            inc(TP);
            SwapBuf := FData[TP];
            FData[TP] := FData[li];
            FData[li] := SwapBuf;
          end;
          inc(li);
        until li>hi;
      end;
     
      SwapBuf := FData[idxL];
      FData[idxL] := FData[TP];
      FData[TP] := SwapBuf;
     
      AnyQuickSort(idxL, TP-1, Dir);//, CompareValue);
      AnyQuickSort(TP+1, idxH, Dir);//, CompareValue);
    end;
     
    procedure TBZBaseList<T>.AnyInsertionSort(idxL, idxH : Integer; Dir : TBZSortOrder);
    var
      ps, cs : Integer;
      li,hi : Integer;
      SwapBuf : T;
    begin
     
      if FCount<2 then exit;
     
      if FCount = 2 then
      begin
        if (CompareValue(FData[1], FData[0]) < 0) then
        begin
          If Dir = soAscending then
          begin
            SwapBuf := FData[0];
            FData[0] := FData[1];
            FData[1] := SwapBuf;
            Exit;
          end
          else
          begin
            Exit;
          end;
        end;
      end;
     
      li :=idxL + 1;
      hi :=idxH;
     
      Repeat
       SwapBuf := FData[li]; //Move(pb[ls], SwapBuf^, Stride);
       ps := li;
       cs := ps - 1;
       If Dir = soAscending then
       begin
         While (ps >= 1) and  (CompareValue(SwapBuf, FData[cs]) < 0) do
         begin
           FData[ps] := FData[cs];
           dec(ps);
           dec(cs);
         end;
       end
       else
       begin
         While (ps >= 1) and  (CompareValue(SwapBuf, FData[cs]) > 0) do
         begin
           FData[ps] := FData[cs];
           dec(ps);
           dec(cs);
         end;
       end;
       FData[ps] := SwapBuf;
       inc(li);
      until li > hi;
     
    end;
     
     
     
    procedure TBZBaseList<T>.Sort(Const Direction : TBZSortOrder);
    begin
      if FCount<2 then exit;
      if FCount < cInsertionSort_CutOff then AnyInsertionSort(0, FCount-1, Direction)
      else if FCount <= cQuickSort_CutOff then AnyQuickSort(0, FCount-1, Direction)
      else AnyDualPivotQuickSort(0, FCount-1, Direction);
    end;
     
    procedure TBZBaseList<T>.QuickSort(Const Direction : TBZSortOrder);
    begin
      if FCount<2 then exit;
      AnyQuickSort(0, FCount-1, Direction);
    end;
     
    procedure TBZBaseList<T>.DualQuickSort(Const Direction : TBZSortOrder);
    begin
      if FCount<2 then exit;
      AnyDualPivotQuickSort(0, FCount-1, Direction);
    end;
     
    procedure TBZBaseList<T>.InsertionSort(Const Direction : TBZSortOrder);
    begin
      AnyInsertionSort(0, FCount-1, Direction);
    end;
     
    procedure TBZBaseList<T>.Shuffle();
    Var
     SwapBuffer : T;
     I, K, RandIdx : Integer;
    begin
      K := FCount - 1;
      for i := 1 to  K do
      begin
        RandIdx := random(K - I + 1) + I; // Distribution uniforme
        SwapBuffer := FData[RandIdx];
        FData[RandIdx] := FData[I];
        FData[I] := SwapBuffer;
      end;
    end;
    {%region%=====[ TBZDoubleList ]================================================}
     
    function TBZIntegerList.CompareValue(Const elem1, elem2: integer) : Integer;
    begin
      if      elem1 = elem2 then Result :=  0
      else if elem1 < elem2 then Result := -1
      else Result := 1;
    end;
     
    {%endregion%}
     
    {%region%=====[ TBZSingleList ]================================================}
     
    function TBZDoubleList.CompareValue(Const elem1, elem2: double) : Integer;
    begin
      if      elem1 = elem2 then Result :=  0
      else if elem1 < elem2 then Result := -1
      else Result := 1;
    end;
     
    //==============================================================================
    end.

  18. #38
    Membre expert
    Citation Envoyé par JP CASSOU Voir le message
    Bjr à tous,

    J'ai choisi d'adapter les unités de graphes de BZ dans mon projet

    Je rencontre une erreur pénible +++++ ici:

    Code :Sélectionner tout -Visualiser dans une fenêtre à part
    1
    2
     
    bzgraphesclasses.pas(490,17) Error: Incompatible types: got "TClass" expected "TBZClassNode"


    Ton erreur est ici :

    Code :Sélectionner tout -Visualiser dans une fenêtre à part
    TBZGraphNode = class(TBZBaseList<TClass>)


    Le Graph est une liste de Noeuds (Node) et non de "class" donc:

    Code :Sélectionner tout -Visualiser dans une fenêtre à part
    TBZGraphNode = class(TBZBaseList<TNode>)


    Sinon voici qui va te faire gagner un peu de temps




    ps : fais gaffe avec {$mode Delphi} c'est la m... des fois, surtout avec des références sur des pointeurs

    A+

    Jérôme
    • "L'Homme devrait mettre autant d'ardeur à simplifier sa vie qu'il met à la compliquer" - Henri Bergson
    • "Bien des livres auraient été plus clairs s'ils n'avaient pas voulu être si clairs" - Emmanuel Kant
    • "La simplicité est la sophistication suprême" - Léonard De Vinci
    • "Ce qui est facile à comprendre ou à faire pour toi, ne l'est pas forcément pour l'autre." - Mon pèrei

    Mes projets sur Github - Blog - Site DVP

  19. #39
    Expert confirmé
    J'ai testé ton nouveau projet Jérôme : Very Good job

    Le seul souci que j'ai vu pour l'instant c'est quand on sélectionne une station les infos arc entrant et sortant n'on pas l'air bonnes.

    Ami calmant, J.P
    Jurassic computer : Sinclair ZX81 - Zilog Z80A à 3,25 MHz - RAM 1 Ko - ROM 8 Ko

  20. #40
    Expert confirmé
    J'ai testé ton nouveau projet Jérôme : Very Good job

    Le seul souci que j'ai vu pour l'instant c'est quand on sélectionne une station les infos arc entrant et sortant n'on pas l'air bonnes.

    EDIT : correction possible :
    Code :Sélectionner tout -Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
     procedure ShowNodeInfo;  Var
        LArcsIn, LArcsOut : TBZIntegerList;
        aNode : TNode;
        i, arc : Integer;
      begin
        if (FCurrentSelectedNodeIndex =  -1)  or (FSelectedNode = nil) then exit;
        mmoInfos.Clear;
        mmoInfos.Lines.Add('Ligne         = ' + FSelectedNode.LineNUm.ToString);
        mmoInfos.Lines.Add('Station       = ' + FSelectedNode.StationNUm.ToString);
        mmoInfos.Lines.Add('ID Station    = ' + FSelectedNode.IDStation.ToString);
        if FSelectedNode.Visited then
          mmoInfos.Lines.Add('Visité        = ' + 'OUI')
        else
          mmoInfos.Lines.Add('Visité        = ' + 'NON');
        mmoInfos.Lines.Add('================================');
        LArcsIn := FSelectedNode.ArcsIn;
        mmoInfos.Lines.Add(' Arcs entrant : ');
        if (LArcsIn <> nil) then
        begin
          for i := 0 to (LArcsIn.Count - 1) do
          begin
            arc := LarcsIn.Items[i];
            mmoInfos.Lines.Add('---> Arc entrant : ' + arc.ToString);
            aNode := FGraphNode.Items[arc];
            mmoInfos.Lines.Add('     - Ligne      = ' + aNode.LineNUm.ToString);
            mmoInfos.Lines.Add('     - Station    = ' + aNode.StationNUm.ToString);
            mmoInfos.Lines.Add('     - ID Station = ' + aNode.IDStation.ToString);
            mmoInfos.Lines.Add('     - Distance   = ' + FSelectedNode.getDistanceTo(aNode).ToString);
            if aNode.Visited then
              mmoInfos.Lines.Add('     - Visité     = ' + 'OUI')
            else
              mmoInfos.Lines.Add('     - Visité     = ' + 'NON');
            mmoInfos.Lines.Add('--------------------------------');
            FreeAndNil(LArcsIn);
          end;
        end
        else
        begin
          mmoInfos.Lines.Add('---> Aucun arc entrant trouvé');
        end;
        mmoInfos.Lines.Add('================================');
        LArcsOut := FSelectedNode.ArcsOut;
        mmoInfos.Lines.Add(' Arcs sortant : ');
        if (LArcsOut <> nil) then
        begin
          for i := 0 to (LArcsOut.Count - 1) do
          begin
            arc := LarcSOut.Items[i];
            mmoInfos.Lines.Add('---> Arc sortant : ' + arc.ToString);
            aNode := FGraphNode.Items[arc];
            mmoInfos.Lines.Add('    - Ligne      = ' + aNode.LineNUm.ToString);
            mmoInfos.Lines.Add('    - Station    = ' + aNode.StationNUm.ToString);
            mmoInfos.Lines.Add('    - ID Station = ' + aNode.IDStation.ToString);
            mmoInfos.Lines.Add('    - Distance   = ' + FSelectedNode.getDistanceTo(aNode).ToString);
            if aNode.Visited then
              mmoInfos.Lines.Add('    - Visité     = ' + 'OUI')
            else
              mmoInfos.Lines.Add('    - Visité     = ' + 'NON');
            mmoInfos.Lines.Add('--------------------------------');
          end;
          FreeAndNil(LArcsOut);
        end
        else
        begin
          mmoInfos.Lines.Add('---> Aucun arc sortant trouvé');
        end;
      end;




    Ami calmant, J.P
    Jurassic computer : Sinclair ZX81 - Zilog Z80A à 3,25 MHz - RAM 1 Ko - ROM 8 Ko

###raw>template_hook.ano_emploi###