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.