From 807650c731c1b9e95aff3e1e4168bdfad51aa397 Mon Sep 17 00:00:00 2001 From: Joe Care Date: Fri, 26 Dec 2025 09:10:57 +0100 Subject: [PATCH] Common --- Diverses/FPC/PrjLaby4.lpi | 4 +- Diverses/FPC/PrjLaby4b.lpi | 7 +- Diverses/Source/Labyrinth/frm_laby4b.lfm | 12 +- Diverses/Source/Labyrinth/frm_laby4b.pas | 465 +++++++++++----------- Diverses/Source/Labyrinth/unt_Point2d.pas | 14 +- 5 files changed, 249 insertions(+), 253 deletions(-) diff --git a/Diverses/FPC/PrjLaby4.lpi b/Diverses/FPC/PrjLaby4.lpi index cd8aba38..d73d8085 100644 --- a/Diverses/FPC/PrjLaby4.lpi +++ b/Diverses/FPC/PrjLaby4.lpi @@ -1,16 +1,16 @@ - + + - <UseAppBundle Value="False"/> <ResourceType Value="res"/> diff --git a/Diverses/FPC/PrjLaby4b.lpi b/Diverses/FPC/PrjLaby4b.lpi index 3b62f575..c8f8abfc 100644 --- a/Diverses/FPC/PrjLaby4b.lpi +++ b/Diverses/FPC/PrjLaby4b.lpi @@ -1,16 +1,16 @@ <?xml version="1.0" encoding="UTF-8"?> <CONFIG> <ProjectOptions> - <Version Value="11"/> + <Version Value="12"/> <PathDelim Value="\"/> <General> <Flags> <MainUnitHasUsesSectionForAllUnits Value="False"/> <MainUnitHasCreateFormStatements Value="False"/> <MainUnitHasTitleStatement Value="False"/> + <CompatibilityMode Value="True"/> </Flags> <SessionStorage Value="InProjectDir"/> - <MainUnit Value="0"/> <Title Value="PrjLaby4b"/> <UseAppBundle Value="False"/> <ResourceType Value="res"/> @@ -250,6 +250,9 @@ <SmartLinkUnit Value="True"/> </CodeGeneration> <Linking> + <Debugging> + <DebugInfoType Value="dsDwarf3"/> + </Debugging> <LinkSmart Value="True"/> <Options> <Win32> diff --git a/Diverses/Source/Labyrinth/frm_laby4b.lfm b/Diverses/Source/Labyrinth/frm_laby4b.lfm index ef9be905..46fa86ab 100644 --- a/Diverses/Source/Labyrinth/frm_laby4b.lfm +++ b/Diverses/Source/Labyrinth/frm_laby4b.lfm @@ -10,9 +10,9 @@ object FrmLaby4: TFrmLaby4 Font.Color = clWindowText Font.Height = -11 Font.Name = 'Tahoma' + LCLVersion = '4.2.0.0' OnCreate = FormCreate OnDestroy = FormDestroy - LCLVersion = '2.0.10.0' object pbxResult: TPaintBox Left = 0 Height = 771 @@ -28,6 +28,7 @@ object FrmLaby4: TFrmLaby4 Align = alRight ClientHeight = 771 ClientWidth = 107 + ParentBackground = False TabOrder = 0 object pbxPreview: TPaintBox Left = 1 @@ -45,6 +46,7 @@ object FrmLaby4: TFrmLaby4 Align = alClient ClientHeight = 528 ClientWidth = 105 + ParentBackground = False TabOrder = 0 object btnGenerate: TBitBtn Left = 15 @@ -52,8 +54,8 @@ object FrmLaby4: TFrmLaby4 Top = 56 Width = 75 Caption = 'Generate' - OnClick = btnGenerateClick TabOrder = 1 + OnClick = btnGenerateClick end object btnDraw: TBitBtn Left = 16 @@ -61,8 +63,8 @@ object FrmLaby4: TFrmLaby4 Top = 88 Width = 75 Caption = 'Draw' - OnClick = btnDrawClick TabOrder = 2 + OnClick = btnDrawClick end object btnPrint: TBitBtn Left = 15 @@ -70,8 +72,8 @@ object FrmLaby4: TFrmLaby4 Top = 120 Width = 75 Caption = 'Print' - OnClick = btnPrintClick TabOrder = 3 + OnClick = btnPrintClick end object edtLabySize: TSpinEdit Left = 15 @@ -81,9 +83,9 @@ object FrmLaby4: TFrmLaby4 Increment = 5 MaxValue = 80 MinValue = 8 - OnChange = edtLabySizeChange TabOrder = 0 Value = 21 + OnChange = edtLabySizeChange end object lblLabySize: TLabel Left = 15 diff --git a/Diverses/Source/Labyrinth/frm_laby4b.pas b/Diverses/Source/Labyrinth/frm_laby4b.pas index 0e165879..b41acfaf 100644 --- a/Diverses/Source/Labyrinth/frm_laby4b.pas +++ b/Diverses/Source/Labyrinth/frm_laby4b.pas @@ -37,57 +37,57 @@ interface uses -{$IFnDEF FPC} - Windows, -{$ELSE} + {$IFnDEF FPC} + Windows, + {$ELSE} LCLIntf, LCLType, -{$ENDIF} - SysUtils, Variants, Classes, Graphics, Controls, Forms, - Dialogs, ExtCtrls, Buttons, StdCtrls, Spin, PrintersDlgs, unt_Laby4; + {$ENDIF} + SysUtils, Variants, Classes, Graphics, Controls, Forms, + Dialogs, ExtCtrls, Buttons, StdCtrls, Spin, PrintersDlgs, unt_Laby4; type { TFrmLaby4 Formular mit UI zur Steuerung der Labyrinth-Generierung und -Darstellung. } - TFrmLaby4 = class(TForm) - btnPrint: TBitBtn; // Startet Druckdialog und druckt die3D-Ansicht - btnGenerate: TBitBtn; // Generiert ein neues Höhenlabyrinth - btnDraw: TBitBtn; // Zeichnet die isometrische Darstellung (3D) - lblLabySize: TLabel; // Beschriftung für die Größe - pbxResult: TPaintBox; // Zeichenfläche für isometrische Darstellung - pbxPreview: TPaintBox; // Zeichenfläche für Raster-Vorschau (2D) - pnlRight: TPanel; // Seitenpanel (Layout) - pnlRightCl2: TPanel; // Unterpanel (Layout) - PrintDialog1: TPrintDialog; // Druckdialog - edtLabySize: TSpinEdit; // Eingabefeld für Labyrinth-Kantenlänge - procedure btnGenerateClick(Sender: TObject); // Generiert Feld und aktualisiert Preview - procedure btnDrawClick(Sender: TObject); // Zeichnet3D-Sicht - procedure btnPrintClick(Sender: TObject); // Druckt3D-Sicht - procedure FormCreate(Sender: TObject); // Initialisiert FHLaby/Defaultwerte - procedure FormDestroy(Sender: TObject); // Gibt Ressourcen frei - procedure pbxPreviewPaint(Sender: TObject); // Re-Render der Preview bei Paint - procedure edtLabySizeChange(Sender: TObject);// Änderung der Kantenlänge/Skalierung - private - FHLaby: THeightLaby; // Kernmodell für Höhenlabyrinth - Clen :integer; // Kantenlänge (Anzahl Zellen pro Seite) - FMargin: Integer; // (aktuell) ungenutzter Rand für pbxResult - lastCell: TPoint; // Letztveränderte Zelle (für Debug-Update) - { Zeichnet eine einzelne Zelle in der2D-Preview in Farbe abhängig von Höhe. } - procedure Drawbox(Canvas: TCanvas; x, y, z: integer; DrawHead: boolean); - { Ereignis-Handler (Debug): wird bei Zell-Updates während `Generate` aufgerufen. } - procedure LabyUpdateCell(Sender: TObject; Cell: TPoint); - { Malt eine Zelle (x,y) im Preview. `mark=true` hebt die Zelle farblich hervor. } - procedure PaintField(x, y: integer; mark: boolean = False); - { Malt das gesamte Preview-Feld entsprechend aktueller `FHLaby`-Daten. } - procedure UpdateGField; - { Private-Deklarationen } - public - { Public-Deklarationen } - end; + TFrmLaby4 = class(TForm) + btnPrint :TBitBtn; // Startet Druckdialog und druckt die3D-Ansicht + btnGenerate :TBitBtn; // Generiert ein neues Höhenlabyrinth + btnDraw :TBitBtn; // Zeichnet die isometrische Darstellung (3D) + lblLabySize :TLabel; // Beschriftung für die Größe + pbxResult :TPaintBox; // Zeichenfläche für isometrische Darstellung + pbxPreview :TPaintBox; // Zeichenfläche für Raster-Vorschau (2D) + pnlRight :TPanel; // Seitenpanel (Layout) + pnlRightCl2 :TPanel; // Unterpanel (Layout) + PrintDialog1 :TPrintDialog; // Druckdialog + edtLabySize :TSpinEdit; // Eingabefeld für Labyrinth-Kantenlänge + procedure btnGenerateClick(Sender :TObject); // Generiert Feld und aktualisiert Preview + procedure btnDrawClick(Sender :TObject); // Zeichnet3D-Sicht + procedure btnPrintClick(Sender :TObject); // Druckt3D-Sicht + procedure FormCreate(Sender :TObject); // Initialisiert FHLaby/Defaultwerte + procedure FormDestroy(Sender :TObject); // Gibt Ressourcen frei + procedure pbxPreviewPaint(Sender :TObject); // Re-Render der Preview bei Paint + procedure edtLabySizeChange(Sender :TObject);// Änderung der Kantenlänge/Skalierung + private + FHLaby :THeightLaby; // Kernmodell für Höhenlabyrinth + Clen :integer; // Kantenlänge (Anzahl Zellen pro Seite) + FMargin :integer; // (aktuell) ungenutzter Rand für pbxResult + lastCell :TPoint; // Letztveränderte Zelle (für Debug-Update) + { Zeichnet eine einzelne Zelle in der2D-Preview in Farbe abhängig von Höhe. } + procedure Drawbox(Canvas :TCanvas; x, y, z :integer; DrawHead :boolean); + { Ereignis-Handler (Debug): wird bei Zell-Updates während `Generate` aufgerufen. } + procedure LabyUpdateCell(Sender :TObject; Cell :TPoint); + { Malt eine Zelle (x,y) im Preview. `mark=true` hebt die Zelle farblich hervor. } + procedure PaintField(x, y :integer; mark :boolean = False); + { Malt das gesamte Preview-Feld entsprechend aktueller `FHLaby`-Daten. } + procedure UpdateGField; + { Private-Deklarationen } + public + { Public-Deklarationen } + end; var - FrmLaby4: TFrmLaby4; + FrmLaby4 :TFrmLaby4; @@ -95,15 +95,15 @@ implementation uses unt_Point2d, Printers; -{$IFnDEF FPC} - {$R *.lfm} + {$IFnDEF FPC} + {$R *.lfm} -{$ELSE} + {$ELSE} {$R *.lfm} -{$ENDIF} + {$ENDIF} const - c:integer =3; // Basisskalierung pro Zelle in der Preview (Pixelhalbkanten) + c :integer = 3; // Basisskalierung pro Zelle in der Preview (Pixelhalbkanten) {------------------------------------------------------------------------------ PaintField @@ -112,48 +112,45 @@ implementation zu linken/unteren Nachbarn mit geringer Höhendifferenz (<2) als weiße Linien eingezeichnet, um gangbare Übergänge zu visualisieren. ------------------------------------------------------------------------------} -procedure TFrmLaby4.PaintField(x, y: integer; mark: boolean = False); +procedure TFrmLaby4.PaintField(x, y :integer; mark :boolean = False); var - yy, xx: integer; + yy, xx :integer; begin - with pbxPreview do - begin - // Farbgebung: stärkerer Blauanteil; bei markierter Zelle mehr Rot - if mark then - Canvas.Brush.Color := - rgb(63 + (FHLaby[x, y] *192) div (Clen *2 +5), -0 + (FHLaby[x, y] *192) div (Clen *2 +5), - (FHLaby[x, y] *192) div (Clen *2 +5)) - else - Canvas.Brush.Color := - rgb((FHLaby[x, y] *196) div (Clen *2 +5), - (FHLaby[x, y] *196) div (Clen *2 +5), - (FHLaby[x, y] *255) div (Clen *2 +5)); - - // Umrechnung Koordinaten: Preview ist gespiegelt/gedreht - yy := clen - y -1; - xx := clen - x -1; - - // Zellen-Rechteck füllen - Canvas.FillRect(Rect(xx * c *2, yy * c *2, (xx +1) * - c *2, (yy +1) * c *2)); - - // Kanten zeichnen, wenn Nachbar in x-Richtung ähnliche Höhe hat - if (x >=1) and (abs(FHLaby[x, y] - FHLaby[x -1, y]) <2) then - begin - Canvas.pen.Color := clwhite; - Canvas.moveto(xx * c *2 + c, yy * c *2 + c); - Canvas.Lineto(xx * c *2 + c *3, yy * c *2 + c); - - end; - // Kanten zeichnen, wenn Nachbar in y-Richtung ähnliche Höhe hat - if (y >=1) and (abs(FHLaby[x, y] - FHLaby[x, y -1]) <2) then - begin - Canvas.pen.Color := clwhite; - Canvas.moveto(xx * c *2 + c, yy * c *2 + c); - Canvas.Lineto(xx * c *2 + c, yy * c *2 + c *3); - end; - end; + with pbxPreview do + begin + // Farbgebung: stärkerer Blauanteil; bei markierter Zelle mehr Rot + if mark then + Canvas.Brush.Color := + rgb(63 + (FHLaby[x, y] * 192) div (Clen * 2 + 5), 0 + (FHLaby[x, y] * 192) div + (Clen * 2 + 5), (FHLaby[x, y] * 192) div (Clen * 2 + 5)) + else + Canvas.Brush.Color := + rgb((FHLaby[x, y] * 196) div (Clen * 2 + 5), (FHLaby[x, y] * 196) div + (Clen * 2 + 5), (FHLaby[x, y] * 255) div (Clen * 2 + 5)); + + // Umrechnung Koordinaten: Preview ist gespiegelt/gedreht + yy := clen - y - 1; + xx := clen - x - 1; + + // Zellen-Rechteck füllen + Canvas.FillRect(Rect(xx * c * 2, yy * c * 2, (xx + 1) * c * 2, (yy + 1) * c * 2)); + + // Kanten zeichnen, wenn Nachbar in x-Richtung ähnliche Höhe hat + if (x >= 1) and (abs(FHLaby[x, y] - FHLaby[x - 1, y]) < 2) then + begin + Canvas.pen.Color := clwhite; + Canvas.moveto(xx * c * 2 + c, yy * c * 2 + c); + Canvas.Lineto(xx * c * 2 + c * 3, yy * c * 2 + c); + + end; + // Kanten zeichnen, wenn Nachbar in y-Richtung ähnliche Höhe hat + if (y >= 1) and (abs(FHLaby[x, y] - FHLaby[x, y - 1]) < 2) then + begin + Canvas.pen.Color := clwhite; + Canvas.moveto(xx * c * 2 + c, yy * c * 2 + c); + Canvas.Lineto(xx * c * 2 + c, yy * c * 2 + c * 3); + end; + end; end; {------------------------------------------------------------------------------ @@ -163,12 +160,12 @@ procedure TFrmLaby4.PaintField(x, y: integer; mark: boolean = False); ------------------------------------------------------------------------------} procedure TFrmLaby4.UpdateGField; var - y: integer; - x: integer; + y :integer; + x :integer; begin - for x :=0 to FHLaby.Dimension.Width -1 do - for y :=0 to FHLaby.Dimension.Height -1 do - PaintField(x, y); + for x := 0 to FHLaby.Dimension.Width - 1 do + for y := 0 to FHLaby.Dimension.Height - 1 do + PaintField(x, y); end; {------------------------------------------------------------------------------ @@ -178,19 +175,18 @@ procedure TFrmLaby4.UpdateGField; wird `OnUpdateCell` auf `LabyUpdateCell` gesetzt, um schrittweise Updates anzuzeigen. ------------------------------------------------------------------------------} -procedure TFrmLaby4.btnGenerateClick(Sender: TObject); - +procedure TFrmLaby4.btnGenerateClick(Sender :TObject); begin - pnlRight.Width := CLen * c *2 +2; // Layout anpassen - pbxPreview.Width := CLen * c *2; - FHLaby.Dimension := rect(0,0, Clen, Clen); - pbxPreview.Height := CLen * c *2; - Application.ProcessMessages; -{$ifdef DEBUG} + pnlRight.Width := CLen * c * 2 + 2; // Layout anpassen + pbxPreview.Width := CLen * c * 2; + FHLaby.Dimension := rect(0, 0, Clen, Clen); + pbxPreview.Height := CLen * c * 2; + Application.ProcessMessages; + {$ifdef DEBUG} FHLaby.OnUpdateCell:=LabyUpdateCell; // Live-Updates beim Generieren -{$endif } - FHLaby.Generate; // Labyrinth erzeugen - UpdateGField; // Preview auffrischen + {$endif } + FHLaby.Generate; // Labyrinth erzeugen + UpdateGField; // Preview auffrischen end; {------------------------------------------------------------------------------ @@ -213,87 +209,86 @@ procedure TFrmLaby4.btnGenerateClick(Sender: TObject); - Seitenflächen werden abhängig von benachbarten Höhen gezeichnet, um Stufen/Abstufungen plastisch zu zeigen. ------------------------------------------------------------------------------} -procedure TFrmLaby4.Drawbox(Canvas: TCanvas; x, y, z: integer; DrawHead: boolean); +procedure TFrmLaby4.Drawbox(Canvas :TCanvas; x, y, z :integer; DrawHead :boolean); var - x2, y2, L, H, s, s2, d: integer; - pts: array of TPoint; - + x2, y2, L, H, s, s2, d :integer; + pts :array of TPoint; begin - L := Canvas.ClipRect.Right div (Clen *2); - H := Canvas.ClipRect.Height div (Clen *4 + FHLaby.Baselevel(Clen -1, Clen -1)+4); - x2 := (Clen - x + y) * L; - y2 := Canvas.ClipRect.bottom - (x *2 + y *2 + z +2) * H; - setlength(pts{%H-},4); - pts[0] := point(x2, y2); - - // Linke Seitenfläche, wenn links keine höhere/gleich hohe Stufe vorhanden - if (x =0) or (FHLaby[x -1, y] < z) then - begin - // pbxResult.Canvas.pen.Color := pbxResult.Canvas.Brush.Color; - pts[1] := point(x2 + L, y2 - H *2); - pts[2] := point(x2 + L, y2 - H); - pts[3] := point(x2, y2 + H); - Canvas.pen.Color := clBlack; - Canvas.Brush.Color := clDkGray; - Canvas.Polygon(pts); - end; - - // Rechte Seitenfläche, wenn oben keine höhere/gleich hohe Stufe vorhanden - if (y =0) or (FHLaby[x, y -1] < z) then - begin - Canvas.Brush.Color := clLtGray; - Canvas.pen.Color := clWhite; - pts[1] := point(x2 - L, y2 - H *2); - pts[2] := point(x2 - L, y2 - H); - pts[3] := point(x2, y2 + H); - Canvas.Polygon(pts); - - // Schräge Verbindung an der Kante (Detail) basierend auf diagonaler Zelle - if (x < clen -1) and (y >0) and (FHLaby[x +1, y -1] - z >=0) then - begin - d := FHLaby[x +1, y -1]; - s := trunc((d - z) * L /8); - s2 := trunc((d - z +1) * L /8); - if s2 <= L then - begin - pts[0] := point(x2 + s - L, y2 - H *2 + trunc(s * H / L *2)); - pts[3] := point(x2 + s2 - L, y2 - H *1 + trunc(s2 * H / L *2 +0.5)); - Canvas.pen.Color := clDkGray; - Canvas.Brush.Color := clDkGray; - Canvas.Polygon(pts); - Canvas.pen.Color := clBlack; - Canvas.Line(pts[1], pts[2]); - Canvas.Line(pts[2], pts[3]); - pts[0] := point(x2, y2); - end; - end; - end; - // pbxResult.Canvas.PolyLine(pts); - // pbxResult.Canvas.pen.Color := pbxResult.Canvas.Brush.Color; - - // Deckfläche zeichnen, wenn oberer Abschluss erreicht - if DrawHead then - begin - pts[1] := point(x2 + L, y2 - H *2); - pts[2] := point(x2, y2 - H *4); - pts[3] := point(x2 - L, y2 - H *2); - Canvas.Brush.Color := clwhite; - Canvas.pen.Color := clLtGray; - Canvas.Polygon(pts); - // pbxResult.Canvas.PolyLine(pts); - - // Rechte, oben ansteigende Fläche, wenn rechts höhere Zelle vorhanden - if (x < clen -1) and (FHLaby[x +1, y] - z >0) then - begin - s := trunc((FHLaby[x +1, y] - z) * L /8); - pts[1] := point(x2 + s, y2 - H *4 + trunc(s * H / L *2)); - pts[0] := point(x2 + s - L, y2 - H *2 + trunc(s * H / L *2)); - Canvas.pen.Color := clltGray; - Canvas.Brush.Color := clDkGray; - Canvas.Polygon(pts); - end; - end; + L := Canvas.ClipRect.Right div (Clen * 2); + H := Canvas.ClipRect.Height div (Clen * 4 + FHLaby.Baselevel(Clen - 1, Clen - 1) + 4); + x2 := (Clen - x + y) * L; + y2 := Canvas.ClipRect.bottom - (x * 2 + y * 2 + z + 2) * H; + setlength(pts{%H-}, 4); + pts[0] := point(x2, y2); + + // Linke Seitenfläche, wenn links keine höhere/gleich hohe Stufe vorhanden + if (x = 0) or (FHLaby[x - 1, y] < z) then + begin + // pbxResult.Canvas.pen.Color := pbxResult.Canvas.Brush.Color; + pts[1] := point(x2 + L, y2 - H * 2); + pts[2] := point(x2 + L, y2 - H); + pts[3] := point(x2, y2 + H); + Canvas.pen.Color := clBlack; + Canvas.Brush.Color := clDkGray; + Canvas.Polygon(pts); + end; + + // Rechte Seitenfläche, wenn oben keine höhere/gleich hohe Stufe vorhanden + if (y = 0) or (FHLaby[x, y - 1] < z) then + begin + Canvas.Brush.Color := clLtGray; + Canvas.pen.Color := clWhite; + pts[1] := point(x2 - L, y2 - H * 2); + pts[2] := point(x2 - L, y2 - H); + pts[3] := point(x2, y2 + H); + Canvas.Polygon(pts); + + // Schräge Verbindung an der Kante (Detail) basierend auf diagonaler Zelle + if (x < clen - 1) and (y > 0) and (FHLaby[x + 1, y - 1] - z >= 0) then + begin + d := FHLaby[x + 1, y - 1]; + s := trunc((d - z) * L / 8); + s2 := trunc((d - z + 1) * L / 8); + if s2 <= L then + begin + pts[0] := point(x2 + s - L, y2 - H * 2 + trunc(s * H / L * 2)); + pts[3] := point(x2 + s2 - L, y2 - H * 1 + trunc(s2 * H / L * 2 + 0.5)); + Canvas.pen.Color := clDkGray; + Canvas.Brush.Color := clDkGray; + Canvas.Polygon(pts); + Canvas.pen.Color := clBlack; + Canvas.Line(pts[1], pts[2]); + Canvas.Line(pts[2], pts[3]); + pts[0] := point(x2, y2); + end; + end; + end; + // pbxResult.Canvas.PolyLine(pts); + // pbxResult.Canvas.pen.Color := pbxResult.Canvas.Brush.Color; + + // Deckfläche zeichnen, wenn oberer Abschluss erreicht + if DrawHead then + begin + pts[1] := point(x2 + L, y2 - H * 2); + pts[2] := point(x2, y2 - H * 4); + pts[3] := point(x2 - L, y2 - H * 2); + Canvas.Brush.Color := clwhite; + Canvas.pen.Color := clLtGray; + Canvas.Polygon(pts); + // pbxResult.Canvas.PolyLine(pts); + + // Rechte, oben ansteigende Fläche, wenn rechts höhere Zelle vorhanden + if (x < clen - 1) and (FHLaby[x + 1, y] - z > 0) then + begin + s := trunc((FHLaby[x + 1, y] - z) * L / 8); + pts[1] := point(x2 + s, y2 - H * 4 + trunc(s * H / L * 2)); + pts[0] := point(x2 + s - L, y2 - H * 2 + trunc(s * H / L * 2)); + Canvas.pen.Color := clltGray; + Canvas.Brush.Color := clDkGray; + Canvas.Polygon(pts); + end; + end; end; {------------------------------------------------------------------------------ @@ -301,17 +296,17 @@ procedure TFrmLaby4.Drawbox(Canvas: TCanvas; x, y, z: integer; DrawHead: boolean Visualisiert Schritt-für-Schritt die Generierung: Zunächst der3x3-Block um `lastCell` neu zeichnen, dann die neue Zelle hervorheben und kurz pausieren. ------------------------------------------------------------------------------} -procedure TFrmLaby4.LabyUpdateCell(Sender: TObject; Cell: TPoint); +procedure TFrmLaby4.LabyUpdateCell(Sender :TObject; Cell :TPoint); var - i: Integer; + i :integer; begin - for i :=0 to8 do - if FHLaby.Dimension.Contains(lastcell.add(point(i mod3,i div3) )) then - PaintField(lastcell.x+(i mod3), lastcell.y+(i div3),false); - PaintField(cell.x, cell.y,true); - lastCell := cell; - Application.ProcessMessages; - sleep(100); + for i := 0 to 8 do + if FHLaby.Dimension.Contains(lastcell.add(point(i mod 3, i div 3))) then + PaintField(lastcell.x + (i mod 3), lastcell.y + (i div 3), False); + PaintField(cell.x, cell.y, True); + lastCell := cell; + Application.ProcessMessages; + sleep(100); end; {------------------------------------------------------------------------------ @@ -322,23 +317,20 @@ procedure TFrmLaby4.LabyUpdateCell(Sender: TObject; Cell: TPoint); `(z > Baselevel(x,y) -6)` blendet tiefe Bereiche teilweise aus, um eine plastische Darstellung zu erreichen. ------------------------------------------------------------------------------} -procedure TFrmLaby4.btnDrawClick(Sender: TObject); - +procedure TFrmLaby4.btnDrawClick(Sender :TObject); var - x, y, z: integer; - + x, y, z :integer; begin - if FHLaby.Dimension.Width < Clen then - btnGenerateClick(Sender); - pbxResult.Canvas.Brush.Color := Color; - pbxResult.Canvas.FillRect(pbxResult.Canvas.ClipRect); - FMargin:=10; - for z :=0 to (Clen *2 +4) do - for x := Clen -1 downto0 do - for y := Clen -1 downto0 do - if (FHLaby[x, y] >= z) and ((x =0) or (y =0) or - (z > FHLaby.baselevel(x, y) -6)) then - Drawbox(pbxResult.Canvas, x, y, z, FHLaby[x, y] = z); + if FHLaby.Dimension.Width < Clen then + btnGenerateClick(Sender); + pbxResult.Canvas.Brush.Color := Color; + pbxResult.Canvas.FillRect(pbxResult.Canvas.ClipRect); + FMargin := 10; + for z := 0 to (Clen * 2 + 4) do + for x := Clen - 1 downto 0 do + for y := Clen - 1 downto 0 do + if (FHLaby[x, y] >= z) and ((x = 0) or (y = 0) or (z > FHLaby.baselevel(x, y) - 6)) then + Drawbox(pbxResult.Canvas, x, y, z, FHLaby[x, y] = z); end; @@ -348,55 +340,54 @@ procedure TFrmLaby4.btnDrawClick(Sender: TObject); wird zuvor generiert. Zeichnung wie in `btnDrawClick`, jedoch auf dem Drucker-Canvas, Hoch-/Querformat auf Querformat gesetzt. ------------------------------------------------------------------------------} -procedure TFrmLaby4.btnPrintClick(Sender: TObject); +procedure TFrmLaby4.btnPrintClick(Sender :TObject); var - x, y, z: integer; - cl: TRect; - pr: TPaperRect; + x, y, z :integer; + cl :TRect; + pr :TPaperRect; begin - if FHLaby.Dimension.Width < Clen then - btnGenerateClick(Sender); - if PrintDialog1.Execute then - begin - printer.Orientation := poLandscape; - printer.Title := 'Laby #4 ' + DateToStr(now()); - Printer.BeginDoc; - for z :=0 to (Clen *2 +4) do - for x := Clen -1 downto0 do - for y := Clen -1 downto0 do - if (FHLaby[x, y] >= z) and - ((x =0) or (y =0) or (z > FHLaby.baselevel(x, y) -6)) then - Drawbox(printer.Canvas, x, y, z, FHLaby[x, y] = z); - Printer.EndDoc; - end; + if FHLaby.Dimension.Width < Clen then + btnGenerateClick(Sender); + if PrintDialog1.Execute then + begin + printer.Orientation := poLandscape; + printer.Title := 'Laby #4 ' + DateToStr(now()); + Printer.BeginDoc; + for z := 0 to (Clen * 2 + 4) do + for x := Clen - 1 downto 0 do + for y := Clen - 1 downto 0 do + if (FHLaby[x, y] >= z) and ((x = 0) or (y = 0) or (z > FHLaby.baselevel(x, y) - 6)) then + Drawbox(printer.Canvas, x, y, z, FHLaby[x, y] = z); + Printer.EndDoc; + end; end; {------------------------------------------------------------------------------ FormCreate Initialisiert das Labyrinth-Objekt und setzt eine Default-Kantenlänge. ------------------------------------------------------------------------------} -procedure TFrmLaby4.FormCreate(Sender: TObject); +procedure TFrmLaby4.FormCreate(Sender :TObject); begin - FHLaby := THeightLaby.Create; - Clen:=21; + FHLaby := THeightLaby.Create; + Clen := 21; end; {------------------------------------------------------------------------------ FormDestroy Gibt das Labyrinth-Objekt frei. ------------------------------------------------------------------------------} -procedure TFrmLaby4.FormDestroy(Sender: TObject); +procedure TFrmLaby4.FormDestroy(Sender :TObject); begin - FreeAndNil(FHLaby); + FreeAndNil(FHLaby); end; {------------------------------------------------------------------------------ pbxPreviewPaint Vollständige Neuzeichnung der Preview bei Bedarf (z. B. Fenster-Invalidierung). ------------------------------------------------------------------------------} -procedure TFrmLaby4.pbxPreviewPaint(Sender: TObject); +procedure TFrmLaby4.pbxPreviewPaint(Sender :TObject); begin - UpdateGField; + UpdateGField; end; {------------------------------------------------------------------------------ @@ -405,13 +396,13 @@ procedure TFrmLaby4.pbxPreviewPaint(Sender: TObject); Preview-Skalierungsfaktor `c` so, dass kleine Labyrinthe größer dargestellt werden. ------------------------------------------------------------------------------} -procedure TFrmLaby4.edtLabySizeChange(Sender: TObject); +procedure TFrmLaby4.edtLabySizeChange(Sender :TObject); begin - with sender as TSpinEdit do - begin - Clen := Value; - c :=100 div clen +1 - end; + with Sender as TSpinEdit do + begin + Clen := Value; + c := 100 div clen + 1; + end; end; end. diff --git a/Diverses/Source/Labyrinth/unt_Point2d.pas b/Diverses/Source/Labyrinth/unt_Point2d.pas index 723a340a..f1510c0e 100644 --- a/Diverses/Source/Labyrinth/unt_Point2d.pas +++ b/Diverses/Source/Labyrinth/unt_Point2d.pas @@ -200,7 +200,7 @@ function getInvDir(dir, radius: integer): integer; result := dir // Fester Spezialfall für radius10 else if radius =10 then - result := ((dir +2) mod6) +1 + result := ((dir +2) mod 6) +1 // Inversion aus vorberechneter Tabelle für8-Nachbarschaft else if radius =15 then result := InvDir2D15[dir] @@ -288,7 +288,7 @@ function T2DPoint.Copy: T2DPoint; end; { T2DPoint – Arithmetik / Vektoroperationen } -function T2DPoint.Add(vect: T2DPoint); +function T2DPoint.Add(vect: T2DPoint): T2DPoint; Begin // Addition mit nil-Schutz @@ -534,14 +534,14 @@ function getdir(radius: integer; direction: integer): T2DPoint; Begin imax := round(radius * sqrt2 *4); - If (round(radius * sqrt2) Mod2) =0 Then + If (round(radius * sqrt2) Mod 2) =0 Then imax := imax +4; // Anpassung für gerade Rundungsfälle // Richtung in Grundintervall falten - nr := direction Mod (imax Div2); - nr := nr Mod (imax Div4); - If nr > imax Div8 Then - nr := (imax Div4) - nr; // Spiegelung aufgrund Achsensymmetrie + nr := direction Mod (imax Div 2); + nr := nr Mod (imax Div 4); + If nr > imax Div 8 Then + nr := (imax Div 4) - nr; // Spiegelung aufgrund Achsensymmetrie // Spezialfall Richtung0 ? Nullvektor If direction =0 Then