unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Label1: TLabel;
    Label2: TLabel;
    Button1: TButton;
    Button2: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
  const N=40;
var
  Form1: TForm1;
  mas: array[1..N] of integer;
implementation

{$R *.dfm}
procedure sort(l, r: integer);
var
  i,j,temp: integer;
  left: boolean;
begin
left:=true;
if (r-l)>=1 then
begin
 i:=l;
 j:=r;

 while i<>j do
   begin
    if left=true then begin
      if mas[i]<=mas[j] then
        begin
         j:=j-1;
        end
      else
        begin
         temp:=mas[i];
         mas[i]:=mas[j];
         mas[j]:=temp;
         inc(i);
         left:=false;
        end;
      end
      else
      begin
      if mas[i]<=mas[j] then
        begin
         inc(i);
        end
      else
        begin
         temp:=mas[i];
         mas[i]:=mas[j];
         mas[j]:=temp;
         j:=j-1;
         left:=true;
        end;
        end;
   end;
sort(l, i-1);
sort(j+1, r);
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  i: integer;
begin
randomize;
Label1.Caption:='';
for i:=1 to N do
  begin
   mas[i]:=random(100);
   Label1.Caption:=Label1.Caption+'  '+IntToStr(mas[i]);
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  i: integer;
begin
Label2.Caption:='';

sort(1,N);
for i:=1 to N do
  Label2.Caption:=Label2.Caption+'  '+IntToStr(mas[i]);
end;

end.

Алгоритм:

1. понадобится два массива:  исходный(неупорядоченный) и выходной(пустой)
2. берем первый элемент исходного массива и помещаем в конец выходного
3. в цикле сравниваем добавленый элемент со всеми, пока он не станет на свое место
4. повторяем пункт 3 пока в исходном массиве не закончатся элементы

  #include 
  #include


  void add(int *mas[20], int n)
    {
     int i,j,*temp;

     for (i=0;i0)
         {
          temp=mas[j-1];
          mas[j-1]=mas[j];
          mas[j]=temp;
          --j;
         }
       for (i=0;i>menu;
	switch (menu)
	  {
	   case 1: { cin>>mas[n];  ++n; add(&mas, n);  } ; break;

	   default: exit=1;
	  }
       };

    }

Простейший алгоритм заполнения называется алгоритм кораеда.

Алгоритм:

• Добавить начальную полоску в список
• Цикл, пока список не пустой

1. берем первую точку из списка(удаляем ее)
2. закрашиваем взятую точку
3. проверяем 4 точки вокруг и если их цвет не совпадает с цветом границыи она не закрашена, то добавляем ее в список.

unit Unit1;
interface
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Buttons, jpeg, ExtCtrls, ColorGrd;

type
Stek = ^St;
    St=record
    x,y:integer;
    Next:Stek;
    end;
  TForm1 = class(TForm)
    Image1: TImage;
    procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormCreate(Sender: TObject);
    procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure Image1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    { Private declarations }
  public
    first:stek;{ Public declarations }
    C1,C2:TColor;
    procedure Add (X1,Y1:integer);
    procedure Del (var X1,y1:integer);
  end;
var
  Form1: TForm1;
  MD: boolean;
implementation

{$R *.DFM}

procedure TForm1.Add(X1, Y1: integer);
var
 elem:Stek;
begin
   New (elem);
elem.x:=X1;
elem.y:=Y1;
elem.Next:=first;
first:=elem;
end;

procedure TForm1.Del(var X1, y1: integer);
var
x,y:integer;
elem:Stek;
begin
   if first <> nil then
   begin
   x1:=first.x;
   y1:=first.y;
   elem:=first;
   first:=first.Next;
   dispose (elem);
    end;
end;

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
  var
  X1,y1:integer;
  begin
  if Button=mbleft then
  begin
  MD:=true;
  Image1.Canvas.MoveTo(x,y);
  end
  else
  begin
  c2:=Image1.Canvas.Pixels[x,y];
  c1:=RGB(random(255),random(255),random(255));
  first:=nil;
  Add(x,y);
  while (first <> nil) do
  begin
  Del (x1,y1);
  Image1.Canvas.Pixels[x1,y1]:=C1;
  if (Image1.Canvas.Pixels[x1,y1-1]=C2) then
  Add (x1,Y1-1);
   if (Image1.Canvas.Pixels[x1,y1+1]=C2) then
  Add (X1,Y1+1);
  if (Image1.Canvas.Pixels[x1-1,y1]=C2)then
   Add (x1-1,y1);
  if (Image1.Canvas.Pixels[x1+1,y1]=C2)  then
  Add (x1+1,y1);
  end;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
