Drawing binary trees

Posted by Michael
This project started with my (by the way pretty awesome) math teacher showing me his own program to draw binary trees (in VB). He challenged me to do it better! Of course, I took up the challenge and started coding right away.
While his program still draws the trees faster, my program has a lot more features and settings to play with. I did think about doing the drawing in DirectDraw, which would have been very quick, but it would take too much time to figure out how to do that. I just draw the tree on a regular tbitmap – with or without updating the screen.
Recursive functions
The program uses a recursive function – actually, it uses two, but only for the cause of speed. One for drawing the tree with “Update screen and abort with ESC” enabled and one for the same, just disabled.
Branch colors
The only thing not completely working in this program is the color code. The function for calculating the branch color will sometimes output a weird color. That piece of code needs some love.
Animation
The program has a tab for creating frames for an animation. I just draws a batch of images, and saves each of them in a folder as BMP. Make sure the folder exists (there is no code for checking that)!.
I have included 2 videos - see them under attached files.
unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, Spin, Math, XPMan, ComCtrls, ExtDlgs, FileCtrl;
 
type
  TForm1 = class(TForm)
    Button1: TButton;
    XPManifest1: TXPManifest;
    ColorDialog1: TColorDialog;
    Bevel1: TBevel;
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    SpinEdit1: TSpinEdit;
    Label1: TLabel;
    Label2: TLabel;
    SpinEdit2: TSpinEdit;
    Label3: TLabel;
    Edit1: TEdit;
    Label4: TLabel;
    SpinEdit3: TSpinEdit;
    CheckBox2: TCheckBox;
    Label5: TLabel;
    Label6: TLabel;
    Shape1: TShape;
    Shape2: TShape;
    Label7: TLabel;
    Shape3: TShape;
    RadioButton1: TRadioButton;
    RadioButton2: TRadioButton;
    Label8: TLabel;
    Label9: TLabel;
    CheckBox1: TCheckBox;
    TabSheet3: TTabSheet;
    Image1: TImage;
    Button2: TButton;
    SaveDialog1: TSaveDialog;
    RadioButton3: TRadioButton;
    RadioButton4: TRadioButton;
    Label10: TLabel;
    SpinEdit4: TSpinEdit;
    SpinEdit5: TSpinEdit;
    Label11: TLabel;
    SpinEdit6: TSpinEdit;
    SpinEdit7: TSpinEdit;
    Label12: TLabel;
    Label13: TLabel;
    Edit2: TEdit;
    Button3: TButton;
    Button4: TButton;
    Label14: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure RadioButton1Click(Sender: TObject);
    procedure RadioButton2Click(Sender: TObject);
    procedure Shape3MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Shape2MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Shape1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.dfm}
 
// Calculate the color of a specific branch
Function GetColor(FromColor, ToColor:TColor; TotalColors, ReturnColorNumber:Integer): TColor;
var
  FR, FG, FB, TR, TG, TB: byte;
  ReturnR, ReturnG, ReturnB: Byte;
begin
  if ReturnColorNumber = 1 then // No reason to calculate the "FromColor"
    Result := FromColor
  else
    if ReturnColorNumber = TotalColors then // No reason to calculate the "ToColor"
      Result := ToColor
    else
      begin // If the branch is not 1 or the last one:
 
        FR := GetRValue(FromColor);    // Take the red value
        FG := GetGValue(FromColor);    // Take the green value
        FB := GetBValue(FromColor);    // etc.
        TR := GetRValue(ToColor);
        TG := GetGValue(ToColor);
        TB := GetBValue(ToColor);
 
        // Calculate the color - it's not fully working!
        ReturnR := round(((TR-FR)/(TotalColors-1))*(ReturnColorNumber-1) +TR);
        ReturnG := round(((TG-FG)/(TotalColors-1))*(ReturnColorNumber-1) +TG);
        ReturnB := round(((TB-FB)/(TotalColors-1))*(ReturnColorNumber-1) +TB);
 
        Result := RGB(ReturnR, ReturnG, ReturnB);  // Convert to a color
      end;
end;
 
