Недавно добавленные исходники

•  Animation Loaders  676

•  DeLiKaTeS Tetris (Тетрис)  5 689

•  TDictionary Custom Sort  7 643

•  Fast Watermark Sources  7 335

•  3D Designer  10 538

•  Sik Screen Capture  7 856

•  Patch Maker  8 080

•  Айболит (remote control)  8 141

•  ListBox Drag & Drop  6 935

•  Доска для игры Реверси  100 122

•  Графические эффекты  8 198

•  Рисование по маске  7 600

•  Перетаскивание изображений  6 201

•  Canvas Drawing  6 564

•  Рисование Луны  6 491

•  Поворот изображения  5 670

•  Рисование стержней  4 594

•  Paint on Shape  3 290

•  Генератор кроссвордов  4 281

•  Головоломка Paletto  3 419

•  Теорема Монжа об окружностях  4 241

•  Пазл Numbrix  2 750

•  Заборы и коммивояжеры  3 656

•  Игра HIP  2 462

•  Игра Go (Го)  2 443

•  Симулятор лифта  2 855

•  Программа укладки плитки  2 293

•  Генератор лабиринта  3 014

•  Проверка числового ввода  2 514

•  HEX View  2 920

 
скрыть

  Форум  

Delphi FAQ - Часто задаваемые вопросы

| Базы данных | Графика и Игры | Интернет и Сети | Компоненты и Классы | Мультимедиа |
| ОС и Железо | Программа и Интерфейс | Рабочий стол | Синтаксис | Технологии | Файловая система |



Delphi Sources

Кривая Гильберта




unit gilbert_;

interface

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

type
  TForml = class(TForm)
    procedure FormPaint(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation
{$R *.dfm}

var
  p: integer = 5; // порядок кривой
  u: integer = 7; // длина штриха

{ Кривую Гильберта можно получить путем
соединения элементов а,b,с и d.

Каждый элемент строит
соответствующая процедура. }

procedure a(i: integer; canvas: TCanvas); forward;
procedure b(i: integer; canvas: TCanvas); forward;
procedure с(i: integer; canvas: TCanvas); forward;
procedure d(i: integer; canvas: TCanvas); forward;

// Элементы кривой
procedure a(i: integer; canvas: TCanvas);
begin
  if i > 0 then
  begin
    d(i - l, canvas);
    canvas.LineTo(canvas.PenPos.X + u, canvas.PenPos.Y);
    a(i - l, canvas);
    canvas.LineTo(canvas.PenPos.X, canvas.PenPos.Y + u);
    a(i - l, canvas);
    canvas.LineTo(canvas.PenPos.X - u, canvas.PenPos.Y);
    с(i - 1, canvas);
  end;
end;

procedure b(i: integer; canvas: TCanvas);
begin
  if i > 0 then
  begin
    c(i - l, canvas);
    canvas.LineTo(canvas.PenPos.X - u, canvas.PenPos.Y);
    b(i - 1, canvas);
    canvas.LineTo(canvas.PenPos.X, canvas.PenPos.Y - u);
    b(i - l, canvas);
    canvas.LineTo(canvas.PenPos.X + u, canvas.PenPos.Y);
    d(i - l, canvas);
  end;
end;

procedure c(i: integer; canvas: TCanvas);
begin
  if i > 0 then
  begin
    b(i - 1, canvas);
    canvas.LineTo(canvas.PenPos.X, canvas.PenPos.Y - u);
    с(i - 1, canvas);
    canvas.LineTo(canvas.PenPos.X - u, canvas.PenPos.Y);
    c(i - 1, canvas);
    canvas.LineTo(canvas.PenPos.X, canvas.PenPos.Y + u);
    a(i - 1, canvas);
  end;
end;

procedure d(i: integer; canvas: TCanvas);
begin
  if i > 0 then
  begin
    a(i - 1, canvas);
    canvas.LineTo(canvas.PenPos.X, canvas.PenPos.Y + u);
    d(i - 1, canvas);
    canvas.LineTo(canvas.PenPos.X + u, canvas.PenPos.Y);
    d(i - 1, canvas);
    canvas.LineTo(canvas.PenPos.X, canvas.PenPos.Y - u);
    b(i - 1, canvas);
  end;
end;

procedure TForml.FormPaint(Sender: TObject);
begin
  Form1.Canvas.MoveTo(u, u);
  a(5, Form1.Canvas); // вычертить кривую Гильберта
end;

end.

Следует обратить внимание на следующую особенность реализации программы. Процедура, которая вычерчивает элемент а, помимо самой себя (для вычерчивания элемента а кривой более низкого порядка) вызывает процедуры d и ь, описание (текст) которых в тексте программы находится после процедуры а. Чтобы компилятор не вывел сообщение об ошибке, в текст программы помещено объявление процедуры с ключевым словом forward, означающим, что это только объявление, а описание (реализация) находится дальше. Таким образом, уже в процессе компиляции процедуры а, компилятор "знает", что имена ь и d означают процедуры.





Похожие по теме исходники

Кривая Безье

Кривая Коха




Copyright © 2004-2026 "Delphi Sources" by «SiteAnalyzer». Delphi World FAQ

Группа ВКонтакте