Программа выводящая график функции в полярных координатах
Материал из DRKB
На днях ребёнку в школе задали задание по графикам функций, при отсутствии под рукой готовых программ нацарапал своё приложение, причём приложение написано "двумя пальцами", т.е. без каких-либо украшательств, не очень красивым кодом и без комментариев - простая програмка, написанная за 15 минут.
Вот исходники:
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:
Author: Vit
ID: 04222