unit Aufgabe3_u;
(*) Geschrieben von Benito van der Zander

  Namennotation:
    YYYY_xx
Name  /\  Typ
  Trennzeichen

  Typ:
    x                                          x
  Allgemeine Information:             Genauere Information:
  p:Pointer auf:                       Beliebiegertyo


  b: Booleanwert                       x: Boolean (kann weggelassen werden)
                                       b: ByteBool
                                       l: LongBool
                                       w: WordBool;

  c: Cardinalwert (ohne Vorzeichen)    x: Cardinal (kann weggelassen werden)
                                       b: Byte
                                       w: Word
                                       l: LongWord
  i: Integerwert (mit Vorzeichen)
                                       x: Integer  (kann weggelassen werden)
                                       s: ShortInt
                                       k: SmallInt
                                       l: LongInt
                                       i: Int64

  t: Text                              c: Char
                                       s: String

  k: Komponenten                       p: TPaintBox

  v:VCL-Objekte                        c: TCanvas
                                       b: TBitmap
-----------------------------------------------------------------
  x:Benutzerdefiniert                  zp:TZellenpos;
                                       z:TArrayZelle;
                                       w:TWabe (aaz: array of array of TArrayZelle);
                                       aw:array of TWeg;
                                       azp:array of TZellenpos;
                                       f_file;
(*)

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Menus, ExtCtrls, ImgList, StdCtrls,math;
type TZellenPos=record //Record der die Verbindung zu einer anderen Zelle aufnimmt
  x_i,y_i:integer;     //NummerPosition der anderen Zellen
  bwInfCode_tc:char;   //Wegbuchstabe, der die Richtung beschreibt ('O','W','N');
end;
type TArrayOfTZellenPos=array of TZellenPos;

type TArrayZelle=record //Record der Zelleninformationen aufnimmt
  status_cb:byte;//0: keine aktive Zelle; 1: aktive Zelle
  verbindetmit_xazp:TArrayOfTZellenPos;//Zellen, die von der aktuellen Zelle ausereichbar sind
  verbundenmit_xazp:TArrayOfTZellenPos;//Zellen, von denen aus man die aktuelle Zelle ereichen kann
end;
type TWabe=array of array of TArrayZelle; //Wabe

type TWeg=record //Record der einen gefundenen Weg aufnimmt
  startx_i,starty_i:integer; //Startposition
  weg_ts:string; //BwInf (Bettys wirklich interissanter Fütterungsweg)
end;

