unit Hilb1F;
//*******************************************************
// Example program demonstrating recursive Hilbert curves.
//*******************************************************
// Copyright (C) 1998 John Wiley & Sons, Inc.
// All rights reserved. See additional copyright
// information in Readme.txt.
//
// Revised (C) 1999 Andrzej Grażyński, HELION Publ.
//
//*******************************************************

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Menus, StdCtrls, ExtCtrls, Math;

type
  THilb1Form = class(TForm)
    MainMenu1: TMainMenu;
    File1: TMenuItem;
    mnuExit: TMenuItem;
    Help1: TMenuItem;
    mnuAbout: TMenuItem;
    Label1: TLabel;
    LevelEdit: TEdit;
    CmdDraw: TButton;
    LoopsLabel: TLabel;
    DrawArea: TImage;
    Label2: TLabel;
    procedure mnuExitClick(Sender: TObject);
    procedure mnuAboutClick(Sender: TObject);
    procedure NumbersOnly(Sender: TObject; var Key: Char);
    procedure CmdDrawClick(Sender: TObject);
    procedure DrawCurve;
    procedure DrawHilbert(depth, dx, dy : Integer);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Hilb1Form: THilb1Form;

implementation

var
    loops : Longint;

{$R *.DFM}

procedure THilb1Form.mnuExitClick(Sender: TObject);
begin
    Close;
end;

procedure THilb1Form.mnuAboutClick(Sender: TObject);
const
    CRCR = #13#10#13#10;
    CR = #13#10;
begin


    MessageDlg(
        'Niniejszy program rysuje krzywą Hilberta określonego stopnia w sposób rekursywny.' + CRCR +
        'Wprowadź stopień krzywej i kliknij w przycisk "Rysuj".' + CR +
        'UWAGA: czas rysowania rośnie gwałtownie wraz ze stopniem krzywej.'
        , mtInformation, [mbOK], 0);





end;

procedure THilb1Form.NumbersOnly(Sender: TObject; var Key: Char);
begin
    if (Key = #8) then exit; // Backspace.
    if ((Key >= '0') and (Key <= '9')) then exit;
    Key := #0;
end;

procedure THilb1Form.CmdDrawClick(Sender: TObject);
begin
    DrawCurve;
end;

// Draw the curve.
procedure THilb1Form.DrawCurve;
var
    depth, dist, gaps, margin : Integer;
    rect                      : TRect;
begin
    LoopsLabel.Caption := '';
    loops := 0;

    if (LevelEdit.Text = '') then exit;
    depth := StrToInt(LevelEdit.Text);
    if ((depth < 1) or (depth > 9)) Then
    begin
        ShowMessage('Stopień krzywej musi zawierać się pomiędzy 1 a 9');
        exit;
    end;

    Screen.Cursor := crHourGlass;
    Update;

    // See how long each segment should be to fill the
    // drawing area.
    margin := 5;
    gaps := Round(IntPower(2, depth) - 1);
    dist := (DrawArea.ClientWidth - 2 * margin) div gaps;

    rect.Left := 0;
    rect.Right := DrawArea.ClientWidth;
    rect.Top := 0;
    rect.Bottom := DrawArea.ClientWidth;
    DrawArea.Canvas.FillRect(rect);
    DrawArea.Canvas.MoveTo(margin, margin);

    DrawHilbert(depth, dist, 0);

    LoopsLabel.Caption := IntToStr(loops);
    Screen.Cursor := crDefault;
end;

// Draw the Hilbert curve. dx and dy indicate the
// direction for the first part of the curve. In other
// words, if the curve starts at (x, y) it should finish
// at (x + dx, y + dy) after it has drawn the first third
// of the curve.
procedure THilb1Form.DrawHilbert(depth, dx, dy : Integer);
begin
    loops := loops + 1;

    with DrawArea.Canvas do
    begin
      if (depth > 1)
      then
        DrawHilbert(depth - 1, dy, dx);

      LineTo(PenPos.X + dx, PenPos.Y + dy);

      if (depth > 1)
      then
        DrawHilbert(depth - 1, dx, dy);

      LineTo(PenPos.X + dy, PenPos.Y + dx);

      if (depth > 1)
      then
        DrawHilbert(depth - 1, dx, dy);

      LineTo(PenPos.X - dx, PenPos.Y - dy);

      if (depth > 1)
      then
        DrawHilbert(depth - 1, -dy, -dx);
    end;
end;

end.