// Disable controls while drawing the tree
procedure DisableControls(disable: boolean);
begin
  if disable = true then
    with Form1 do
      begin
        SpinEdit1.Enabled := False;
        SpinEdit2.Enabled := False;
        SpinEdit3.Enabled := False;
        SpinEdit4.Enabled := False;
        SpinEdit5.Enabled := False;
        SpinEdit6.Enabled := False;
        SpinEdit7.Enabled := False;
        Edit1.Enabled := False;
        Edit2.Enabled := False;
        CheckBox2.Enabled := False;
        CheckBox1.Enabled := False;
        RadioButton1.Enabled := False;
        RadioButton2.Enabled := False;
        RadioButton3.Enabled := False;
        RadioButton4.Enabled := False;
        Shape1.Enabled := False;
        Shape2.Enabled := False;
        Shape3.Enabled := False;
        Button1.Enabled := False;
        Button2.Enabled := False;
        Button3.Enabled := False;
        Button4.Enabled := False;
      end
  else
    with Form1 do
      begin
        SpinEdit1.Enabled := True;
        SpinEdit2.Enabled := True;
        SpinEdit3.Enabled := True;
        SpinEdit4.Enabled := True;
        SpinEdit5.Enabled := True;
        SpinEdit6.Enabled := True;
        SpinEdit7.Enabled := True;
        Edit1.Enabled := True;
        Edit2.Enabled := True;
        CheckBox2.Enabled := True;
        if RadioButton1.Checked then
          CheckBox1.Enabled := True;
        RadioButton1.Enabled := True;
        RadioButton2.Enabled := True;
        RadioButton3.Enabled := True;
        RadioButton4.Enabled := True;
        Shape1.Enabled := True;
        Shape2.Enabled := True;
        Shape3.Enabled := True;
        Button1.Enabled := True;
        Button2.Enabled := True;
        Button3.Enabled := True;
        Button4.Enabled := True;
      end;
end;
 
 
// To draw an antialiased line.
// Thanks to http://www.delphi3000.com/articles/article_1566.asp
procedure AALine(x1,y1,x2,y2 : single; color : tcolor; canvas : tcanvas);
function CrossFadeColor(FromColor,ToColor : TColor; Rate : Single) : TColor;
var r,g,b : byte;
begin
  r:=Round(GetRValue(FromColor)*Rate+GetRValue(ToColor)*(1-Rate));
  g:=Round(GetGValue(FromColor)*Rate+GetGValue(ToColor)*(1-Rate));
  b:=Round(GetBValue(FromColor)*Rate+GetBValue(ToColor)*(1-Rate));
  Result:=RGB(r,g,b);
end;
procedure hpixel(x : single; y : integer);
var FadeRate : single;
begin
  FadeRate:=x-trunc(x);
  with canvas do
  begin
    pixels[trunc(x),y]:=CrossFadeColor(Color,Pixels[Trunc(x),y],1-FadeRate);
    pixels[trunc(x)+1,y]:=CrossFadeColor(Color,Pixels[Trunc(x)+1,y],FadeRate);
  end;
end;
 
procedure vpixel(x : integer; y : single);
var FadeRate : single;
begin
  FadeRate:=y-trunc(y);
  with canvas do
  begin
    pixels[x,trunc(y)]:=CrossFadeColor(Color,Pixels[x,Trunc(y)],1-FadeRate);
    pixels[x,trunc(y)+1]:=CrossFadeColor(Color,Pixels[x,Trunc(y)+1],FadeRate);
  end;
end;
 
var i : integer;
    ly,lx,currentx,currenty,deltax,deltay,l,skipl : single;
begin
  if (x1<>x2) or (y1<>y2) then
  begin
    currentx:=x1;
    currenty:=y1;
    lx:=abs(x2-x1);
    ly:=abs(y2-y1);
 
    if lx>ly then
    begin
      l:=trunc(lx);
      deltay:=(y2-y1)/l;
      if x1>x2 then
      begin
        deltax:=-1;
        skipl:=(currentx-trunc(currentx));
      end else
      begin
        deltax:=1;
        skipl:=1-(currentx-trunc(currentx));
      end;
    end else
    begin
      l:=trunc(ly);
      deltax:=(x2-x1)/l;
      if y1>y2 then
      begin
        deltay:=-1;
        skipl:=(currenty-trunc(currenty));
      end else
      begin
        deltay:=1;
        skipl:=1-(currenty-trunc(currenty));
      end;
    end;
 
    currentx:=currentx+deltax*skipl;
    currenty:=currenty+deltay*skipl;
 
    for i:=1 to trunc(l) do
    begin
      if lx>ly then vpixel(trunc(currentx),currenty) else hpixel(currentx,trunc(currenty));
      currentx:=currentx+deltax;
      currenty:=currenty+deltay;
    end;
  end;
end;
 
// Draw a branch, and do not check for ESC press (recursive function)
 
 
 
