Розв’язок задачі з Абрамова №846г

Всі умови | Умова: Дослідити область визначення і побудувати графіки наступних функцій ... (С.А. Абрамов, Г.Г. Гнездилова,Е.Н. Капустина, М.И. Селюн. Задачи по программированию. - Вологда, 2000. - №846)

program Pr846_4;
uses
  CRT,
  Graph,
  _ViewGr;
const
  PathToBGI : String[80] = 'D:\Tools\BGI';

function InitGraphics: Integer;
var
  grDriver, grMode : Integer;
begin
  grDriver := Detect;
  InitGraph(grDriver, grMode, PathToBGI);
  InitGraphics := GraphResult;
end;

function MyVeryCoolfunction1(Myvar:Real):Real; Far;
begin
  MyVeryCoolfunction1 := 3-2/x-3/(x*x);
end;

var
  a,b : Real;
  S   : String;
begin
  if InitGraphics<>grOK then Exit;

  Initvariable;
  MainWindow(S);

  a := -1.5*Pi;
  b :=  1.5*Pi;

  ColorGr := Yellow;
  DrawGraph(@MyVeryCoolfunction1,a,b);


  CloseGraph;
end.
{ Содержимое библиотеки _ViewGr }
{$IFNDEF Debug}
{$D-,L-,S-}
{$endIF}
{$B-,R-,V-,X+,G+,N+,E-,A-,T-,F-,Q-,P-}

UNIT _ViewGr;
INTERFACE
USES
  Graph;
const
  ArgNumber = 800;               {количество интервалов аргумента при построении}
const
  CalcScale : BOOLEAN    = TRUE; {при построении графика пересчитывать масштаб}
  CalcFun   : BOOLEAN    = TRUE; {при построении графика пересчитывать мин. и макс. значение функции}
  MinFun    : Real       =  0.0; {минимальное  значение функции на интервале [a; b]}
  MaxFun    : Real       =  0.0; {максимальное значение функции на интервале [a; b]}

  ScaleX    : Real       = 80.0; { Коэффициент увеличения графика по оси X}
  ScaleY    : Real       = 80.0; { Коэффициент увеличения графика по оси Y}

  ColorAxis : Word       = LightBlue; {цвет осей координат          }
  ColorGr   : Word       = Yellow;    {цвет линии графика           }
  ColorLbl  : Word       = Red;       {цвет чисел на сетке координат}
  ColorMin  : Word       = LightRed;  {цвет линии "минимум"         }
  ColorMax  : Word       = LightRed;  {цвет линии "максимум"        }
type
{$IFOPT N+}
  Real = Extended;
{$endIF}
  TDrawFunc = function (aX : Real) : Real;

procedure Initvariable;
procedure MainWindow(var Header:String);
procedure PlotAxis;
procedure DrawLegend(Title : String);
procedure DrawGraph (PF: Pointer; a,b: Real);

IMPLEMENTATION

var
  HeightM  : Integer;
  MaxX     : Integer;
  MaxY     : Integer;

procedure Initvariable;
begin
  MaxX  :=  GetMaxX;
  MaxY  :=  GetMaxY;
  HeightM := TextHeight('M');
end;

procedure MainWindow(var Header:String);
begin
  ClearDevice;
  SetTextStyle(DefaultFont, HorizDir, 2);
  SetTextJustify(CenterText,  TopText);
  SetViewPort(0, 0, MaxX, MaxY, ClipOn);

  SetColor(White);
  OutTextXY(MaxX DIV 2, 4, Header);

(*  SetViewPort(0, HeightM+4, MaxX  , MaxY-4, ClipOn);
  PlotAxis;*)

  SetViewPort(100, HeightM+50, MaxX-25, MaxY-(HeightM+50), ClipOn);
  PlotAxis;

  SetViewPort(1, HeightM+5, MaxX-1, MaxY-(HeightM+5), ClipOn);
end;

procedure PlotAxis;
var
  ViewPort : ViewPorttype; {}
begin
{  SetLineStyle(SolidLn, 0, NormWidth);
  SetColor(ColorAxis);
  Rectangle(100, HeightM+50, MaxX-25, MaxY-(HeightM+50));}
  SetLineStyle(SolidLn, 0, NormWidth);
  SetColor(ColorAxis);
  GetViewSettings(ViewPort);
  with ViewPort do
    Rectangle(0, 0, X2-X1, Y2-Y1);
end;

procedure DrawLegend(Title : String);
begin
end;

procedure DrawGraph (PF: Pointer; a,b: Real);
var
  F          : TDrawFunc;    {отображаемая функция}
  dArg       : Real;         {шаг изменения аргумента функции}
  X          : Real;         {текущее значение аргумента функции}
  Y          : Real;         {текущее значение функции}
  vStr       : String;       {}
  Xs         : Integer;      {значение координаты X на экране}
  Ys         : Integer;      {значение координаты Y на экране}
  ViewPort   : ViewPorttype; {}
  GraphSizeY : Integer;      {высота области для рисования графика}
begin
  @F := PF;

  dArg := (b-a)/ArgNumber;
  { Определение минимальноого и максимального значений функции }
  if CalcFun
  then begin
    X := a;
    MinFun := F(X);
    MaxFun := MinFun;
    repeat
      Y := F(X);
      if MinFun>Y then MinFun := Y;
      if MaxFunthen MaxFun := Y;
      X := X+dArg;
    until ( X > b );
  end;
  {отобразить значения X и Y на осях координат}
  if CalcScale
  then begin
    SetColor(ColorLbl);
    Str(MaxFun :4 :2, vStr);
    OutTextXY(50, HeightM+35, vStr);
    Str(MinFun :4 :2, vStr);
    OutTextXY(50, MaxY-(HeightM+80), vStr);

    Str(a :4:2, vStr);
    OutTextXY(120, MaxY-(HeightM+40), vStr);
    Str(b :4:2, vStr);
    OutTextXY(MaxX-60, MaxY-(HeightM+40), vStr);
  end;

  SetViewPort(100, HeightM+50, MaxX-25, MaxY-(HeightM+50), ClipOn);

  GetViewSettings(ViewPort);
  GraphSizeY := ViewPort.Y2-ViewPort.Y1;
  if CalcScale
  then begin
    GetViewSettings(ViewPort);
    with ViewPort do begin
      ScaleX := (X2-X1)/(b-a);
      ScaleY := (Y2-Y1)/(MaxFun-MinFun);
    end;
  end;
  SetColor(ColorGr);
  X := a;
  Y := F(X);
  Xs := Trunc((X-a)*ScaleX);
  Ys := GraphSizeY-Trunc((Y-MinFun)*ScaleY);
  PutPixel(Xs, Ys, ColorGr);
  X := X+dArg;
  while Xdo begin
    Y := F(X);
    Xs := Trunc((X-a)*ScaleX);
    Ys := GraphSizeY-Trunc((Y-MinFun)*ScaleY);
    LineTo(Xs, Ys);
    X := X+dArg;
  end;
end;

{begin}
end.