Image1.Canvas.Rectangle(0,0,Image1.Width,Image1.Height);
first:=nil;
end;

procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
if MD then
  Image1.Canvas.LineTo(x,y);
end;

procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
MD:=false;
end;
end.

Задание: нарисовать фрактальное дерево.

unit Unit1;
interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Edit1: TEdit;
    Edit2: TEdit;
    Edit3: TEdit;
    //procedure fak(x, y, a, al, be, ga: integer);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  max:integer;  //густота ветвей, самая густая=1, чем больше тем убывает
implementation

{$R *.dfm}

Procedure Draw(x, y : Integer; l, u : real);//рекурсивная процедура рисавания всего изображения
Procedure lineto1(x, y : Integer; l, u : real); //процедура рисования линии по заданным координатам
Begin
   Form1.Canvas.MoveTo(x,y);
   Form1.Canvas.LineTo(Round(x + l * cos(u)), Round(y - l * sin(u)));
End;
Begin
   If l > max then
    Begin
      l := l * 0.7;
      lineto1(x, y, l, u);
      x := Round(x + l * cos(u));
      y := Round(y - l * sin(u));
      Draw(x, y, l, u + pi / strtoint(form1.edit2.text));{Угол поворота 1}
      Draw(x, y, l, u - pi / strtoint(form1.edit3.text));{Угол поворота 2}
   End;
end;
procedure TForm1.Button1Click(Sender: TObject);
var x1,y1,x2,y2:integer;
    a:real;
begin
form1.Canvas.Brush.Color:=clwhite;
form1.Canvas.Rectangle(0, 0, Form1.Width, Form1.Height);
max:=StrToInt(Edit1.Text); //водим число 1,2,3....
x1:=Form1.ClientWidth div 2; //середина формы
y1:=Form1.ClientHeight - 100; //100 пикселей от нижнего края
Draw(x1, y1, Form1.ClientHeight div 3, pi/2)//размер рисунка 2/3 высоты формы, самый оптимальный
end;                                         //угол между ветвями 90 град.

end.

unit Unit1;
interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Menus;

type
  TForm1 = class(TForm)
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormCreate(Sender: TObject);

  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  X_i: array [0..100] of real;
  Y_i: array [0..100] of real;
  col: integer;
implementation

{$R *.dfm}

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
procedure draw();
var x1:    integer;
    y1:    real;
    q:     real;
    i,j:   integer;
begin
form1.Canvas.MoveTo(0,0);
for x1:=0 to form1.Width do
 begin y1:=0;
  for i:=0 to col-1 do
   begin q:=1;
    for j:=0 to col-1 do
     begin
      if i<>j then
       q:=q*(x1-X_i[j])/(X_i[i]-X_i[j]);
      end;
      y1:=y1+y_i[i]*q;
   end;
form1.Canvas.LineTo(x1,round(y1));
 end;
end;
begin
Canvas.Rectangle(0,0,Form1.Width,Form1.Height);
form1.Canvas.Ellipse(X-2,Y-2,X+2,Y+2);
X_i[col]:=X;
Y_i[col]:=Y;
inc(col);
draw;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
col:=0;
end;
end.

procedure FlipBitmap(Bitmap: TBitmap; FlipHor: Boolean);
{Зеркальное отражение изображения.
 Если FlipHor = True, то отражение по горизонтали,
 иначе по вертикали.}
var
  x, y, W, H: Integer;
  Pixel_1, Pixel_2: PRGBTriple;
  MemPixel: TRGBTriple;
