Программа выводящая график параметрической функции в декартовых координатах
Материал из DRKB
На днях ребёнку в школе задали задание по графикам функций, при отсутствии под рукой готовых программ нацарапал своё приложение, причём приложение написано "двумя пальцами", т.е. без каких-либо украшательств, не очень красивым кодом и без комментариев - простая програмка, написанная за 15 минут.
Вот исходники:
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
{ Private declarations }
procedure DrawFunction(FormulaX, FormulaY: string; Cl: TColor);
function GetValue(FormulaText: string; x: Real): Real;
procedure SetupAxes;
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.
Parsing.pas[править | править код]
Для разбора математических выражений использовался модуль Parsing из RxLib:
Author: Vit
ID: 00675