unit Unit1;
{ paint graph of a function
shows scales handling
avoid plotting of asymptotes by use of 2nd derivative
}
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Buttons, ExtCtrls;
type
TForm1 = class(TForm)
plotbox: TPaintBox;
centerYtext: TStaticText;
centerXtext: TStaticText;
yscaletext: TStaticText;
xscaletext: TStaticText;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
formula1btn: TSpeedButton;
Label5: TLabel;
formula2btn: TSpeedButton;
formula4btn: TSpeedButton;
formula5btn: TSpeedButton;
plotbtn: TBitBtn;
clearBtn: TBitBtn;
Timer1: TTimer;
SpeedButton1: TSpeedButton;
formula3Btn: TSpeedButton;
autoplotcheck: TCheckBox;
procedure clearBtnClick(Sender: TObject);
procedure FormPaint(Sender: TObject);
procedure plotboxPaint(Sender: TObject);
procedure centerXtextMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Timer1Timer(Sender: TObject);
procedure centerXtextMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure SpeedButton1Click(Sender: TObject);
procedure formula1btnClick(Sender: TObject);
procedure plotbtnClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
const maxscalecode = 9;
minscalecode = 0;
maxCenter = 1000;
minCenter = -1000;
scalesBase : array[0..2] of single = (1, 2, 5);
scalesExp : array[0..3] of single = (0.01, 0.1, 1, 10);
var centerX : single = 0;
centerY : single = 0;
scaleX : single = 1;
scaleY : single = 1;
scaleCodeX : byte = 6;
scaleCodeY : byte = 6;
timercode : byte = 0;
formulaNr : byte = 1;
procedure showScales;
const fstring = '##0.0##';
begin
with form1 do
begin
Xscaletext.caption := formatfloat(fstring,scaleX);
Yscaletext.caption := formatfloat(fstring,scaleY);
centerXtext.Caption := formatfloat(fstring,centerX);
centerYtext.Caption := formatfloat(fstring,centerY);
end;
end;
procedure scalecode2scales;
// scaleCode = scaleBaseIndex + 3*scalesExpIndex
var i,j: byte;
begin
i := scalecodeX mod 3;
j := scalecodeX div 3;
scaleX := scalesBase[i] * scalesExp[j];
centerX := round(centerX/scaleX) * scaleX; //make center multiple of scale
i := scaleCodeY mod 3;
j := scaleCodeY div 3;
scaleY := scalesBase[i] * scalesExp[j];
centerY := round(centerY/scaleY) * scaleY; //make center multiple of scale
end;
procedure resetScales;
begin
scaleCodeX := 6;
scaleCodeY := 6;
centerX := 0;
centerY := 0;
scaleCode2Scales;
showscales;
end;
procedure clearPlotBox;
var i : word;
zX,zY : smallInt;
begin
with form1.plotbox do with canvas do
begin
brush.color := $f0ffff;
brush.style := bsSolid;
fillrect(rect(0,0,width,height));
i := 10;
while i < width do
begin
if i = 410 then pen.Style := psDot else pen.Style := psSolid;
if (i-10) mod 40 = 0 then pen.Color := $ffc0c0 else pen.Color := $ffe0e0;
moveto(i,10);
lineto(i,height-10);
inc(i,20);
end;
i := 10;
while i < height do
begin
if i = 330 then pen.Style := psDot else pen.Style := psSolid;
if (i-10) mod 40 = 0 then pen.color := $ffc0c0 else pen.Color := $ffe0e0;
moveto(10,i);
lineto(width-10,i);
inc(i,20);
end;
zX := 410 - trunc(40*centerXscaleX);
if (zX>=10) and (zX <= width-10) then
begin
pen.color := $ff;
moveto(zX,10);
lineto(zX,height-10);
end;
zY := 330 + trunc(40*centerYscaleY);
if (zY>=10) and (zY<=height-10) then
begin
pen.color := $ff;
moveto(10,zY);
lineto(width-10,zY);
end;
end;
end;
function pix2X(px : smallInt) : single;
//pixel value px to x value
begin
result := centerX+0.025*(px-410)*scaleX;
end;
function getValue(x : single; var v : boolean) : single;
//calculate function value
var sqx : single;
begin
result := 0;
try
case formulaNr of
1 : result := 0.1*x*x-6;
2 : result := sqrt(64-sqr(x));
3 : begin
sqx := x*x;
result := sqx*(-0.01*sqx +0.5);
end;
4 : result := 1/(x-2.001);
5 : result := 5/((x-4.001)*(x+3.999));
end;//case
v := true;
except
v := false;
end;
end;
function getPixelValue(y : single) : smallInt;
var pixY : single;
begin
PixY := 330 - 40*(y-centerY)/scaleY;
if PixY < 0 then pixY := -1; //avoid integer overflowing
if PixY >= 660 then PixY := 660;
result := round(PixY);
end;
// --- events ---
procedure TForm1.clearBtnClick(Sender: TObject);
begin
clearPlotbox;
end;
procedure TForm1.FormPaint(Sender: TObject);
//paint edge around plotbox
var x1,y1,x2,y2 : word;
i : byte;
begin
showscales;
with plotbox do
begin
x1 := Left-2;
y1 := Top - 2;
x2 := Left + Width+1;
y2 := top + height+1;
end;
with canvas do //form1.canvas
begin
pen.Width := 1;
for i := 0 to 1 do
begin
pen.color := $000000;
moveto(x2-i,y1+i);
lineto(x1+i,y1+i);
lineto(x1+i,y2-i);
pen.color := $808080;
lineto(x2-i,y2-i);
lineto(x2-i,y1+i);
end;
end;
end;
procedure TForm1.plotboxPaint(Sender: TObject);
begin
clearPlotBox;
end;
procedure TForm1.centerXtextMouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
timercode := Tstatictext(sender).Tag;
if button = mbRight then inc(timercode,4);
timer1.Interval := 300;
timer1timer(self);
timer1.Enabled := true;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
case timercode of
1 : if scaleCodeX < maxscaleCode then inc(scaleCodeX);
2 : if scaleCodeY < maxscaleCode then inc(scaleCodeY);
3 : if centerX < maxCenter then centerX := centerX + scaleX;
4 : if centerY < maxCenter then centerY := centerY + scaleY;
5 : if scaleCodeX > minscaleCode then dec(scaleCodeX);
6 : if scaleCodeY > minscaleCode then dec(scaleCodeY);
7 : if centerX > minCenter then centerX := centerX - scaleX;
8 : if centerY > minCenter then centerY := centery - scaleY;
end;//case
scalecode2scales;
showscales;
clearplotbox;
if autoplotcheck.Checked then plotBtnClick(self);
with timer1 do if Interval > 160 then interval := interval-20;
end;
procedure TForm1.centerXtextMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
timer1.Enabled := false;
end;
procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
resetscales;
clearPlotBox;
if autoplotcheck.Checked then plotBtnClick(self);
end;
procedure TForm1.formula1btnClick(Sender: TObject);
begin
formulaNr := TStatictext(sender).Tag;
end;
procedure TForm1.plotbtnClick(Sender: TObject);
var x,y,prevY,dY,prevdY,ddY : single;
valid,OK : boolean;
plotcode : byte;
px,py : smallInt;
begin
plotcode := 0;
py := 0;
prevY := 0; prevdY := 0; ddY := 0;
with form1.plotbox.Canvas do
begin
pen.Color := $000000;
pen.Width := 1;
end;
for px := 10 to 809 do
begin
X := pix2X(px);
Y := getValue(x,valid);
if valid then py := getPixelvalue(y);
dy := Y-prevY;
if dY*prevdY >= 0 then OK := true //asymptote suppression
else OK := dy*ddy >= 0;
// OK := true; //OK=true allows drawing asymptotes
valid := valid and OK;
plotcode := (plotcode shl 1) and $3;
if valid then plotcode := plotcode or $1;
with form1.plotbox.Canvas do
case plotcode of
1 : MoveTo(px,py);
3 : lineto(px,py);
end;//case
ddY := dY - prevdY;
prevdY := dY;
prevY := Y;
end; //for px
end;
end.
