Equation drawer source listing


This is the Delphi-7 source code listing for the equation grapher.
Click to return to the article on formula translation.

unit eqdrawer;
{ draw equation just parsed
  for test purposes only.
  use 640 * 480 coordinate system with (0,0) at pixel location (320,240)
  for type 3 equations: v domain is 0 to 10 in 400 steps
  paintbox1 of form1
}

interface

uses graphics,classes;

procedure drawequation;

implementation

uses unit1,xlate;

const boxwidth = 640;
      boxheight = 480;

var eqtype : byte;//1,2,3,4

//--- support

function y2pix(y : double) : longInt;
//convert y double value to pixel
begin
 result := trunc(240.5 - y*40);
end;

function x2pix(x : double) : longInt;
//convert x double to pixel
begin
 result := trunc(320.5 + x*40);
end;

function pix2x(p : longInt) : double;
//convert pixel x to x coordinate
begin
 result := 0.025*(p - 320);
end;

function pix2y(p : longInt) : double;
//convert pixel y to y coordinate
begin
 result := 0.025*(240 - p);
end;

//--- drawing equations ---

procedure drawtype1;
//x from -8 to 8 in steps of 0.025
var x,y1,y2 : double;
      i : longInt;
  valid : boolean;
 vcount : byte;
begin
 y1 := 0; y2 := 0;
 with form1.PaintBox1.Canvas do
  begin
   pen.Color := $ff;
   pen.Width := 1;
   vcount := 0;
   for i := 0 to 639 do
    begin
     x := pix2x(i);
     setX(x);
     calculate(valid);
     if valid then
      begin
       y2 := y1;
       y1 := getY;
       if vcount < 2 then inc(vcount);
      end else vcount := 0;
     case vcount of
        1 : moveto(i,y2pix(y1));
        2 : if abs(y2-y1) < 12 then lineto(i,y2pix(y1))
             else moveto(i,y2pix(y1));
     end;//case
    end;//for i
  end;//with form1
end;

procedure drawtype2;
//y from -6 to 6 in steps of 0.025
var y,x1,x2 : double;
      i : longInt;
  valid : boolean;
 vcount : byte;
begin
 x1 := 0; x2 := 0;
 with form1.PaintBox1.Canvas do
  begin
   pen.Color := $ff;
   pen.Width := 1;
   vcount := 0;
   for i := 0 to 479 do
    begin
     y := pix2y(i);
     setY(y);
     calculate(valid);
     if valid then
      begin
       x2 := x1;
       x1 := getX;
       if vcount < 2 then inc(vcount);
      end else vcount := 0;
     case vcount of
        1 : moveto(x2pix(x1),i);
        2 : if abs(x2-x1) < 16 then lineto(x2pix(x1),i)
             else moveto(x2pix(x1),i);
     end;//case
    end;//for i
  end;//with form1begin
end;

procedure drawtype3;
//v runs from 0..10 in 400 steps
var y,x,v : double;
      i : longInt;
  valid : boolean;
 vcount : byte;
begin
 x := 0; y := 0;
 with form1.PaintBox1.Canvas do
  begin
   pen.Color := $ff;
   pen.Width := 1;
   vcount := 0;
   for i := 0 to 400 do
    begin
     v := i*0.025;
     setV(v);
     calculate(valid);
     if valid then
      begin
       x := getX;
       y := getY;
       if vcount < 2 then inc(vcount);
      end else vcount := 0;
     case vcount of
        1 : moveto(x2pix(x),y2pix(y));
        2 : lineto(x2pix(x),y2pix(y));
     end;//case
    end;//for i
  end;//with form1begin
end;

procedure drawtype4;
//scan all pixels, calculate v
//paint dot when v changes sign or v = 0
const pixcolor = $0000ff;
var x : array[0..boxwidth-1] of double;
    v : array[0..boxwidth-1] of double;
    code : array[0..boxwidth] of byte;//$80:valid; $01: > 0; $02: < 0; $03: = 0
    i,j :longInt;
    nextcode : byte;
    nextv : double;
    OK : boolean;
begin
 code[boxwidth] := 0;//set invalid
 for i := 0 to boxwidth-1 do
  begin
   x[i] := pix2x(i); //for time saving
   code[i] := 0;     //set invalid
  end;
 with form1.PaintBox1.Canvas do
  for j := 0 to boxheight-1 do
   begin
    setY(pix2Y(j));
    for i := 0 to boxwidth-1 do    //calc new row and check against pixel above
     begin
      setX(x[i]);
      calculate(OK);
      if OK then
       begin
        nextV := getV;
        if nextV = 0 then nextcode := $83
         else if nextV > 0 then nextcode := $81 else nextcode := $82;
        if nextcode and code[i] = $80 then
         begin
          if abs(nextV) <= abs(v[i]) then pixels[i,j] := pixcolor
           else pixels[i,j-1] := pixcolor;
         end;
        v[i] := nextV;
       end //if OK
        else nextcode := 0;
      code[i] := nextcode;
     end;//for i
    for i := 0 to boxwidth-1 do   //horizontal test
     if code[i] = $83 then pixels[i,j] := pixcolor
      else
       if code[i] and code[i+1] = $80 then
        if abs(v[i]) <= abs(v[i+1]) then pixels[i,j] := pixcolor
         else pixels[i+1,j] := pixcolor;
   end;//for j
end;

//--- central call ---

procedure drawequation;
var i : word;
begin
 with form1.paintbox1 do with canvas do
  begin
   brush.color := $e0f0f0;
   brush.style := bssolid;
   pen.color := 0;
   pen.width := 1;
   fillrect(rect(0,0,width,height));
   pen.color := $e0e0e0;
   i := 20;
   while i < width do
    begin
     moveto(i,0);
     lineto(i,height);
     inc(i,40);
    end;
   i := 40;
   pen.color := $c0c0c0;
   while i < width do
    begin
     moveto(i,0);
     lineto(i,height);
     inc(i,40);
    end;
   i := 20;
   pen.color := $e0e0e0;
   while i < height do
    begin
     moveto(0,i);
     lineto(width,i);
     inc(i,40);
    end;
   i := 40;
   pen.color := $c0c0c0;
   while i < height do
   begin
     moveto(0,i);
     lineto(width,i);
     inc(i,40);
    end;
  pen.color := $f00000;
  moveto(320,0);
  lineto(320,height);
  moveto(0,240);
  lineto(width,240);
  pen.color := 0;
  brush.style := bsclear;
  rectangle(0,0,width,height);
  end;
  eqtype := getEqType;
  case eqtype of
   1 : drawtype1;
   2 : drawtype2;
   3 : drawtype3;
   4 : drawtype4;
  end;
end;

end.