type
  TForm1 = class(TForm)
    PaintBox1: TPaintBox;
    MainMenu1: TMainMenu;
    ImageList1: TImageList;
    Programm1: TMenuItem;
    BreitedesFeldes1: TMenuItem;
    HhederWabe1: TMenuItem;
    Berechnen1: TMenuItem;
    Panel1: TPanel;
    Label1: TLabel;
    ListBox1: TListBox;
    Optionen1: TMenuItem;
    AlleBWInfsanzeigen1: TMenuItem;
    Splitter1: TSplitter;
    Wabespeichern1: TMenuItem;
    Wabeladen1: TMenuItem;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    procedure PaintBox1Paint(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure BreitedesFeldes1Click(Sender: TObject);
    procedure HhederWabe1Click(Sender: TObject);
    procedure Berechnen1Click(Sender: TObject);
    procedure ListBox1Click(Sender: TObject);
    procedure AlleBWInfsanzeigen1Click(Sender: TObject);
    procedure Wabespeichern1Click(Sender: TObject);
    procedure Wabeladen1Click(Sender: TObject);
  private
    { Private-Deklarationen}
  public
    { Public-Deklarationen}
    procedure AddVerbindung(vonX_i,vonY_i,zuX_i,zuY_i:integer;bwInfCode_tc:char); //Fügt eine neue Verbindung in das entsporechnende Array
    procedure BerechneVerbindungen; //berechnet alle Verbindungen
    procedure BerechneTeil(wabe_xw:TWabe;posx_i,posy_i,startx_i,starty_i:integer;weg_ts:string;zellen_i:integer); //Berechnet den Weg, ausgehen von eine Zelle
    procedure WM_ERASEBKGND(var mes:Tmessage);message WM_ERASEBKGND;
  end;

var
  Form1: TForm1;
  felder_xw:TWabe;
  wege_xaw:array of TWeg;
  selectedweg_i,anzahl:integer;
implementation

{$R *.DFM}


//--------------------Fügt eine Verbindung zwischen zwei Zellen ein-------------
procedure TForm1.AddVerbindung(vonX_i,vonY_i,zuX_i,zuY_i:integer;bwInfCode_tc:char);
var StartZellenArray_pxazp,ZielZellenArray_pxazp:^TArrayOfTZellenPos;//Arrays der Ziel und Startzellen
    NeueStartZellenVerbindung_pxzp,NeueZielZellenVerbindung_pxzp:^TZellenPos; //Neue Elemente in den Arrays
begin
//Fügt in das Verbundens Array von VonX/VonY die Verbindung von ZuX/ZuY zu VonX/VonY ein
StartZellenArray_pxazp:=@felder_xw[vonX_i,vonY_i].verbindetmit_xazp; //Setzt einen Pointer auf das Startzellenverbindungsarray
setlength(StartZellenArray_pxazp^,length(StartZellenArray_pxazp^)+1); //Setz die Länge des Startzellenverbindungsarray um eins höher
NeueStartZellenVerbindung_pxzp:=@StartZellenArray_pxazp^[high(StartZellenArray_pxazp^)]; //Setzt einen Pointer auf das neue Element im Array
NeueStartZellenVerbindung_pxzp.x_i:=zuX_i; //Setzt beim neuen Element den x Wert
NeueStartZellenVerbindung_pxzp.y_i:=zuY_i; //und den y Wert
NeueStartZellenVerbindung_pxzp.bwInfCode_tc:=bwInfCode_tc; //und den Wegcode

//Fügt in das Verbundens Array von ZuX/ZuY die Verbindung von vonX/vonY zu zuX/zuY ein
ZielZellenArray_pxazp:=@felder_xw[zuX_i,zuY_i].verbundenmit_xazp;//Setzt einen Pointer auf das Zielzellenverbindungsarray
setlength(ZielZellenArray_pxazp^,length(ZielZellenArray_pxazp^ )+1); //Setz die Länge des Zielzellenverbindungsarray um eins höher
NeueZielZellenVerbindung_pxzp:=@ZielZellenArray_pxazp^[high(ZielZellenArray_pxazp^)]; //Setzt einen Pointer auf das neue Element im Array
NeueZielZellenVerbindung_pxzp.x_i:=vonX_i; //Setzt beim neuen Element den x Wert
NeueZielZellenVerbindung_pxzp.y_i:=vonY_i; //und den y Wert
NeueZielZellenVerbindung_pxzp.bwInfCode_tc:=bwInfCode_tc; //und den Wegcode
end;

//-------------Berechnet alle zwischen den Zellen möglichen Verbindungen--------
procedure TForm1.BerechneVerbindungen;
var posx_i,posy_i:integer;
begin
//Für alle Zellen einstelen, das sie von keiner verbunden sind
for posx_i:=0 to high(felder_xw) do
  for posy_i:=0 to high(felder_xw[posx_i]) do
    setlength(felder_xw[posx_i,posy_i].verbundenmit_xazp,0);

//Berechnet die Verbindungen
for posx_i:=0 to high(felder_xw) do
  for posy_i:=0 to high(felder_xw[posx_i]) do begin
    if felder_xw[posx_i,posy_i].status_cb=0 then continue; //Wenn es keine aktive Zelle ist, Schkleife wiederholen
    setlength(felder_xw[posx_i,posy_i].verbindetmit_xazp,0); //Diese Zelle verbindet mit nichts

    //Nördliche Richtung prüfen
    if (posy_i>0)and(felder_xw[posx_i,posy_i-1].status_cb<>0) then //Wenn es nicht die oberste ist und es eine aktiver Zelle ist
      AddVerbindung(posx_i,posy_i,posx_i,posy_i-1,'N'); //Wird die Verbindung hinzugefügt

    //(Süd)westliche Richtung prüfen
    if (posx_i>0)and(posy_i<high(felder_xw[0])) then
      if posx_i mod 2 =0 then begin //Wenn die horizontale Position gerade ist
        if (felder_xw[posx_i-1,posy_i].status_cb<>0) then
          AddVerbindung(posx_i,posy_i,posx_i-1,posy_i,'W'); //muss die vertikale Nummer gleichbleiben
      end else
        if (felder_xw[posx_i-1,posy_i+1].status_cb<>0) then
          AddVerbindung(posx_i,posy_i,posx_i-1,posy_i+1,'W'); //sonst um eins erhöht werden

    //(Süd)östliche Richtung wie oben prüfen
    if (posx_i<high(felder_xw))and(posy_i<high(felder_xw [0])) then
      if posx_i mod 2 =0 then begin
        if (felder_xw [posx_i+1,posy_i].status_cb<>0) then
          AddVerbindung(posx_i,posy_i,posx_i+1,posy_i,'O');
       end else
         if (felder_xw[posx_i+1,posy_i+1].status_cb<>0) then
           AddVerbindung(posx_i,posy_i,posx_i+1,posy_i+1,'O');
  end;
end;

//--------------------------Berechnet die Wege pro Zelle------------------------
procedure TForm1.BerechneTeil(wabe_xw:TWabe;posx_i,posy_i,startx_i,starty_i:integer;weg_ts:string;zellen_i:integer);
var neueWabe_xw:TWabe; //Die veränderte Wabe die im nächsten rekursiven Aufruf übergeben wird
    i_i,i2_i,x_i,y_i:integer; //i: Schleifenvariablen;i2: temporäre Variable; x und y: entweder Schleifenvariablen, oder temporäre Variablen zu aufnahme der Koordinaten
    temp_xzp:TZellenPos; //temporäre Zelle
    DirektVerbindungAn_b:boolean; //Gibt an, ob es eine zwingende Verbindung gibt
    DirektVerbindungsZiel_xzp:TZellenPos; //Gibt das Ziel einer zwingenden Verbindung an
    TempZelle_pxz,AktuelleZelle_pxz:^TArrayZelle; //Pointer auf Zellen aus dem Wabe Array
begin
inc(anzahl);
if Wabe_xw[posx_i,posy_i].status_cb=0 then exit; //Ist die aktuelle Zelle keine aktive, ABBRECHEN

if (length(wege_xaw)>0)and (AlleBWInfsanzeigen1.checked) then abort; //Wenn schon ein Weg gefunden ist, und nur einer gefunden werden muss,ABBRECHEN

neueWabe_xw:=wabe_xw; //Kopiert eine Referenz auf die alte Wabe in die neue
setlength(neuewabe_xw,length(wabe_xw)); //Kopiert die ersten Daten der Refeferenz und löst sie auf
setlength(neuewabe_xw[posx_i],length(neuewabe_xw[0])); //Kopiert die Daten der Referenz, die sie auf die Zeile der ersten Zelle zeigt, und löst sie auf
if posx_i>0 then
  setlength(neuewabe_xw[posx_i-1],length(neuewabe_xw[0])); //Kopiert die Daten der Referenz, die sie auf die Zeile der ersten Zelle zeigt, und löst sie auf
if posx_i<high(neuewabe_xw) then
  setlength(neuewabe_xw[posx_i+1],length(neuewabe_xw[0])); //Kopiert die Daten der Referenz, die sie auf die Zeile der ersten Zelle zeigt, und löst sie auf

AktuelleZelle_pxz:=@neueWabe_xw[posx_i,posy_i]; //Erzeugt einen Pointer, der auf die aktuelle Zelle zeigt

{for i_i:=0 to high(AktuelleZelle_pxz.verbindetmit_xazp) do begin //Läuft alle ereichbaren Zellen durch
  x_i:=AktuelleZelle_pxz.verbindetmit_xazp[i_i].x_i; //Merkt sie die Zeile, in der diese ereichbare Zelle ist
  if x_i<>posx_i then //Wenn diese Zeile ungleich der Zeile der aktuellen Position ist
     setlength(neuewabe_xw[x_i],length(neuewabe_xw[0])); //Werden die Daten der Referenz auf die Zelle kopiert und die Referenz aufgelöst
end;
 }
if zellen_i<=1 then begin //Wenn es die letzte Zelle in einem Weg ist, wird die der Weg gespeichert
{  for i_i:=0 to high(wege_xaw) do
    if (wege_xaw[i_i].weg_ts=weg_ts)and(wege_xaw[i_i].startx_i=startx_i)and(wege_xaw[i_i].starty_i=starty_i) then
      exit;                                }
  setlength(wege_xaw,length(wege_xaw)+1);
  wege_xaw[high(wege_xaw)].startx_i:=startx_i;
  wege_xaw[high(wege_xaw)].starty_i:=starty_i;
  wege_xaw[high(wege_xaw)].weg_ts:=weg_ts;
  label1.Caption:='Gefundene Wege ('+IntToStr(length(wege_xaw))+') :';
  Application.ProcessMessages;
  exit; //und die Prozedure ABGEBROCHEN
end;
AktuelleZelle_pxz.status_cb:=0; //Aktuelle Zelle ist jetzt nicht mehr aktiv

for i_i:=0 to high(AktuelleZelle_pxz.verbundenmit_xazp) do begin //Durchläuft das Verbindungsarray
  //Setzt einen Pointer auf die Zelle
  TempZelle_pxz:=@neuewabe_xw[AktuelleZelle_pxz.verbundenmit_xazp[i_i].x_i,AktuelleZelle_pxz.verbundenmit_xazp[i_i].y_i];
  for i2_i:=0 to high(TempZelle_pxz.verbindetmit_xazp) do begin //Durchläuft das Verbindungsarray der verbundenen Zelle
    if (TempZelle_pxz.verbindetmit_xazp[i2_i].x_i=posx_i)and(TempZelle_pxz.verbindetmit_xazp[i2_i].y_i=posy_i) then begin
        x_i:=high(TempZelle_pxz.verbindetmit_xazp); //Holt sich den index des letzten Element der Verbindungen
        if x_i >0 then //Wenn das letzte Element nicht das erste ist
          temp_xzp:=TempZelle_pxz.verbindetmit_xazp[x_i]; //wird es geholt
        SetLength(TempZelle_pxz.verbindetmit_xazp,x_i); //Setz die Länge auf den Index des letzten Elements, um es abzuschneiden
        if x_i >i2_i then //Wenn i2_i noch im Array ist
          TempZelle_pxz.verbindetmit_xazp[i2_i]:=temp_xzp; //wird es mit dem letzten Element überschrieben
        break;
    end;
  end;
end;

DirektVerbindungAn_b:=false; //Es ist keine Verbindung erzwungen
for x_i:=max(0,posx_i-1) to min(high(neueWabe_xw),posx_i+1) do //Durchsucht die Zeilen in einem 3 Raster um die aktuelle Zeile
  for y_i:=max(0,posy_i-1) to min(high(neueWabe_xw[x_i]),posy_i+1) do begin //dasselbe mit den Spalten
    if (neueWabe_xw[x_i,y_i].status_cb=0) then continue; //Ist die Zelle nicht aktiv wird die Verarbeitung mit neuem Wert fortgesetz
    if (x_i=posx_i)and(y_i=posy_i) then continue; // das selbe wenn die Zelle die aktuelle ist

    TempZelle_pxz:=@neuewabe_xw[x_i,y_i]; //Setzt einen Pointer auf die Zelle
    if (length(TempZelle_pxz.verbundenmit_xazp)<=0) then //Ist die Zelle mit keiner anderen verbunden
      exit; //wird die Prozedur ABGEBROCHEN
    if (length(TempZelle_pxz.verbindetmit_xazp)<=0)and(zellen_i>3) then //Führt die Zelle zu keiner anderen und es gibt noch mehrere aktive Zellen
      exit; //wird die Prozedur ABGEBROCHEN

    for i_i:=0 to high(TempZelle_pxz.verbundenmit_xazp) do //Durch läuft Verbindungen von anderen Zellen zu ihr
      if (TempZelle_pxz.verbundenmit_xazp[i_i].x_i=posx_i)and(TempZelle_pxz.verbundenmit_xazp[i_i].y_i=posy_i) then begin //Ist die aktueele Zelle mit iht verbunden
        i2_i:=high(TempZelle_pxz.verbundenmit_xazp); //Holt sich den index des letzten Element der Verbindungen
        if i2_i >0 then //Wenn das letzte Element nicht das erste ist
          temp_xzp:=TempZelle_pxz.verbundenmit_xazp[i2_i]; //wird es geholt
        SetLength(TempZelle_pxz.verbundenmit_xazp,i2_i); //Setz die Länge auf den Index des letzten Elements, um es abzuschneiden
        if i2_i >i_i then //Wenn i_i noch im Array ist
          TempZelle_pxz.verbundenmit_xazp[i_i]:=temp_xzp; //wird es mit dem letzten Element überschrieben
        if i2_i=0 then begin //Wenn die Länge gleich null ist, muss der nächste Wegabschnitt mit dieser Zelle anfangen
          if DirektVerbindungAn_b then //Wenn bereits so ein Zwang besteht
            exit; //wird die Prozedure ABGEBROCHEN

          DirektVerbindungAn_b:=true; //Zwang einschalten
          DirektVerbindungsZiel_xzp.x_i:=x_i; //Ziel festlegen
          DirektVerbindungsZiel_xzp.y_i:=y_i; // "      "
          if x_i<posx_i then //Wenn das Ziel links ist
             DirektVerbindungsZiel_xzp.bwInfCode_tc:='W' //ist die Richtung Westen
          else if x_i>posx_i then //ist es rechts
            DirektVerbindungsZiel_xzp.bwInfCode_tc:='O' //ist die Richtung osten
          else if y_i<posy_i then //oben
            DirektVerbindungsZiel_xzp.bwInfCode_tc:='N'; //Norden
        end;
        break; //innen Schleife abbrechen
      end;
  end;

if DirektVerbindungAn_b then begin //Besteht ein Zwang
  //Zum Ziel gehen
  BerechneTeil(neuewabe_xw,DirektVerbindungsZiel_xzp.x_i,DirektVerbindungsZiel_xzp.y_i,startx_i,starty_i,weg_ts+DirektVerbindungsZiel_xzp.bwInfCode_tc,zellen_i-1);
  exit; //Prozedur ABRECHEN
end;

//Besteht kein Zwang
for i_i:=0 to high(AktuelleZelle_pxz.verbindetmit_xazp) do begin //Wird das ganze Verbindungsarray durchlaufen
  x_i:=AktuelleZelle_pxz.verbindetmit_xazp[i_i].x_i; //Nimmt die X
  y_i:=AktuelleZelle_pxz.verbindetmit_xazp[i_i].y_i; //und Y Koordinaten auf
{  if neueWabe_xw[x_i,y_i].status_cb=0 then
    showmessage('');     }
  if (zellen_i<=2) or ( length(neueWabe_xw[x_i,y_i].verbindetmit_xazp)>0) then //Gibt es nur wenige Zellen, oder kommt man von der neuen Zelle zu anderen
    BerechneTeil(neuewabe_xw,x_i,y_i,startx_i,starty_i,weg_ts+neueWabe_xw[posx_i,posy_i].verbindetmit_xazp[i_i].bwInfCode_tc,zellen_i-1); //wird zu ihr gegangen
end;
end;                                                                                                                         

//-------------------------Startet das Berechnet der BWInfs---------------------
procedure TForm1.Berechnen1Click(Sender: TObject);
var x_i,y_i,i_i,zellen_i:integer; //x,y,i: Forschleifen variablen; Die Anzahl der Waben
    counter:cardinal;
begin
anzahl:=0;
counter:=GetTickCount;
selectedweg_i:=-1; //Aktiven Weg auf null setzen
ListBox1.Clear;//Anzeige löschen
SetLength(wege_xaw,0); //Gefundene Wege löschen
BerechneVerbindungen; //Berechnet die verbindungen zwioschen den Zellen

zellen_i:=0; //Anzahl der Zelln mit 0 initialiezieren
for x_i:=0 to high(felder_xw) do //Durchläuft die Wabe
  for y_i:=0 to high(felder_xw[x_i]) do
    if felder_xw[x_i,y_i].status_cb=1 then //Wenn die Zelle aktiv ist,
      inc(zellen_i); //wird der counter erhöht.
try
  for x_i:=0 to high(felder_xw) do //Durchläuft nochmals die Zellen
    for y_i:=0 to high(felder_xw[x_i]) do begin
      if (felder_xw[x_i,y_i].status_cb=1)and(length(felder_xw[x_i,y_i].verbundenmit_xazp)=0) then begin//Wenn eine Zelle von keiner anderen aus, zu erreichen ist
        BerechneTeil(felder_xw,x_i,y_i,x_i,y_i,'',zellen_i); //wird sie als Startzelle genommen
        abort;
      end;
    end;
  if length(wege_xaw)=0 then  begin //wurde kein Weg gefunden
    for x_i:=0 to high(felder_xw) do //werden nach einander
      for y_i:=0 to high(felder_xw[x_i]) do begin
        if felder_xw[x_i,y_i].status_cb=1 then //alle aktiven Zellen
          BerechneTeil(felder_xw,x_i,y_i,x_i,y_i,'',zellen_i); //als Startzellen genommen
      end;
  end;
finally
  PaintBox1.Refresh; //Update der Darstellung
  case high(wege_xaw) of //Update der Weganzeige
   -1:  begin ListBox1.Items.Add('(kein Weg gefunden)');Label1.Caption:='(kein Weg gefunden)';end;
   -0:  Label1.Caption:='Gefundener Weg';
   else label1.Caption:='Gefundene Wege ('+IntToStr(length(wege_xaw))+') :';

  end;
  for i_i:=0 to high(wege_xaw) do
    ListBox1.Items.Add('Startposition: X: '+IntToStr(wege_xaw[i_i].startx_i)+' Y: '+IntToStr(wege_xaw[i_i].starty_i)+ ' BWInf: '+wege_xaw[i_i].weg_ts);
  showmessage(INtToStr(GetTickCount-counter));
  showmessage(INtToStr(anzahl));
end;
end;

//------------------------------Stellt die Wabe dar-----------------------------
procedure TForm1.PaintBox1Paint(Sender: TObject);
var x_i,y_i,i_i:integer; //Schleifenvariablen
    bitmap_vb:Tbitmap; //Bild für Doppelbuffer
begin
//Bild erzeugen
bitmap_vb:=TBitmap.Create;
bitmap_vb.Width:=PaintBox1.Width;
bitmap_vb.Height:=PaintBox1.Height;
try
  //Bildhintergrund iniitialiesieren
  bitmap_vb.Canvas.brush.Color:=clBtnFace;
  bitmap_vb.Canvas.Rectangle(0,0,PaintBox1.Width,PaintBox1.Height);

  //Durch läuft die gesamte Wabe
  for x_i:=0 to high(felder_xw) do
    for y_i:=0 to high(felder_xw[x_i]) do begin
      if felder_xw[x_i,y_i].status_cb=0 then //Wenn die Wabe aktiv ist, wird
        ImageList1.draw(bitmap_vb.Canvas,x_i*23,y_i*30+(x_i mod 2)*15,1) //ein mit Honig gefüllte Zelle ausgegeben
       else
        ImageList1.draw(bitmap_vb.Canvas,x_i*23,y_i*30+(x_i mod 2)*15,0); //sonst eine alte, zerfallene
    end;

  //Zeichnet den markierten Weg
  if selectedweg_i<>-1 then begin //Wenn einer markiert ist
    x_i:=wege_xaw[selectedweg_i].startx_i*23+15; //Startpositio ermitteln (X)
    y_i:=wege_xaw[selectedweg_i].starty_i*30+15+(wege_xaw[selectedweg_i].startx_i mod 2)*15; //Y
    bitmap_vb.Canvas.MoveTo(x_i,y_i); //Bewegt den Malcursor zu startpoisition
    for i_i:=1 to length(wege_xaw[selectedweg_i].weg_ts) do //Läuft den gesamten weg durch
      case wege_xaw[selectedweg_i].weg_ts[i_i] of //und zeichnet eine Linie in die entsprechende Richtung
        'N':begin y_i:=y_i-30; bitmap_vb.Canvas.LineTo(x_i,y_i); end;
        'O':begin x_i:=x_i+23; y_i:=y_i+15; bitmap_vb.Canvas.LineTo(x_i,y_i); end;
        'W':begin x_i:=x_i-23; y_i:=y_i+15; bitmap_vb.Canvas.LineTo(x_i,y_i); end;
      end;

    case wege_xaw[selectedweg_i].weg_ts [length(wege_xaw[selectedweg_i].weg_ts)] of
      'N': ImageList1.draw(bitmap_vb.Canvas,x_i-15,y_i-10,2); //Fügt einen Pfeil nach Norden
      'O': ImageList1.draw(bitmap_vb.Canvas,x_i-16,y_i-16,3); //nach Osten
      'W': ImageList1.draw(bitmap_vb.Canvas,x_i-14,y_i-16,4); //nach Westen
    end; //ein

    //Startposition ermitteln
    x_i:=wege_xaw[selectedweg_i].startx_i*23+15; //X
    y_i:=wege_xaw[selectedweg_i].starty_i*30+15+(wege_xaw[selectedweg_i].startx_i mod 2)*15; //Y

    //Zeichnet einen roten Kreis um die Startpoisition
    bitmap_vb.Canvas.brush.Color:=clRed;
    bitmap_vb.Canvas.Ellipse(x_i-5,y_i-5,x_i+5,y_i+5);
  end;
  PaintBox1.Canvas.Draw(0,0,bitmap_vb); //Stellt das gezeichnete dar
finally
  bitmap_vb.free; //Speicherplatz freigeben
end;
end;

//---------------------------Markiert einen Weg---------------------------------
procedure TForm1.ListBox1Click(Sender: TObject);
begin
if ListBox1.Items[0][1]<>'(' then //ist ein Weg gefunden
  selectedweg_i:=ListBox1.ItemIndex //Ihn als markiert markieren
 else
  selectedweg_i:=-1; //sonst auf -1 setzten
PaintBox1.Refresh;
end;

//-----------------------------Editiert die Wabe--------------------------------
procedure TForm1.PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var ZelleX_i,ZelleY_i:integer; //Variablen, die die gewählte Zelle aufnehmen
begin
ZelleX_i:=x div 23; //X Nummer ermitteln
ZelleY_i:=(y-(ZelleX_i mod 2)*15) div 30; //Y Nummer ermitteln
if (ZelleX_i>high(felder_xw))or(ZelleY_i>high(felder_xw[0])) then //Wenn die Zell im ungültigen Bereich sind
  exit; //wird abgebrochen
felder_xw[ZelleX_i,ZelleY_i].status_cb:= (felder_xw [ZelleX_i,ZelleY_i].status_cb+1)mod 2; //Umschalten der Zellenaktivität
PaintBox1.Refresh; //Updatetn der Darstellung
end;

//-------------------------Stellt die Wabenbreite ein---------------------------
procedure TForm1.BreitedesFeldes1Click(Sender: TObject);
var Breite_ts:string;
begin
Breite_ts:=IntToStr(Length(felder_xw)); //Aktuelle Breite
if InputQuery('Bundeswettbewerb Informatik Aufgabe 3','Bitte geben sie die Breite für die Wabe an (in Zellen):',Breite_ts) then //Fragt nach der Breite
if Breite_ts='0' then begin //Wenn gewünschte Breite zu klein ist
  showmessage('Zu klein'); //nach ausgeben eines Hinweises
  exit; //abbrechen
end;

setlength(felder_xw,StrToInt(Breite_ts),length(felder_xw[0])); //Setzten der Breite der Wabe
end;

//--------------------------Stellt die Wabenhöhe ein----------------------------
procedure TForm1.HhederWabe1Click(Sender: TObject);
var Hoehe_ts:string;
begin
Hoehe_ts:=IntToStr(Length(felder_xw[0]));//Aktuelle Höhe
if InputQuery('Bundeswettbewerb Informatik Aufgabe 3','Bitte geben sie die Breite für die Wabe an (in Zellen):',Hoehe_ts) then //Fragt nach der Höhe
if Hoehe_ts='0' then begin //Ist die gewünschte Höhe zu klein
  showmessage('Zu klein'); //wird nach ausgegeben eines Hinweisen
  exit; //die Prozedur abgebrochen
end;

setlength(felder_xw,length(felder_xw),StrToInt(Hoehe_ts)); //Setzten der Höhe
end;


//-----------------------Speichert eine Wabe auf Festplatte---------------------
procedure TForm1.Wabespeichern1Click(Sender: TObject);
var datei_xf:file;
    x_i,y_i:integer;
    groese_c:cardinal;
begin
if SaveDialog1.Execute then begin //Öffnet den SaveDialog
  if pos('.',savedialog1.filename) <=0 then SaveDialog1.FileName:=SaveDialog1.FileName+'.bbw';
  assignfile(datei_xf,savedialog1.filename);
  Rewrite(datei_xf,1); //Überschreibt die gewählte Datei
  groese_c:=length(felder_xw);
  BlockWrite(datei_xf,groese_c,sizeof(groese_c)); //Schreibt die Breite
  groese_c:=length(felder_xw[0]);
  BlockWrite(datei_xf,groese_c,sizeof(groese_c)); //und die Höhe der Waben
  for x_i:=0 to high(felder_xw) do
    for y_i:=0 to high(felder_xw[x_i]) do begin
      BlockWrite(datei_xf,felder_xw[x_i,y_i].status_cb,sizeof(felder_xw[x_i,y_i].status_cb)); //Schreibt den Zustand jeder Zelle
    end;
  CloseFile(datei_xf); //Schließt die Datei
end;

end;

//--------------------------Läd eine Wabe vonn Festplatte-----------------------
procedure TForm1.Wabeladen1Click(Sender: TObject);
var datei_xf:file;
    x_i,y_i:integer;
    groese,groese2:cardinal;
begin
if OpenDialog1.Execute then begin //Öffnet den OpenDialog
  assignfile(datei_xf,opendialog1.filename);
  Reset(datei_xf,1); //Öffnet die gewählte Datei
  BlockRead(datei_xf,groese,sizeof(groese)); //Liest die Breite und die
  BlockRead(datei_xf,groese2,sizeof(groese2)); //Höhe der Wabe
  setlength(felder_xw,groese,groese2); //und setzt sie
  for x_i:=0 to high(felder_xw) do
    for y_i:=0 to high(felder_xw[x_i]) do begin
      BlockRead(datei_xf,felder_xw[x_i,y_i].status_cb,sizeof(felder_xw[x_i,y_i].status_cb)); //Liest und setzt den Zustand jeder Zelle
    end;
  CloseFile(datei_xf);
end;
end;

//----------------------------Schaltet ein MenuItem um--------------------------
procedure TForm1.AlleBWInfsanzeigen1Click(Sender: TObject);
begin
AlleBWInfsanzeigen1.checked:=not AlleBWInfsanzeigen1.checked;
end;

//------------verhindert das störende Flackern des Hintergundes----------------
procedure TForm1.WM_ERASEBKGND(var mes:Tmessage);
begin
  mes.Result:=1;
end;
//--------------------------Iniitizialiesiert die Variablen---------------------
procedure TForm1.FormCreate(Sender: TObject);
begin
//Iniitizialiesieren
setlength(felder_xw,16,13); //der Wabengröße
selectedweg_i:=-1; //des Weges
end;

end.

