|
|
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.
|
|