procedure DrawBranchNoESC(TheCanvas:TCanvas;Depth:Integer; X, Y, Length, Theta, LenghtScale, dtheta:Single);
var
  x1, y1: Integer;
  TheColor: TColor;
begin
  x1 := round(X + length * cos(theta)); // Calculate the next point
  y1 := round(Y + length * sin(theta)); //
 
  // Decide the branch color
  TheColor := GetColor(Form1.Shape2.Brush.Color,Form1.Shape1.Brush.Color,Form1.SpinEdit1.Value,Depth);
 
  if Form1.RadioButton2.Checked then // Is antialised line checked?
    AALine(x,y,x1,y1,TheColor,TheCanvas) // Then draw an antialiased line
  else
    begin // Draw regular jaggy line
      if Form1.CheckBox1.Checked then // Is variable thickness checked?
        TheCanvas.Pen.Width := Depth // Then the pen width is equal the branch depth
      else
        TheCanvas.Pen.Width := 1; // Otherwise, the pen width is 1
      TheCanvas.Pen.Color := TheColor;
      TheCanvas.MoveTo(round(x),round(y));
      TheCanvas.LineTo(x1,y1);
    end;
 
  if Depth > 1 then // if there are more branches to draw...
    begin
      // Call this very same code again twice - one going to the left and one to the right
      DrawBranchNoESC(TheCanvas, Depth-1, x1, y1, Length*LenghtScale, Theta+dtheta, LenghtScale, dtheta);
      DrawBranchNoESC(TheCanvas, Depth-1, x1, y1, Length*LenghtScale, Theta-dtheta, LenghtScale, dtheta);
    end;
 
end;
 
 
// Draw a branch, and DO check for ESC press (recursive function)
procedure DrawBranchCheckESC(TheCanvas:TCanvas;Depth:Integer; X, Y, Length, Theta, LenghtScale, dtheta:Single);
var
  x1, y1: Integer;
  TheColor: TColor;
begin
  // The following three lines are the only difference (compared to the code above)
  Application.ProcessMessages; // Take a breath!
  if GetKeyState(VK_Escape) and 128 = 128 then // Is ESC pressed?
    Exit; // Stop drawing
 
  x1 := round(X + length * cos(theta));
  y1 := round(Y + length * sin(theta));
 
  TheColor := GetColor(Form1.Shape2.Brush.Color,Form1.Shape1.Brush.Color,Form1.SpinEdit1.Value,Depth);
 
  if Form1.RadioButton2.Checked then
    begin
      AALine(x,y,x1,y1,TheColor,TheCanvas)
    end
  else
    begin
      if Form1.CheckBox1.Checked then
        TheCanvas.Pen.Width := Depth
      else
        TheCanvas.Pen.Width := 1;
      TheCanvas.Pen.Color := TheColor;
      TheCanvas.MoveTo(round(x),round(y));
      TheCanvas.LineTo(x1,y1);
    end;
 
  if Depth > 1 then
    begin
      DrawBranchCheckESC(TheCanvas, Depth-1, x1, y1, Length*LenghtScale, Theta+dtheta, LenghtScale, dtheta);
      DrawBranchCheckESC(TheCanvas, Depth-1, x1, y1, Length*LenghtScale, Theta-dtheta, LenghtScale, dtheta);
    end;
end;
 
procedure TForm1.Button1Click(Sender: TObject);
var
  BeginTime: Integer;
begin
  DisableControls(True); // Disable controls.
  Label14.Caption := ''; // Reset the "number of ms" label
  BeginTime := GetTickCount; // Start the stopwatch! (inaccuracy: about +/- 16 ms)
 
  // Reset the image
  Image1.Picture.Bitmap.Height := Image1.Height;
  Image1.Picture.Bitmap.Width := Image1.Width;
  Image1.Canvas.Brush.Color := Shape3.Brush.Color;
  Image1.Canvas.Rectangle(0,0,Image1.Width+1, Image1.Height+1);
 
  // Is "Update screen and abort with ESC" checked?
  if CheckBox2.Checked then
    DrawBranchCheckESC(Image1.Canvas,SpinEdit1.Value,Image1.Width div 2,Image1.Height,SpinEdit3.Value,degtorad(270),StrToFloat(Edit1.Text),degtorad(SpinEdit2.Value))
  else
    DrawBranchNoESC(Image1.Canvas,SpinEdit1.Value,Image1.Width div 2,Image1.Height,SpinEdit3.Value,degtorad(270),StrToFloat(Edit1.Text),degtorad(SpinEdit2.Value));
  // Drawing is done!
  // Write the draw time to label
  Label14.Caption := 'Drawing time: ' + IntToStr(GetTickCount-BeginTime)+' ms';
 
  DisableControls(False);  // Re-enable controls
