GLScene/Examples/Demox/Pathfinder/fdPathfinder.pas

unit fdPathfinder;

interface

uses
  System.SysUtils,
  System.Types,
  System.UITypes,
  System.Classes,
  System.Variants,
  System.Generics.Collections,

  FMX.Types,
  FMX.Controls,
  FMX.Forms,
  FMX.Graphics,
  FMX.Dialogs,
  FMX.Objects,
  FMX.Controls.Presentation,
  FMX.StdCtrls,
  FMX.Layouts,
  FMX.Edit,

  uGBEPathFinder;

type
  TFormPathfinder = class(TForm)
    layIHM: TLayout;
    btnTrouverChemin: TButton;
    layGrille: TLayout;
    rectangleModele: TRectangle;
    lblTotal: TLabel;
    tDistanceD: TText;
    tDistanceA: TText;
    lblInfos: TLabel;
    cbDiagonale: TCheckBox;
    layOptions: TLayout;
    ScrollBox: TScrollBox;
    eNbColonne: TEdit;
    SpinEditButton1: TSpinEditButton;
    lblNbColonne: TLabel;
    lblLigne: TLabel;
    eNbLigne: TEdit;
    SpinEditButton2: TSpinEditButton;
    btnCreerGrille: TButton;
    gbOptions: TGroupBox;
    cbPremiereEtape: TCheckBox;
    cbModeCout: TCheckBox;
    procedure FormCreate(Sender: TObject);
    procedure rectangleModeleClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure btnTrouverCheminClick(Sender: TObject);
    procedure SpinEditButton1DownClick(Sender: TObject);
    procedure SpinEditButton1UpClick(Sender: TObject);
    procedure SpinEditButton2UpClick(Sender: TObject);
    procedure SpinEditButton2DownClick(Sender: TObject);
    procedure btnCreerGrilleClick(Sender: TObject);
  private
    procedure creerGrille;
    procedure mettreAJourCase(position: TPoint; couleur: TAlphaColor;
      dDistance, aDistance: integer);
    procedure celluleClick(Sender: TObject);
    procedure initialiserGrille;
    function getPoint(indice: integer): TPoint;
    function getIndice(point: TPoint): integer;
    procedure dessinerResultat;
  public
    noeudDepart, noeudArrivee: TGBENoeud;
    lGrille, hGrille: integer;
    PathFinder: TGBEPathFinder;
  end;

var
  fFormPathfinder: TFormPathfinder;

implementation

{$R *.fmx}

procedure TFormPathfinder.FormCreate(Sender: TObject);
begin
  randomize;
  PathFinder := TGBEPathFinder.Create;
  PathFinder.CoutDeplacementCote := 10;
  PathFinder.CoutDeplacementDiagonal := 15;
  eNbColonne.Text := '12';
  eNbLigne.Text := '10';

  creerGrille;
  initialiserGrille;
end;

procedure TFormPathfinder.FormDestroy(Sender: TObject);
begin
  FreeAndNil(PathFinder);
end;

procedure TFormPathfinder.creerGrille;
var
  x, y, indice: integer;
begin
  indice := 0;
  hGrille := strtointdef(eNbLigne.Text, 8);
  lGrille := strtointdef(eNbColonne.Text, 8);
  layGrille.Width := rectangleModele.Width * lGrille;
  layGrille.Height := rectangleModele.Height * hGrille;

  // La grille est constituée de TRectangle clonés à partir du rectangleModele
  for y := 0 to hGrille - 1 do
  begin
    for x := 0 to lGrille - 1 do
    begin
      if indice >= 1 then
      begin
        with rectangleModele.Clone(nil) as TRectangle do
        begin
          parent := layGrille;
          name := 'rectangle' + indice.ToString;
          position.x := x * Width;
          position.y := y * Height;
          tag := indice;
          // le tag va contenir l'indice de la case, ce qui permettra d'avoir ensuite les coordonnées X et Y de la case
          onClick := celluleClick;
        end;
      end;
      inc(indice);
    end;
  end;
end;

procedure TFormPathfinder.initialiserGrille;
var
  iRectangle: TFMxObject;
