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

Материал из DRKB


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


Clip04222.png

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


PMain.pas[править | править код]

unit PMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, CustomizeDlg, ExtCtrls, Tabs, Menus;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Button1: TButton;
    Edit1: TEdit;
    Label1: TLabel;
    Panel2: TPanel;
    Label3: TLabel;
    Edit2: TEdit;
    Label4: TLabel;
    Edit3: TEdit;
    Label5: TLabel;
    Edit4: TEdit;
    Label6: TLabel;
    Edit5: TEdit;
    Edit6: TEdit;
    Label7: TLabel;
    Edit7: TEdit;
    Label8: TLabel;
    Edit8: TEdit;
    Label9: TLabel;
    Edit9: TEdit;
    Label10: TLabel;
    Edit10: TEdit;
    Label11: TLabel;
    Edit11: TEdit;
    Label12: TLabel;
    Edit12: TEdit;
    Label13: TLabel;
    Label14: TLabel;
    Edit13: TEdit;
    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(FormulaText: 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, 'x', 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);

  Point.X := Width div 2;
  Point.Y := 0;
  Canvas.PenPos := Point;
  Canvas.LineTo(Width div 2, Height);
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(FormulaText: string; Cl: TColor);
var
  i: Integer;
  j: Real;
  P: Real;
  x1, x2, x0: Real;
  W: Integer;
  k: Real;
  point: TPoint;
  error: Boolean;
  prev, value: Integer;
begin
  if FormulaText = '' then exit;

  SetupAxes();

  Canvas.Pen.Color := cl;
  Canvas.Pen.Style := psSolid;
  Canvas.Pen.Width := 2;

  { setup first point }
  try
    Point.X := Round(GetValue(FormulaText, DegToRad(StrToIntDef(Edit2.Text, 0))) * Cos(DegToRad(StrToIntDef(Edit2.Text, 0))) * StrToIntDef(Edit13.Text, 20));
    Point.Y := Round(GetValue(FormulaText, DegToRad(StrToIntDef(Edit2.Text, 0))) * Sin(DegToRad(StrToIntDef(Edit2.Text, 0))) * StrToIntDef(Edit13.Text, 20));
    Point.X := Point.X + (Width div 2);
    Point.Y := (Height div 2) - Point.Y;
    Canvas.PenPos := Point;
  except
  end;

  for i := StrToIntDef(Edit2.Text, 0) to StrToIntDef(Edit3.Text, 3600) do
  begin
    try
      Point.X := Round(GetValue(FormulaText, DegToRad(i)) * Cos(DegToRad(i)) * StrToIntDef(Edit13.Text, 20));
      Point.Y := Round(GetValue(FormulaText, DegToRad(i)) * Sin(DegToRad(i)) * StrToIntDef(Edit13.Text, 20));
      Point.X := Point.X +(Width div 2);
      Point.Y := (Height div 2) - Point.Y;
      Canvas.LineTo(Point.X, Point.Y);
      Canvas.PenPos := Point;
      Application.ProcessMessages;
    except
    end;
  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, clRed);
  DrawFunction(Edit4.Text, clGreen);
  DrawFunction(Edit5.Text, clFuchsia);

  DrawFunction(Edit6.Text, clLime);
  DrawFunction(Edit7.Text, clAqua);
  DrawFunction(Edit8.Text, clNavy);
  DrawFunction(Edit9.Text, clYellow);
  DrawFunction(Edit10.Text, clOlive);
  DrawFunction(Edit11.Text, clMaroon);
  DrawFunction(Edit12.Text, clBlack);
end;

end.


PMain.dfm[править | править код]