end;
 
// To select the color
procedure TForm1.Shape1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  ColorDialog1.Color := Shape1.Brush.Color;
  If ColorDialog1.Execute then
    Shape1.Brush.Color := ColorDialog1.Color;
end;
 
// To select the color
procedure TForm1.Shape2MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  ColorDialog1.Color := Shape2.Brush.Color;
  If ColorDialog1.Execute then
    Shape2.Brush.Color := ColorDialog1.Color;
end;
 
// To select the color
procedure TForm1.Shape3MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  ColorDialog1.Color := Shape3.Brush.Color;
  If ColorDialog1.Execute then
    Shape3.Brush.Color := ColorDialog1.Color;
end;
 
procedure TForm1.RadioButton2Click(Sender: TObject);
begin
  if RadioButton2.Checked then
    CheckBox1.Enabled := False
  else
    CheckBox1.Enabled := True;
end;
 
procedure TForm1.RadioButton1Click(Sender: TObject);
begin
  if RadioButton1.Checked then
    CheckBox1.Enabled := True
  else
    CheckBox1.Enabled := False;
end;
 
// To save the binary tree
procedure TForm1.Button2Click(Sender: TObject);
begin
  if SaveDialog1.Execute then
    Image1.Picture.SaveToFile(SaveDialog1.FileName);
end;
 
procedure TForm1.Button3Click(Sender: TObject);
var
  Dir: string;
begin
  Dir := 'C:';
  if SelectDirectory('Select an output folder:', 'C:', Dir) then
    Edit2.Text := Dir;
end;
 
// This makes and saves all the frames required for animation
procedure TForm1.Button4Click(Sender: TObject);
var
  i: Integer;
begin
  DisableControls(True);
  if RadioButton3.Checked then  // Different branch length
    begin
      for i := SpinEdit4.Value to SpinEdit5.Value do
        begin
          Image1.Picture.Bitmap.Height := Image1.Height;
          Image1.Picture.Bitmap.Width := Image1.Width;
          Image1.Canvas.Brush.Color := Shape3.Brush.Color;
          Image1.Canvas.Rectangle(0,0,Image1.Width+1, Image1.Height+1);
 
          if CheckBox2.Checked then
            DrawBranchCheckESC(Image1.Canvas,SpinEdit1.Value,Image1.Width div 2,Image1.Height,i,degtorad(270),StrToFloat(Edit1.Text),degtorad(SpinEdit2.Value))
          else
            DrawBranchNoESC(Image1.Canvas,SpinEdit1.Value,Image1.Width div 2,Image1.Height,i,degtorad(270),StrToFloat(Edit1.Text),degtorad(SpinEdit2.Value));
          Image1.Picture.SaveToFile(IncludeTrailingBackslash(Edit2.Text)+'BinaryTree_'+IntToStr(i)+'.bmp');
        end;
 
 
    end;
  if RadioButton4.Checked then  // Different branch depth
    begin
      for i := SpinEdit6.Value to SpinEdit7.Value do
        begin
          Image1.Picture.Bitmap.Height := Image1.Height;
          Image1.Picture.Bitmap.Width := Image1.Width;
          Image1.Canvas.Brush.Color := Shape3.Brush.Color;
          Image1.Canvas.Rectangle(0,0,Image1.Width+1, Image1.Height+1);
 
          if CheckBox2.Checked then
            DrawBranchCheckESC(Image1.Canvas,i,Image1.Width div 2,Image1.Height,SpinEdit3.Value,degtorad(270),StrToFloat(Edit1.Text),degtorad(SpinEdit2.Value))
          else
             DrawBranchNoESC(Image1.Canvas,i,Image1.Width div 2,Image1.Height,SpinEdit3.Value,degtorad(270),StrToFloat(Edit1.Text),degtorad(SpinEdit2.Value));
 
          Image1.Picture.SaveToFile(IncludeTrailingBackslash(Edit2.Text)+'BinaryTree_'+IntToStr(i)+'.bmp');
        end;
    end;
 
  DisableControls(False);
end;
 
// Select the first tab on program start
procedure TForm1.FormCreate(Sender: TObject);
begin
  PageControl1.ActivePageIndex := 0;
end;
 
end.
Attachment	Size
Animation (.wmv) - growing size	149.85 KB
Animation (.wmv) - increasing depth	125.59 KB
Drawing binary trees

Menu

Subscribe

Search