begin
  // On dessine toutes les cases de la grille en blanc et sans texte
  for iRectangle in layGrille.Children do
  begin
    (iRectangle as TRectangle).Fill.Gradient.Color := TAlphaColorRec.White;
    ((iRectangle as TRectangle).Children[0] as TLabel).Text := '';
    ((iRectangle as TRectangle).Children[1] as TText).Text := '';
    ((iRectangle as TRectangle).Children[2] as TText).Text := '';
  end;

  // On détermine aléatoirement les cases de départ et d'arrivée
  noeudDepart.position.x := random(lGrille);
  noeudDepart.position.y := random(hGrille);
  noeudDepart.coutDeplacement := 0;

  noeudArrivee.position.x := random(lGrille);
  noeudArrivee.position.y := random(hGrille);
  // Si la case d'arrivée est adjacente à la case de départ, on recherche une autre position pour la case d'arrivée
  while (abs(noeudArrivee.position.x - noeudDepart.position.x) <= 1) and
    (abs(noeudArrivee.position.y - noeudDepart.position.y) <= 1) do
  begin
    noeudArrivee.position.x := random(lGrille);
    noeudArrivee.position.y := random(hGrille);
  end;

  // On intialise les coûts des cases de départ et d'arrivée
  noeudArrivee.coutDeplacement := PathFinder.calculerCoutArrivee
    (noeudDepart.position);
  noeudArrivee.heuristique := 0;
  noeudDepart.heuristique := noeudArrivee.coutDeplacement;

  // On dessine les cases de départ et d'arrivée
  mettreAJourCase(noeudDepart.position, TAlphaColorRec.Cyan, 0,
    noeudDepart.heuristique);
  mettreAJourCase(noeudArrivee.position, TAlphaColorRec.Cyan,
    noeudArrivee.coutDeplacement, 0);

  lblInfos.Text := 'Click on white squares to generate obstacles';
end;

// Dessine les différentes cases de la grille
procedure TFormPathfinder.mettreAJourCase(position: TPoint;
  couleur: TAlphaColor; dDistance, aDistance: integer);
var
  indice, valeur: integer;
  unNoeud: TGBENoeud;
begin
  indice := getIndice(position);

  if (position = noeudDepart.position) or (position = noeudArrivee.position)
  then
  begin
    if (position = noeudDepart.position) then
      ((layGrille.Children[indice] as TRectangle).Children[0] as TLabel)
        .Text := 'D'
    else
      ((layGrille.Children[indice] as TRectangle).Children[0] as TLabel)
        .Text := 'A';
    ((layGrille.Children[indice] as TRectangle).Children[0] as TLabel)
      .TextSettings.FontColor := TAlphaColorRec.Red;
    ((layGrille.Children[indice] as TRectangle).Children[1] as TText).Text :=
      aDistance.ToString;
    ((layGrille.Children[indice] as TRectangle).Children[2] as TText).Text :=
      dDistance.ToString;
    (layGrille.Children[indice] as TRectangle).Fill.Gradient.Color :=
      TAlphaColorRec.Cyan;
  end
  else
  begin
    unNoeud.position := position;
    ((layGrille.Children[indice] as TRectangle).Children[0] as TLabel)
      .TextSettings.FontColor := TAlphaColorRec.Black;
    if PathFinder.listeNoeudsObstacles.TryGetValue(unNoeud.position, unNoeud)
    then
    begin
      ((layGrille.Children[indice] as TRectangle).Children[0] as TLabel)
        .Text := '';
      (layGrille.Children[indice] as TRectangle).Fill.Gradient.Color := couleur;
    end
    else
    begin
      valeur := dDistance + aDistance;
      if valeur = 0 then
        ((layGrille.Children[indice] as TRectangle).Children[0] as TLabel)
          .Text := ''
      else
        ((layGrille.Children[indice] as TRectangle).Children[0] as TLabel).Text
          := valeur.ToString;
      if aDistance = 0 then
        ((layGrille.Children[indice] as TRectangle).Children[1] as TText)
          .Text := ''
      else
        ((layGrille.Children[indice] as TRectangle).Children[1] as TText).Text
          := aDistance.ToString;
      if dDistance = 0 then
        ((layGrille.Children[indice] as TRectangle).Children[2] as TText)
          .Text := ''
      else
        ((layGrille.Children[indice] as TRectangle).Children[2] as TText).Text
          := dDistance.ToString;
      (layGrille.Children[indice] as TRectangle).Fill.Gradient.Color := couleur;
    end;
  end;
end;

procedure TFormPathfinder.rectangleModeleClick(Sender: TObject);
begin
  celluleClick(Sender);
end;

procedure TFormPathfinder.SpinEditButton1DownClick(Sender: TObject);
begin
  if strtointdef(eNbColonne.Text, 0) > 0 then
    eNbColonne.Text := (strtointdef(eNbColonne.Text, 0) - 1).ToString;
end;

procedure TFormPathfinder.SpinEditButton1UpClick(Sender: TObject);
begin
  if strtointdef(eNbColonne.Text, 0) > 0 then
    eNbColonne.Text := (strtointdef(eNbColonne.Text, 0) + 1).ToString;
end;

procedure TFormPathfinder.SpinEditButton2DownClick(Sender: TObject);
begin
  if strtointdef(eNbLigne.Text, 0) > 0 then
    eNbLigne.Text := (strtointdef(eNbLigne.Text, 0) - 1).ToString;
