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

Материал из DRKB



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


Clip0115.png


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

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:

Parsing.pas


Author: Vit
ID: 00675


См. также[править | править код]