Sources
Delphi Russian Knowledge Base
DRKB - это самая большая и удобная в использовании база знаний по Дельфи в рунете, составленная Виталием Невзоровым

Программа, выводящая график параметрической функции в декартовых координатах

01.01.2007
На днях ребёнку в школе задали задание по графикам функций, при отсутствии под рукой готовых програм нацарапал своё приложение, причём приложение написано "двумя пальцами", т.е. без каких-либо украшательств, не очень красивым кодом и без комментариев - простая програмка, написаннная за 15 минут.

clip0115

Вот исходники:

unit Main;

interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls;
 
type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Button1: TButton;
    Edit1: TEdit;
    Label1: TLabel;
    Edit2: TEdit;
    Label2: TLabel;
    Panel2: TPanel;
    procedure FormPaint(Sender: TObject);
    procedure Panel2MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Edit3KeyPress(Sender: TObject; var Key: Char);
    procedure Edit2KeyPress(Sender: TObject; var Key: Char);
    procedure Edit1KeyPress(Sender: TObject; var Key: Char);
    procedure Button3Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    procedure DrawFunction(FormulaX, FormulaY:string;  Cl:TColor);
    function GetValue(FormulaText:string; x: real): real;
    procedure SetupAxes;
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
 
implementation
 
uses math, parsing;
{$R *.dfm}
 
Function TForm1.GetValue(FormulaText:string; x:real):real;
begin
  Result:=GetFormulaValue(StringReplace(FormulaText, 'z', floattostr(x),[rfReplaceAll, rfIgnoreCase]));
end;
 
procedure TForm1.Panel2MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  ReleaseCapture;
  Panel1.perform(WM_SysCommand, $F012, 0);
end;
 
procedure TForm1.SetupAxes;
  var  point:TPoint;
       i:integer;
begin
  {Draw axis X}
  Canvas.Pen.Width:=2;
  Canvas.Pen.Color:=clBlue;
  Point.X:=0;
  Point.Y:=(height div 2);
  canvas.PenPos:=Point;
  Canvas.LineTo(width, height div 2);
 
  {Draw axis Y}
  Point.X:=width div 2;
  Point.Y:=0;
  canvas.PenPos:=Point;
  Canvas.LineTo(width div 2, height);
 
  for I := 1 to (width div 40) do
    begin
      Canvas.Pen.Width:=1;
      Canvas.Pen.Style:= psDot;
      Point.X:=width div 2 +i*20;
      Point.Y:=0;
      canvas.PenPos:=Point;
      Canvas.LineTo(width div 2 +i*20, height);
    end;
  for I := -1 downto (width div 40)*(-1) do
    begin
      Canvas.Pen.Width:=1;
      Canvas.Pen.Style:= psDot;
      Point.X:=width div 2 +i*20;
      Point.Y:=0;
      canvas.PenPos:=Point;
      Canvas.LineTo(width div 2 +i*20, height);
    end;
 
  for I := 1 to (height div 40) do
    begin
      Canvas.Pen.Width:=1;
      Canvas.Pen.Style:= psDot;
      Point.Y:=height div 2 +i*20;
      Point.X:=0;
      canvas.PenPos:=Point;
      Canvas.LineTo(width, height div 2 +i*20);
    end;
 
  for I := -1 downto (height div 40)*(-1) do
    begin
      Canvas.Pen.Width:=1;
      Canvas.Pen.Style:= psDot;
      Point.Y:=height div 2 +i*20;
      Point.X:=0;
      canvas.PenPos:=Point;
      Canvas.LineTo(width, height div 2 +i*20);
    end;
end;
 
procedure TForm1.Button1Click(Sender: TObject);
begin
  Invalidate;
end;
 
procedure TForm1.Button2Click(Sender: TObject);
begin
  Invalidate;
 
end;
 
procedure TForm1.Button3Click(Sender: TObject);
begin
  Invalidate;
 
end;
 
Procedure TForm1.DrawFunction(FormulaX, FormulaY:string; Cl:TColor);
  var i, t:integer;
      j:real;
      P:real;
      x1, x2, x0:real;
      W:integer;
      k:real;
      point:TPoint;
      error:boolean;
      prev, value:integer;
 
begin
  if (FormulaX='') or (FormulaY='') then exit;
 
  SetupAxes;
 
  Canvas.Pen.Color:=cl;
  Canvas.Pen.Style:= psSolid;
  Canvas.Pen.Width:=2;
  try
      Point.X:=(width div 2) + round(GetValue(FormulaX, -100));
      Point.Y:=(height div 2) - round(GetValue(FormulaY, -100));
      Canvas.PenPos:=point;
 
      For t:=-100 to 100 do
        begin
          Point.X:=(width div 2) + round(GetValue(FormulaX, t));
          Point.Y:=(height div 2) - round(GetValue(FormulaY, t));
          Canvas.LineTo(Point.X,Point.Y);
        end;
  except
  end;
end;
 
 
procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
 
  if key=#13 then Invalidate;
 
end;
 
procedure TForm1.Edit2KeyPress(Sender: TObject; var Key: Char);
begin
  if key=#13 then Invalidate;
 
end;
 
procedure TForm1.Edit3KeyPress(Sender: TObject; var Key: Char);
begin
  if key=#13 then Invalidate;
 
end;
 
procedure TForm1.FormPaint(Sender: TObject);
begin
  DrawFunction(Edit1.Text, Edit2.Text, clRed);
end;
 
end.

Автор: Vit