end;

procedure TFormPathfinder.SpinEditButton2UpClick(Sender: TObject);
begin
  if strtointdef(eNbLigne.Text, 0) > 0 then
    eNbLigne.Text := (strtointdef(eNbLigne.Text, 0) + 1).ToString;
end;

procedure TFormPathfinder.btnTrouverCheminClick(Sender: TObject);
var
  iRectangle: TFMxObject;
  unNoeud: TGBENoeud;
begin
  PathFinder.LargeurGrille := lGrille;
  PathFinder.HauteurGrille := hGrille;
  PathFinder.noeudDepart := noeudDepart;
  PathFinder.noeudArrivee := noeudArrivee;
  PathFinder.QuePremiereEtape := cbPremiereEtape.IsChecked;
  PathFinder.AutoriserDeplacementDiagonal := cbDiagonale.IsChecked;
  if cbModeCout.IsChecked then
    PathFinder.Mode := TGBEPathFinderMode.coutMinimum
  else
    PathFinder.Mode := TGBEPathFinderMode.deplacementsMinimum;

  // Réinitialise les celleules de la grille qui ne sont ni les cases de départ et d'arrivée, ni les obstacles
  for iRectangle in layGrille.Children do
  begin
    unNoeud.position := getPoint(iRectangle.tag);
    if (not(PathFinder.listeNoeudsObstacles.ContainsKey(unNoeud.position))) and
      (not(unNoeud.position = PathFinder.noeudArrivee.position)) and
      (not(unNoeud.position = PathFinder.noeudDepart.position)) then
    begin
      (iRectangle as TRectangle).Fill.Gradient.Color := TAlphaColorRec.White;
      ((iRectangle as TRectangle).Children[0] as TLabel).Text := '';
      ((iRectangle as TRectangle).Children[1] as TText).Text := '';
      ((iRectangle as TRectangle).Children[2] as TText).Text := '';
    end;
  end;

  if PathFinder.RechercherChemin then
  begin
    dessinerResultat; // Si on a trouvé un chemin, on le dessine
  end
  else
    lblInfos.Text := 'No path found';
end;

// Création d'une nouvelle grille
procedure TFormPathfinder.btnCreerGrilleClick(Sender: TObject);
begin
  rectangleModele.parent := fFormPathfinder;
  layGrille.DeleteChildren;
  rectangleModele.parent := layGrille;
  creerGrille;
  initialiserGrille;
end;

// Gestion du clic sur les cellules pour définir ou non la cellule comme obstacle
procedure TFormPathfinder.celluleClick(Sender: TObject);
var
  noeudObstacle: TGBENoeud;
begin
  noeudObstacle.position := getPoint((Sender as TRectangle).tag);
  if PathFinder.listeNoeudsObstacles.ContainsKey(noeudObstacle.position) then
  begin
    PathFinder.listeNoeudsObstacles.Remove(noeudObstacle.position);
    mettreAJourCase(noeudObstacle.position, TAlphaColorRec.White, 0, 0);
  end
  else
  begin
    PathFinder.listeNoeudsObstacles.Add(noeudObstacle.position, noeudObstacle);
    mettreAJourCase(noeudObstacle.position, TAlphaColorRec.Darkslategrey, 0, 0);
  end;
end;

// Permet de récupérer les coordonnées en X et Y d'une cellule de la grille en fonction de son indice
function TFormPathfinder.getPoint(indice: integer): TPoint;
begin
  result.x := indice mod lGrille;
  result.y := indice div lGrille;
end;

// Permet de récupérer l'indice d'une cellule depuis ses coordonnées X et Y
function TFormPathfinder.getIndice(point: TPoint): integer;
begin
  result := point.y * lGrille + point.x;
end;

// Permet de dessiner le chemin trouvé
procedure TFormPathfinder.dessinerResultat;
var
  coutDeplacement: integer;
  point: TPoint;
begin
  coutDeplacement := 0;

  for point in PathFinder.listeChemin.Keys do
  begin
    mettreAJourCase(PathFinder.listeChemin.Items[point].position,
      TAlphaColorRec.Cyan, PathFinder.listeChemin.Items[point].coutDeplacement,
      PathFinder.listeChemin.Items[point].heuristique);
    coutDeplacement := coutDeplacement + PathFinder.listeChemin.Items[point]
      .coutDeplacement;
  end;
  lblInfos.Text := 'The shortest path is represented by the blue boxes' +
    sLineBreak + sLineBreak + 'Move : ' + (PathFinder.listeChemin.Count - 1)
    .ToString + sLineBreak + 'Cost : ' + coutDeplacement.ToString;
end;

end.