begin
  Bitmap.PixelFormat := pf24Bit;
  W := Bitmap.Width - 1;
  H := Bitmap.Height - 1;
  if FlipHor then {отражение по горизонтали}
    for y := 0 to H do
    begin
      {помещаем оба указателя на строку H:}
      Pixel_1 := Bitmap.ScanLine[y];
      Pixel_2 := Bitmap.ScanLine[y];
      {помещаем второй указатель в конец строки:}
      Inc(Pixel_2, W);
      {цикл идёт только до середины строки:}
      for x := 0 to W div 2 do
      begin
        {симметричные точки обмениваются цветами:}
        MemPixel := Pixel_1^;
        Pixel_1^ := Pixel_2^;
        Pixel_2^ := MemPixel;
        Inc(Pixel_1); {смещаем указатель вправо}
        Dec(Pixel_2); {смещаем указатель влево}
      end;
    end
  else {отражение по вертикали}
    {цикл идёт только до средней строки:}
    for y := 0 to H div 2 do
    begin
      {помещаем первый указатель на строку H,
       а второй на строку симметричную H:}
      Pixel_1 := Bitmap.ScanLine[y];
      Pixel_2 := Bitmap.ScanLine[H - y];
      for x := 0 to W do
      begin
        {симметричные точки обмениваются цветами:}
        MemPixel := Pixel_1^;
        Pixel_1^ := Pixel_2^;
        Pixel_2^ := MemPixel;
        Inc(Pixel_1); {смещаем указатель вправо}
        Inc(Pixel_2); {смещаем указатель вправо}
      end;
    end;
end;

Алгоритм и текстовые примеры
Основной функцией задачи является create_array_C которой в качестве параметра передаются 2 массива. Функция проверяет элементы массива А на четность (при помощи ф-ии fmod, которая возвращает остаток от деления на число). Следующее условие – проверка на совпадение элементов массива А и В. Если оба условия выполняются начинается цикл и условие проверки повторений элементов массива С. Если элементы совпадают происходит прерывание цикла (точнее двух циклов, $k и $i т.к. оператор break имеет параметр 2, который указывает на количество вложенных циклов которые нужно прервать.

function create_array_C ($array_A, $array_B)
{
$n=0;
for ($i=0; $i<=19; $i++)
 {
     for ($j=0; $j<=19; $j++)
     {
          if  (fmod ($array_A[$i],2) == 0 && $array_A[$i]==$array_B[$j]) // проверяем на четность и находим смежные елементы
          {
              for($k=0;$k<=$n;$k++)
              {
                  if($array_A[$i]==$array_C[$k]) // проверяем совпадение елементов массива
                  break(2); // в Delphi и С++ такого нет (в C# есть). Параметр 2 означает количество вложенных циклов
              }
              $array_C[$n]=$array_A[$i]; // Заносим элементы в массив С
              echo "$array_C[$n]";
              $n++;
              break;
          }

     }
 }

}

procedure Disorder(Bitmap: TBitmap; Hor, Ver: Integer; BackColor: TColor);

  function RandomInRadius(Num, Radius: Integer): Integer;
  begin
    if Random(2) = 0 then
      Result := Num + Random(Radius)
    else
      Result := Num - Random(Radius);
  end;

type
  TRGB = record
    B, G, R: Byte;
  end;
  pRGB = ^TRGB;
var
  x, y, WW, HH, xr, yr: Integer;
  Dest1, Dest2, Src1, Src2: PRGB;
  Bmp: TBitmap;
begin
  Randomize;
  Bitmap.PixelFormat := pf24Bit;
  Bmp := TBitmap.Create;
  try
    Bmp.Assign(Bitmap);
    WW := Bitmap.Width - 1;
    HH := Bitmap.Height - 1;
    Bitmap.Canvas.Brush.Color := BackColor;
    Bitmap.Canvas.FillRect(Rect(0, 0, WW + 1, HH + 1));
    for y := 0 to HH do
    begin
      for x := 0 to WW do
      begin
        xr := RandomInRadius(x, Hor);
        yr := RandomInRadius(y, Ver);
        if (xr >= 0) and (xr < WW) and (yr >= 0) and (yr < HH) then
        begin
          Src1 := Bmp.ScanLine[y];
          Src2 := Bmp.ScanLine[yr];
          Dest1 := Bitmap.ScanLine[y];
          Dest2 := Bitmap.ScanLine[yr];
          Inc(Src1, x);
          Inc(Src2, xr);
          Inc(Dest1, x);
          Inc(Dest2, xr);
          Dest1^ := Src2^;
          Dest2^ := Src1^;
        end;
      end;
    end;
  finally
    Bmp.Free;
  end;
end;

procedure Blocks(Bitmap: TBitmap; Hor, Ver, MaxOffset:
  Integer; BackColor: TColor);
{вырезаем прямоугольники со сторонами Hor Ver
и копируем их в радиусе MaxOffset}

  function RandomInRadius(Num, Radius: Integer): Integer;
  begin
    if Random(2) = 0 then
      Result := Num + Random(Radius)
    else
      Result := Num - Random(Radius);
  end;

var
  x, y, xd, yd: Integer;
  Bmp: TBitmap;
begin
  Bmp := TBitmap.Create;
  try
    Bmp.Assign(Bitmap);
    Bitmap.Canvas.Brush.Color := BackColor;
    Bitmap.Canvas.FillRect(Rect(0, 0, Bitmap.Width, Bitmap.Height));
    xd := (Bitmap.Width - 1) div Hor;
    yd := (Bitmap.Height - 1) div Ver;
    Randomize;
    for x := 0 to xd do
      for y := 0 to yd do
        BitBlt(Bitmap.Canvas.Handle,
          RandomInRadius(Hor * x, MaxOffset),
          RandomInRadius(Ver * y, MaxOffset),
          Hor, Ver, Bmp.Canvas.Handle, Hor * x, Ver * y, SRCCOPY);
  finally
    Bmp.Free;
  end;
end;

• изучить устройство и принцип заполнения D-деревьев.
• научиться использовать на практике основные алгоритмы по обработке D-деревьев

Ход работы

Разработайте программу в соответствии со следующими требованиями:

1. Создание D-дерева (случайное / ручной ввод);
2. добавление элемента в D-дерево;
3. удаление элемента из D-дерева;
4. все операции должны быть наглядно представлены.
5. Важно: обязательно соблюдение инварианта!

На форму нужно кинуть только таймер.
Вот собственно код:

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Timer1: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

const D=4;

type TIach=record
  x,y,znach:integer;
end;

var
  Form1: TForm1;
  Ia:array[0..999]of TIach;
  Xc,Yc,Col:integer;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
var i,j:integer;
begin
randomize;
Ia[0].x:=form1.Width div 2;
Ia[0].Y:=0;
Ia[0].znach:=0;
Col:=1;
Xc:=0;
Yc:=1;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var i,x:integer;
begin
form1.Canvas.FillRect(rect(0,0,form1.Width,form1.Height));
x:=0;
for i:=1 to Col-1 do
  begin
  x:=x+1;
  form1.Canvas.MoveTo(Ia[i].x,Ia[i].y*36+8);
  form1.Canvas.LineTo(Ia[(i-1)div D].x,Ia[(i-1)div D].y*36+8);
  end;

for i:=0 to Col-1 do
  begin
  form1.Canvas.Ellipse(Ia[i].x-16,Ia[i].y*36,Ia[i].x+16,Ia[i].y*36+32);
  form1.Canvas.TextOut(Ia[i].x-4,Ia[i].y*36+12,inttostr(Ia[i].znach));
  end;
end;

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var ax,ay,i:integer;
begin
if(Button=mbLeft)then
  begin
  form1.Caption:=inttostr(Xc)+':'+floattostr(power(2,Yc));
  Ia[Col].x:=round(form1.Width/(power(D,Yc)*2)*(Xc*2+1));
  Ia[Col].Y:=Yc;
  Ia[Col].znach:=Col;
  Col:=Col+1;
  Xc:=Xc+1;
  if(Xc>=round(power(D,Yc)))then
    begin
    Yc:=Yc+1;
    Xc:=0;
    end;
  end
else
  begin
  ay:=Y div 32;
  ax:=round( (x-16)/(form1.Width/(power(D,ay))) );
  for i:=round(power(D,ay)-1)+ax to Col-1 do
    Ia[ i ].znach:=Ia[ i+1 ].znach;
  Col:=Col-1;
  Xc:=Xc-1;
  if(Xc<0)then
    begin
    Yc:=Yc-1;
    Xc:=round(power(D,Yc))-1;
    end;
  form1.Caption:=inttostr(ay)+':'+inttostr(ax)+':'+inttostr( round(power(D,ay)-1));
  end;
end;

end.