Программа для рисования графиков Опции

[klem4]

Вот от нечего делать решил сделать свою программу, в принципе все делается достаточно стандартными способами, вот только отрисовка осей с точками получилось достаточно громоздкая, но может кому-нибудь пригодится ...

uses graph,crt;

var
   maxX, maxY : word;

(*
  Инициализация графики
*)
procedure OpenGr;
var
   gd,gm,ge : integer;
begin

   gd := Detect;

   InitGraph(gd, gm, '');

   ge := GraphResult;

   if ge <> grOk then begin
      writeln('Open Graph Error : ',GraphErrorMsg(ge));
      readln;
      halt(1);
   end;

end;

(*
 Завершение работы в граф режиме
*)
procedure CloseGr;
var
   ge : integer;
begin

   CloseGraph;

   ge := GraphResult;

   if ge <> grOk then begin
      writeln('Close Graph Error : ',GraphErrorMsg(ge));
      halt(1);
   end;

end;

procedure Initialize(var x,y : word);
begin

   x := GetMaxX;

   y := GetMaxY;

end;

(*
 Отрисовка координатных осей
*)
procedure ShowDecart;
var
   i,delta,count : integer;
   s : string;
begin

   SetColor(Red);

   // сами линии
   line(0, maxY div 2, maxX, maxY div 2);
   line(maxX div 2, 0, maxX div 2, maxY);

   SetColor(white);
   SetFillStyle(1, white);

   delta := maxY div 20;

   i := maxX div 2;

   // далее отрисовка точек и чисел над осями
   count := 0;
   while (i<=maxX) do begin
      str(count ,s);
      circle(i, maxY div 2, 2);
      outtextxy(i, maxY div 2 + 5, s);
      FloodFill(i,maxY div 2, white);
      inc(i, delta);
      inc(count);
   end;

   i := maxX div 2;

   while (i>=0) do begin
      circle(i, maxY div 2, 2);
      FloodFill(i, maxY div 2, white);
      dec(i, delta);
   end;

   i := maxY div 2;

   while (i<=maxY) do begin
      circle(maxX div 2, i, 2);
      FloodFill(maxX div 2, i, white);
      inc(i, delta);
   end;

   i := maxY div 2;

   count := 0;
   s:= '';

   while (i>=0) do begin
      outtextxy(maxX div 2 + 5, i, s);
      circle(maxX div 2, i, 2);
      FloodFill(maxX div 2, i, white);
      dec(i, delta);
      inc(count);
      str(count, s);
   end;


end;

(*
  Вычисляемая функция
*)
function F(x : single) : single;
begin
   F := -sqr(x)+4;
end;

(*
   Функции GX и GY - перевод математических координат
  в графические, sx и sy - соответсвенные масштабы по осям x и y
*)
function GX(x : Extended; sx : integer) : integer;
begin
   GX := trunc(sx * x) + maxX div 2;
end;

function GY(y : Extended; sy : integer) : integer;
begin
   GY := maxY div 2 - trunc(sy * y);
end;

(*
  Отрисовка графика
  a и b - границы для вычисления функции
*)
procedure Shedule(a, b : extended);
const
   h : extended = 1E-5; // шаг вычисления
var
   i : extended;
   scale : word; // масштаб для GX и GY
begin
   i := a;
   scale := maxY div 20;
   while(i<=b) do begin
      putpixel(GX(i, scale), GY(F(i), scale), Yellow);
      i := i + h;
   end;
end;

begin

   Clrscr;
   OpenGr;
   Initialize(maxX, maxY);
   ShowDecart;
   Shedule(-20,20);
   Readln;
   CloseGr;

end.