object Form1: TForm1
  Left = 380
  Top = 200
  BorderIcons = [biSystemMenu, biMinimize]
  BorderStyle = bsSingle
  Caption = 'Formula Grapher (c) Vit, 2006'
  ClientHeight = 494
  ClientWidth = 771
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  Position = poScreenCenter
  OnPaint = FormPaint
  PixelsPerInch = 96
  TextHeight = 13
  object Panel1: TPanel
    Left = 24
    Top = 8
    Width = 185
    Height = 353
    TabOrder = 0
    object Label1: TLabel
      Left = 9
      Top = 27
      Width = 16
      Height = 16
      Caption = 'R='
      Font.Charset = DEFAULT_CHARSET
      Font.Color = clWindowText
      Font.Height = -11
      Font.Name = 'Fixedsys'
      Font.Style = []
      ParentFont = False
    end
    object Label3: TLabel
      Left = 9
      Top = 272
      Width = 51
      Height = 13
      Caption = 'min angle='
      Font.Charset = DEFAULT_CHARSET
      Font.Color = clWindowText
      Font.Height = -11
      Font.Name = 'MS Sans Serif'
      Font.Style = []
      ParentFont = False
    end
    object Label4: TLabel
      Left = 9
      Top = 296
      Width = 54
      Height = 13
      Caption = 'max angle='
      Font.Charset = DEFAULT_CHARSET
      Font.Color = clWindowText
      Font.Height = -11
      Font.Name = 'MS Sans Serif'
      Font.Style = []
      ParentFont = False
    end
    object Label5: TLabel
      Left = 9
      Top = 51
      Width = 16
      Height = 16
      Caption = 'R='
      Font.Charset = DEFAULT_CHARSET
      Font.Color = clWindowText
      Font.Height = -11
      Font.Name = 'Fixedsys'
      Font.Style = []
      ParentFont = False
    end
    object Label6: TLabel
      Left = 9
      Top = 75
      Width = 16
      Height = 16
      Caption = 'R='
      Font.Charset = DEFAULT_CHARSET
      Font.Color = clWindowText
      Font.Height = -11
      Font.Name = 'Fixedsys'
      Font.Style = []
      ParentFont = False
    end
    object Label7: TLabel
      Left = 9
      Top = 99
      Width = 16
      Height = 16
      Caption = 'R='
      Font.Charset = DEFAULT_CHARSET
      Font.Color = clWindowText
      Font.Height = -11
      Font.Name = 'Fixedsys'
      Font.Style = []
      ParentFont = False
    end
    object Label8: TLabel
      Left = 9
      Top = 123
      Width = 16
      Height = 16
      Caption = 'R='
      Font.Charset = DEFAULT_CHARSET
      Font.Color = clWindowText
      Font.Height = -11
      Font.Name = 'Fixedsys'
      Font.Style = []
      ParentFont = False
    end
    object Label9: TLabel
      Left = 9
      Top = 147
      Width = 16
      Height = 16
      Caption = 'R='
      Font.Charset = DEFAULT_CHARSET
      Font.Color = clWindowText
      Font.Height = -11
      Font.Name = 'Fixedsys'
      Font.Style = []
      ParentFont = False
    end
    object Label10: TLabel
      Left = 9
      Top = 171
      Width = 16
      Height = 16
      Caption = 'R='
      Font.Charset = DEFAULT_CHARSET
      Font.Color = clWindowText
      Font.Height = -11
      Font.Name = 'Fixedsys'
      Font.Style = []
      ParentFont = False
    end
    object Label11: TLabel
      Left = 9
      Top = 195
      Width = 16
      Height = 16
      Caption = 'R='
      Font.Charset = DEFAULT_CHARSET
      Font.Color = clWindowText
      Font.Height = -11
      Font.Name = 'Fixedsys'
      Font.Style = []
      ParentFont = False
    end
    object Label12: TLabel
      Left = 9
      Top = 219
      Width = 16
      Height = 16
      Caption = 'R='
      Font.Charset = DEFAULT_CHARSET
      Font.Color = clWindowText
      Font.Height = -11
      Font.Name = 'Fixedsys'
      Font.Style = []
      ParentFont = False
    end
    object Label13: TLabel
      Left = 9
      Top = 243
      Width = 16
      Height = 16
      Caption = 'R='
      Font.Charset = DEFAULT_CHARSET
      Font.Color = clWindowText
      Font.Height = -11
      Font.Name = 'Fixedsys'
      Font.Style = []
      ParentFont = False
    end
    object Label14: TLabel
      Left = 9
      Top = 320
      Width = 31
      Height = 13
      Caption = 'scale='
      Font.Charset = DEFAULT_CHARSET
      Font.Color = clWindowText
      Font.Height = -11
      Font.Name = 'MS Sans Serif'
      Font.Style = []
      ParentFont = False
    end
    object Button1: TButton
      Left = 141
      Top = 317
      Width = 41
      Height = 25
      Caption = 'Draw'
      TabOrder = 13
      OnClick = Button1Click
    end
    object Edit1: TEdit
      Left = 31
      Top = 24
      Width = 148
      Height = 24
      Font.Charset = DEFAULT_CHARSET
      Font.Color = clRed
      Font.Height = -11
      Font.Name = 'Fixedsys'
      Font.Style = []
      ParentFont = False
      TabOrder = 0
      OnKeyPress = Edit1KeyPress
    end
    object Panel2: TPanel
      Left = 1
      Top = 1
      Width = 183
      Height = 16
      Align = alTop
      Color = clNavy
      TabOrder = 14
      OnMouseDown = Panel2MouseDown
    end
    object Edit2: TEdit
      Left = 65
      Top = 269
      Width = 72
      Height = 24
      Font.Charset = DEFAULT_CHARSET
      Font.Color = clRed
      Font.Height = -11
      Font.Name = 'Fixedsys'
      Font.Style = []
      ParentFont = False
      TabOrder = 10
      Text = '0'
      OnKeyPress = Edit1KeyPress
    end
    object Edit3: TEdit
      Left = 66
      Top = 293
      Width = 72
      Height = 24
      Font.Charset = DEFAULT_CHARSET
      Font.Color = clRed
      Font.Height = -11
      Font.Name = 'Fixedsys'
      Font.Style = []
      ParentFont = False
      TabOrder = 11
      Text = '3600'
      OnKeyPress = Edit1KeyPress
    end
    object Edit4: TEdit
      Left = 31
      Top = 48
      Width = 148
      Height = 24
      Font.Charset = DEFAULT_CHARSET
      Font.Color = clGreen
      Font.Height = -11
      Font.Name = 'Fixedsys'
      Font.Style = []
      ParentFont = False
      TabOrder = 1
      OnKeyPress = Edit1KeyPress
    end
    object Edit5: TEdit
      Left = 31
      Top = 72
      Width = 148
      Height = 24
      Font.Charset = DEFAULT_CHARSET
      Font.Color = clFuchsia
      Font.Height = -11
      Font.Name = 'Fixedsys'
      Font.Style = []
      ParentFont = False
      TabOrder = 2
      OnKeyPress = Edit1KeyPress
    end
    object Edit6: TEdit
      Left = 31
      Top = 96
      Width = 148
      Height = 24
      Font.Charset = DEFAULT_CHARSET
      Font.Color = clLime
      Font.Height = -11
      Font.Name = 'Fixedsys'
      Font.Style = []
      ParentFont = False
      TabOrder = 3
      OnKeyPress = Edit1KeyPress
    end
    object Edit7: TEdit
      Left = 31
      Top = 120
      Width = 148
      Height = 24
      Font.Charset = DEFAULT_CHARSET
      Font.Color = clAqua
      Font.Height = -11
      Font.Name = 'Fixedsys'
      Font.Style = []
      ParentFont = False
      TabOrder = 4
      OnKeyPress = Edit1KeyPress
    end
    object Edit8: TEdit
      Left = 31
      Top = 144
      Width = 148
      Height = 24
      Font.Charset = DEFAULT_CHARSET
      Font.Color = clNavy
      Font.Height = -11
      Font.Name = 'Fixedsys'
      Font.Style = []
      ParentFont = False
      TabOrder = 5
      OnKeyPress = Edit1KeyPress
    end
    object Edit9: TEdit
      Left = 31
      Top = 168
      Width = 148
      Height = 24
      Font.Charset = DEFAULT_CHARSET
      Font.Color = clYellow
      Font.Height = -11
      Font.Name = 'Fixedsys'
      Font.Style = []
      ParentFont = False
      TabOrder = 6
      OnKeyPress = Edit1KeyPress
    end
    object Edit10: TEdit
      Left = 31
      Top = 192
      Width = 148
      Height = 24
      Font.Charset = DEFAULT_CHARSET
      Font.Color = clOlive
      Font.Height = -11
      Font.Name = 'Fixedsys'
      Font.Style = []
      ParentFont = False
      TabOrder = 7
      OnKeyPress = Edit1KeyPress
    end
    object Edit11: TEdit
      Left = 31
      Top = 216
      Width = 148
      Height = 24
      Font.Charset = DEFAULT_CHARSET
      Font.Color = clMaroon
      Font.Height = -11
      Font.Name = 'Fixedsys'
      Font.Style = []
      ParentFont = False
      TabOrder = 8
      OnKeyPress = Edit1KeyPress
    end
    object Edit12: TEdit
      Left = 31
      Top = 240
      Width = 148
      Height = 24
      Font.Charset = DEFAULT_CHARSET
      Font.Color = clBlack
      Font.Height = -11
      Font.Name = 'Fixedsys'
      Font.Style = []
      ParentFont = False
      TabOrder = 9
      OnKeyPress = Edit1KeyPress
    end
    object Edit13: TEdit
      Left = 66
      Top = 317
      Width = 72
      Height = 24
      Font.Charset = DEFAULT_CHARSET
      Font.Color = clRed
      Font.Height = -11
      Font.Name = 'Fixedsys'
      Font.Style = []
      ParentFont = False
      TabOrder = 12
      Text = '20'
      OnKeyPress = Edit1KeyPress
    end
  end
end


Parsing.pas[править | править код]

Для разбора математических выражений использовался модуль Parsing из RxLib:

Parsing.pas


Author: Vit
ID: 04222

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