Delphi-PRAXiS

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Object-Pascal / Delphi-Language (https://www.delphipraxis.net/32-object-pascal-delphi-language/)
-   -   Delphi Hilfe bei der Hilbert Kurve (https://www.delphipraxis.net/68949-hilfe-bei-der-hilbert-kurve.html)

Lestat 8. Mai 2006 15:57


Hilfe bei der Hilbert Kurve
 
Hallo zusammen, ich habe ein kleines Problem!

Undzwar möchte ich die Hilbert Kurve gerne in Delphi per Rekursion implementieren! Jedoch habe ich noch ein kleines Problem beim zeichnen der Verbindungslinienb mancher Formen! Gleich folgt der Quellcode, wenn ich das Prog bei euch ausprobiert, werdet ihr sehen was ich meine!
Delphi-Quellcode:
unit uMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, Spin;

type
  THubert_Kurve = class(TForm)
    Hubert: TPaintBox;
    Control_Panel: TPanel;
    btn_close: TButton;
    btn_reset: TButton;
    rgrp_ausgangsfigur: TRadioGroup;
    btn_berechnen: TButton;
    sp_edt: TSpinEdit;
    lbl_X: TLabel;
    lbl_Y: TLabel;
    lbl_h: TLabel;
    lbl_act_x: TLabel;
    lbl_act_y: TLabel;
    procedure btn_closeClick(Sender: TObject);
    procedure btn_resetClick(Sender: TObject);
    procedure btn_berechnenClick(Sender: TObject);
    procedure HubertPaint(Sender: TObject);
    procedure HubertMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
  private
    { Private declarations }
    procedure DrawCanvasWhite;
    Procedure a(Stufe : Byte; h : Double; x,y : Double; var First : Boolean);
    Procedure b(Stufe : Byte; h : Double; x,y : Double; var First : Boolean);
    Procedure c(Stufe : Byte; h : Double; x,y : Double; var First : Boolean);
    Procedure d(Stufe : Byte; h : Double; x,y : Double; var First : Boolean);
  public
    { Public declarations }
  end;

var
  Hubert_Kurve: THubert_Kurve;

implementation

uses Math;

{$R *.dfm}

  // Info an mich:
  // In den Rekursionen muss ich zuerst immer nach unten gehen
  // Und dann erst im else Zweig zeichnen, Hoehe -> nicht var sonder immer /2
  // und Go ;)


  //***************************************************************************//
  //** Funktionsname: a                                                     **//
  //** Funktion: Hier wird der Ablauf der Form a mit den entsprechenden    **//
  //**           unter Aufrufen für die Rekursion getätigt                  **//
  //** Übergabeparameter: Stufe -> Welche Ebene habe ich gerade             **//
  //**                    H -> Höhe, x,y -> X und Y-Wert                    **//
  //***************************************************************************//
  Procedure THubert_Kurve.a(Stufe : Byte; h : Double; x,y : Double; var First : Boolean);
  begin
    if (stufe <> 0) then
    begin
      x := X + H/4;
      y := y - H/4;
      if not first then Hubert.Canvas.LineTo(round(x),round(y));
      Hubert.Canvas.MoveTo(round(x),round(y));
      first := true;
      b(Stufe-1,h/2,x,y, first);
      x := x - h;
      a(Stufe-1,h/2,x,y, first);
      y := y + h;
      a(Stufe-1,h/2,x,y, first);
      x := x + h/2;
      y := y + h/2;
      c(Stufe-1,h/2,x,y, first);
    end
    else
    begin
      first := false;
      Hubert.Canvas.LineTo(round(x),round(y));
      x := x - h;
      Hubert.Canvas.LineTo(round(x),round(y));
      y := y + h;
      Hubert.Canvas.LineTo(round(x),round(y));
      x := x + h;
      Hubert.Canvas.LineTo(round(x),round(y));
    end;
  end;

  //***************************************************************************//
  //** Funktionsname: b                                                     **//
  //** Funktion: Hier wird der Ablauf der Form b mit den entsprechenden    **//
  //**           unter Aufrufen für die Rekursion getätigt                  **//
  //** Übergabeparameter: Stufe -> Welche Ebene habe ich gerade             **//
  //**                    H -> Höhe, x,y -> X und Y-Wert                    **//
  //***************************************************************************//
  Procedure THubert_Kurve.b(Stufe : Byte; h : double; x,y : Double; var First : Boolean);
  begin
    if (stufe <> 0) then
    begin
      x := X + H/4;
      y := y - H/4;
      if not first then Hubert.Canvas.LineTo(round(x),round(y));
      Hubert.Canvas.MoveTo(round(x),round(y));
      a(Stufe-1,h/2,x,y, first);
      y := y + h;
      b(Stufe-1,h/2,x,y, first);
      x := x - h;
      b(Stufe-1,h/2,x,y, first);
      y := y - h/2;
      x := x - h/2;
      d(Stufe-1,h/2,x,y, first);
    end
    else
    begin
      Hubert.Canvas.LineTo(round(x),round(y));
      y := y + h;
      Hubert.Canvas.LineTo(round(x),round(y));
      x := x - h;
      Hubert.Canvas.LineTo(round(x),round(y));
      y := y - h;
      Hubert.Canvas.LineTo(round(x),round(y));
    end;
  end;

  //***************************************************************************//
  //** Funktionsname: c                                                     **//
  //** Funktion: Hier wird der Ablauf der Form c mit den entsprechenden    **//
  //**           unter Aufrufen für die Rekursion getätigt                  **//
  //** Übergabeparameter: Stufe -> Welche Ebene habe ich gerade             **//
  //**                    H -> Höhe, x,y -> X und Y-Wert                    **//
  //***************************************************************************//
  Procedure THubert_Kurve.c(Stufe : Byte; h : double; x,y : Double; var First : Boolean);
  begin
    if (stufe <> 0) then
    begin
      x := x - H/4;
      y := Y + H/4;
      if not first then Hubert.Canvas.LineTo(round(x),round(y));
      Hubert.Canvas.MoveTo(round(x),round(y));
      d(Stufe-1,h/2,x,y, first);
      y := y - h;
      c(Stufe-1,h/2,x,y, first);
      x := x + h;
      c(Stufe-1,h/2,x,y, first);
      y := y + h/2;
      x := x + h/2;
      a(Stufe-1,h/2,x,y, first);
    end
    else
    begin
      Hubert.Canvas.LineTo(round(x),round(y));
      y := y - h;
      Hubert.Canvas.LineTo(round(x),round(y));
      x := x + h;
      Hubert.Canvas.LineTo(round(x),round(y));
      y := y + h;
      Hubert.Canvas.LineTo(round(x),round(y));
    end;
  end;

  //***************************************************************************//
  //** Funktionsname: d                                                     **//
  //** Funktion: Hier wird der Ablauf der Form d mit den entsprechenden    **//
  //**           unter Aufrufen für die Rekursion getätigt                  **//
  //** Übergabeparameter: Stufe -> Welche Ebene habe ich gerade             **//
  //**                    H -> Höhe, x,y -> X und Y-Wert                    **//
  //***************************************************************************//
  Procedure THubert_Kurve.d(Stufe : Byte; h : Double; x,y : Double; var First : Boolean);
  begin
    if (stufe <> 0) then
    begin
      x := x - H/4;
      y := Y + H/4;
      if not first then Hubert.Canvas.LineTo(round(x),round(y));
      Hubert.Canvas.MoveTo(round(x),round(y));
      c(Stufe-1,h/2,x,y, first);
      x := x + h;
      d(Stufe-1,h/2,x,y, first);
      y := y - h;
      d(Stufe-1,h/2,x,y, first);
      x := x - h/2;
      y := y - h/2;
      b(Stufe-1,h/2,x,y, first);
    end
    else
    begin
      Hubert.Canvas.LineTo(round(x),round(y));
      x := x + h;
      Hubert.Canvas.LineTo(round(x),round(y));
      y := y - h;
      Hubert.Canvas.LineTo(round(x),round(y));
      x := x - h;
      Hubert.Canvas.LineTo(round(x),round(y));
    end;
  end;

  //***************************************************************************//
  //** Funktionsname: DrawCanvasWhite                                       **//
  //** Funktion: Hier wird das Canvas Weiß gemalt                           **//
  //** Übergabeparameter: Keine                                             **//
  //***************************************************************************//
  procedure THubert_Kurve.DrawCanvasWhite;
  begin
   Hubert.Canvas.Brush.Color := clWhite;
   Hubert.Canvas.Rectangle(0,0,hubert.width,hubert.width);
  end;

  //***************************************************************************//
  //** Funktionsname: Btn_CloseClick                                        **//
  //** Funktion: Hier wird einfach das Programm beendet                     **//
  //** Übergabeparameter: Keine                                             **//
  //***************************************************************************//
  procedure THubert_Kurve.btn_closeClick(Sender: TObject);
  begin
    close;
  end;

  //***************************************************************************//
  //** Funktionsname: btn_resetClick                                        **//
  //** Funktion: DrawCanvas wird aufgerufen                                 **//
  //** Übergabeparameter: Keine                                             **//
  //***************************************************************************//
  procedure THubert_Kurve.btn_resetClick(Sender: TObject);
  begin
    DrawCanvasWhite;
  end;

  //***************************************************************************//
  //** Funktionsname: btn_berechnenClick                                    **//
  //** Funktion: Hier wird der Startpunkt in Abhängigkeit der Form          **//
  //** berechnet und dann die entsprechnende Funktion aufgerufen            **//
  //** Übergabeparameter: Keine                                             **//
  //***************************************************************************//
  procedure THubert_Kurve.btn_berechnenClick(Sender: TObject);
  var
    Stufe : Byte;
    Hoehe, X, Y : Double;
    first : Boolean;
  begin
    // Variablen initialisierung
    Hoehe := Hubert.Width / 2;
    Stufe := sp_edt.Value;
    X := 0;
    Y := 0;
    first := true;

    // Auswahl der Formen, da es zwei verschiedene Startpunkte geben kann
      case rgrp_ausgangsfigur.ItemIndex of
      0..1:
        begin
          x := X + Hoehe + Hoehe/2;
          y := Y + Hoehe/2;
          Hubert.Canvas.MoveTo(round(x),round(y));

          // Aufruf der Funktion zum zeichnen
          if rgrp_ausgangsfigur.ItemIndex = 0 then
            a(Stufe,hoehe,x,y, first)
          else
            b(Stufe,hoehe,x,y, first);
        end;

      2..3 :
        begin
          // Berechnung der X und Y Werte
              x := x + Hoehe/2;
              y := y + Hoehe + Hoehe/2;

          Hubert.Canvas.MoveTo(round(x),round(y));

          // Aufruf der Funktion zum zeichnen
          if rgrp_ausgangsfigur.ItemIndex = 2 then
            c(Stufe,hoehe,x,y, first)
          else
            d(Stufe,hoehe,x,y, first);
        end;
    end;

  end;

  //***************************************************************************//
  //** Funktionsname: HubertPaint                                           **//
  //** Funktion: Beim Programmstart soll das Canvas weiß gemacht werden     **//
  //** Übergabeparameter: Keine                                             **//
  //***************************************************************************//
  procedure THubert_Kurve.HubertPaint(Sender: TObject);
  begin
    Hubert.Canvas.Pen.width := 1;
    Hubert.Canvas.Pen.color :=clBlack;
    DrawCanvasWhite;
  end;

procedure THubert_Kurve.HubertMouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
begin
  lbl_act_x.caption := 'Aktuelle x-Koo: ' + IntToStr(x);
  lbl_act_y.caption := 'Aktuelle y-Koo: ' + IntToStr(y);
end;

end.
Wie ihr seht habe ich es schon ein wenig mit einem Bolleschenparameter versucht, aber ich stecke fest und komme einfach nicht weiter!

Schon mal danke fürs lange lesen bis hier her!

MfG Lestat!

PS: Freue mich schon auf eure Hilfestellungen ;)

alzaimar 8. Mai 2006 16:35

Re: Hilfe bei der Hilbert Kurve
 
solche Sachen würde ich anders lösen:
Delphi-Quellcode:
Var
  gFirst : Boolean;
  gCanvas : TCanvas;

Procedure DrawTo (X,Y : Integer);
Begin
  If gFirst Then Begin
    gCanvas.MoveTo(X,Y);
    gFirst := False;
  End
  Else
    gCanvas.DrawTo (X,Y)
End;

...
  gFirst := True;
  gCanvas := MyControl.Canvas;
  DrawTo (0,0);
  DrawTo (1,1);
  DrawTo (2,5);
...
Prinzipiell verlagerst Du das Bookkeeping des MoveTo/DrawTo-Flags ('gFirst') in eine separate Routine. Das vereinfacht die Sache und ist idiotensicher.


Alle Zeitangaben in WEZ +1. Es ist jetzt 17:35 Uhr.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz