procedure TfrmMainForm.DrawFractal;
var

  MyBitmap: TBitmap;
  K:  Integer;

  procedure DrawTri(a, b,  c:  TPoint);
  begin

    MyBitmap.Canvas.Polygon([a, b,  c]);
  end;

  procedure AddToSoundArray(ID: ShortString);
  begin
    Inc(K);

    SetLength(SoundsArray,  K);
    if  ID  = 'a' then
    begin
      SoundsArray[K - 1]:=  1;

    end
    else
    begin
      if  ID  = 'b' then
      begin

        SoundsArray[K - 1]:=  2;
      end
      else
      begin
        if  ID  = 'c' then

        begin
          SoundsArray[K - 1]:=  3;
        end
        else
        begin

          SoundsArray[K - 1]:=  3 + StrToInt(Copy(ID, 2,  100));
        end;
      end;
    end;
  end;

  procedure ShowFractal(a, b, c:  TPoint;  Level: Integer;  TriID:  ShortString);
  var
    abm,  acm,  bcm:  TPoint;

  begin
    if Level  = 1 then
    begin
      if  SoundActived  then

        AddToSoundArray(TriID);
      DrawTri(a, b, c);
    end
    else
    begin
      abm.X:= Round((a.X  + b.X)  / 2);

      abm.Y:= Round((a.Y  + b.Y)  / 2);

      acm.X:= Round((a.X  + c.X)  / 2);
      acm.Y:= Round((a.Y  + c.Y)  / 2);

      bcm.X:= Round((b.X  + c.X)  / 2);
      bcm.Y:= Round((b.Y  + c.Y)  / 2);

      ShowFractal(a,  abm,  acm,  Level  - 1, 'a');

      if  SoundActived  then
        AddToSoundArray('d' + IntToStr(FractalLevel - Level + 1));

      ShowFractal(acm,  bcm,  c,  Level  - 1, 'b');

      if  SoundActived  then
        AddToSoundArray('d' + IntToStr(FractalLevel - Level + 1));

      ShowFractal(abm,  b,  bcm,  Level  - 1, 'c');

      if  SoundActived  then
        AddToSoundArray('d' + IntToStr(FractalLevel - Level + 1));
    end;
  end;
begin

  try
    Screen.Cursor:= crHourGlass;

    MyBitmap:=  TBitmap.Create;

    with  MyBitmap  do

    begin
      Canvas.Pen.Color:= clBlack;
      Width:=  imgWhiteBoard.Width;
      Height:= imgWhiteBoard.Height;
    end;

    Set3Point;
    K:= 0;

    MyBitmap.Canvas.Brush.Color:= $009FE6FD;
    ShowFractal(Points[1],  Points[2],  Points[3],  FractalLevel, 'a');

    imgWhiteBoard.Picture.Graphic:= MyBitmap;
    imgWhiteBoard.Refresh;
    Caption:= 'مرحله '  +  IntToStr(FractalLevel);

    if SoundActived and SetNotes then
      abfThreadComponent.Execute

    else
      sbtnSound.Down:= False;
     
  finally
    Screen.Cursor:= crDefault;
    MyBitmap.Free;

  end;
end;

procedure TfrmMainForm.DrawFractal;
var
  MyBitmap: TBitmap;

  K:  Integer;

  procedure ShowFractal(a,  b:  TPoint; Ang:  Real; LLen,  Level, LineID: Integer);
  var

    P1, P2: TPoint;

    procedure DrawLine(X, Y:  TPoint; LID:  Integer);
    begin
      with  MyBitmap.Canvas do

      begin
        MoveTo(X.X, X.Y);
        LineTo(Y.X, Y.Y);

        if  SoundActived  then
        begin

          Inc(K);
          SetLength(SoundsArray,  K);
          SoundsArray[K - 1]:=  LID;
        end;
      end;

    end;

  begin
    if  Level = 1 then
    begin
      DrawLine(a, b,  LineID);

    end
    else
    begin
      LLen:=  Round(2 * LLen  / 3);

      Ang:= Ang - Pi  / 4;

      P1.X:=  b.X + Round(Sin(Ang) * LLen);
      P1.Y:=  b.Y + Round(Cos(Ang) * LLen);
      ShowFractal(b,  P1, Ang,  LLen, Level - 1,  LineID  + 1);

      Ang:= Ang + Pi  / 2;
      P2.X:=  b.X + Round(Sin(Ang) * LLen);
      P2.Y:=  b.Y + Round(Cos(Ang) * LLen);
      ShowFractal(b,  P2, Ang,  LLen, Level -  1, LineID  + 1);

      DrawLine(a, b,  LineID);
    end;
  end;
begin
  try
    Screen.Cursor:= crHourGlass;

    SetInitLine;

    MyBitmap:=  TBitmap.Create;
    with  MyBitmap  do
    begin

      Canvas.Pen.Color:= clOlive;
      Canvas.Pen.Width:=  3;
      Width:=  imgWhiteBoard.Width;
      Height:= imgWhiteBoard.Height;
    end;

    K:= 0;

    ShowFractal(InitLine.P1,  InitLine.P2,  Pi,  LineLen, FractalLevel, 1);

    imgWhiteBoard.Picture.Graphic:= MyBitmap;
    imgWhiteBoard.Refresh;

    Caption:= 'مرحله '  +  IntToStr(FractalLevel);

    if SoundActived then
    begin
      sbtnSound.Enabled:= SetNotes;
      abfThreadComponent.Execute;

    end;

  finally
    Screen.Cursor:= crDefault;
    MyBitmap.Free;
  end;
end;

procedure TfrmMainForm.DrawFractal;
var
  MyBitmap: TBitmap;
  NewPoint: TPoint;
  MaxX, MaxY, I,  J,  K: Integer;

  Table:  array of array  of  Integer;
  CurCl:  Integer;

  function  ExistPRoundOfP(X, Y:  Integer):  Boolean;

  begin
    Result:=  False;
    if  ((Y - 1) > 0)  and (Table[Y - 1, X]  >= 0) then

    begin
      Result:=  True;
      Exit;
    end;

    if  ((X + 1) < MaxX)  and (Table[Y, X + 1]  >=  0) then

    begin
      Result:=  True;
      Exit;
    end;

    if  ((Y + 1) < MaxY)  and (Table[Y  + 1, X]  >=  0) then

    begin
      Result:=  True;
      Exit;
    end;

    if  ((X - 1) > 0)  and (Table[Y, X  - 1]  >=  0) then

      Result:=  True;
  end;

  function  GetRandomStartP:  TPoint;
  var

    Zel:  Integer;
  begin
    Zel:= Random(4);

    case  Zel of
      0:

      begin
        Result.X:=  Random(MaxX);
        Result.Y:=  0;
      end;
      1:

      begin
        Result.X:=  MaxX;
        Result.Y:=  Random(MaxY);
      end;
      2:

      begin
        Result.X:=  Random(MaxX);
        Result.Y:=  MaxY;
      end;
      3:

      begin
        Result.X:=  0;
        Result.Y:=  Random(MaxY);
      end;
    end;

  end;

  function  GetNewRandomPoint(X, Y:  Integer):  TPoint;
  var
    Jehat:  0..3;

  begin
    Jehat:= Random(4);

    case  Jehat of
      0:
      begin

        Result.X:=  X;
        Result.Y:=  Y - 1;
      end;
      1:
      begin

        Result.X:=  X + 1;
        Result.Y:=  Y;
      end;
      2:
      begin

        Result.X:=  X;
        Result.Y:=  Y + 1;
      end;
      3:
      begin

        Result.X:=  X - 1;
        Result.Y:=  Y;
      end;
    end;

    if  Result.X  < 0 then

      Result.X:=  MaxX
    else
      if  Result.X  > MaxX  then

        Result.X:=  0;

    if  Result.Y  < 0 then
      Result.Y:=  MaxY

    else
      if  Result.Y  > MaxY  then
        Result.Y:=  0;

  end;

  function  Trace:  TPoint;
  begin
    Result:=  GetRandomStartP;

    while not ExistPRoundOfP(Result.X,  Result.Y)  do
      Result:= GetNewRandomPoint(Result.X,  Result.Y);
  end;

  procedure PaintTable;

  var
    I,  J:  Integer;
  begin
    with  MyBitmap.Canvas do

      for I:= 0 to  High(Table) do
        for J:= 0 to  High(TAble[I]) do
          if  Table[I,  J]  > 0 then

            Pixels[J, I]:=  Table[I,  J];

    imgWhiteBoard.Picture.Graphic:= MyBitmap;
    imgWhiteBoard.Refresh;
  end;

  procedure SetPointNote(P: TPoint);

  var
    Section,  X,  Y:  Integer;
    C:  Variant;

    Arg:  Double;
  begin
    X:= P.X - Round(MaxX  / 2);
    Y:= Round(MaxY  / 2)  - P.Y;

    C:= VarComplexCreate(X, Y);
    Arg:= VarComplexAngle©;
    Section:= Round((Arg + Pi) * SecCount / (2 * Pi));

    Inc(K);
    SetLength(SoundsArray,  K);

    SoundsArray[K - 1]:=  Section;
  end;
begin
  Randomize;
  prgFractal.Max:=  StrToInt(edtPointsCount.Text);

  SecCount:=  StrToInt(edtSecCount.Text);
  K:= 0;

  MaxX:=  imgWhiteBoard.Width;
  MaxY:=  imgWhiteBoard.Height;

  MyBitmap:=  TBitmap.Create;
  with  MyBitmap  do
  begin
    Width:= MaxX;

    Height:=  MaxY;
  end;

  SetLength(Table,  MaxY  + 1);
  for I:= 0 to  High(Table) do

    SetLength(Table[I],  MaxX  + 1);

  for I:= 0 to  High(Table) do
    for J:= 0 to  High(Table[I]) do

      Table[I,  J]:=  -1;

  imgWhiteBoard.Picture.Graphic:= MyBitmap;
  imgWhiteBoard.Refresh;

  try
    Screen.Cursor:= crHourGlass;

    CurCl:= clRed;
    Table[Round(MaxY / 2), Round(MaxX  / 2)]:= 0;
    for I:= 1 to  StrToInt(edtPointsCount.Text)  - 1 do
    begin

      NewPoint:=  Trace;
      Table[NewPoint.Y,  NewPoint.X]:= CurCl;

      if  SoundActived  then

        SetPointNote(NewPoint);

      prgFractal.Position:= prgFractal.Position + 1;
      CurCl:= TColor(RGB(Random(256), Random(256), Random(256)));
      if  I mod 1000  = 0 then
        PaintTable;

    end;

    PaintTable;

    if SoundActived then
    begin
      sbtnSound.Enabled:= SetNotes;
      abfThreadComponent.Execute;

    end;
  finally
    for I:= 0 to  High(Table) do
      SetLength(Table[I],  0);
    SetLength(Table,  0);

    prgFractal.Position:= 0;
    Screen.Cursor:= crDefault;
    MyBitmap.Free;
  end;
end;