HOME ПРИМЕРЫ THANKS НОВИЧКАМ ДОКИ LINKS JavaScript Mail


 
В этот день много лет назад...
1 мая. В 1978 году (39 лет назад) - В Великобритании впервые Первое мая отмечается как государственный праздник.
 
 

Turbo Pascal Examples

Графика:
Построение графика функции
Прыгающий по экрану мячик.
Качание маятника.
Вложенные цветные круги.
Броуновское движение. Использование объектов.
Матрицы и массивы:
Сортировка элементов массива.
Удаление одинаковых элементов.
Простой пример на поворот матрицы.
Сортировка методом Шелла. +функции измерения временных интервалов.
Проверка выпуклости многоугольника.
Перемоножение матриц
Вычисление определителя матрицы. Рекурсия.
Нахождение обратной матрицы.
Задача об автостоянке.
Рекурсия. Подземелье сокровищ.
Численные методы:
Задачка на определение угла между стрелками часов.
Проверка на принадлежность точки многоугольнику.
Нахождение точки пересечения двух отрезков на плоскости.
Сортировка методом Шелла. +функции измерения временных интервалов.
Сортировка методом "пузырька". Пример на динамические структуры данных. Связанные списки.
Нахождение корня функции методом половинного деления.
Вычисление арккосинуса
Нахождение суммы цифр натурального числа.
Работа с фалами:
Рекурсивное сканирование директорий.
Работа со строками:
Работа со словами в предложении с разделителями.
Простейший синтаксический анализатор для распознавания и вычисления многчлена.
Синтаксический анализатор для распознавания и вычисления многчлена.
Работа со строками: смена кодировки, удаление тегов из HTML текста, обработка
Переименование файлов из кириллицы в латиницу.
Выдача контекстной подсказки.
Частотный словарь символов.
Подсчет повторяющихся символов в строке.
Ссылочные переменные:
Моделирование стека.
Пасьянс "Косынка".
Игры:
Пасьянс "Косынка".
Игра "Питон"
Игра "Анацефал". Пример использования объектов.
Игра "Минное поле"
Большие проекты:
Электронная картотека (без исходника)


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

Приводится программа построения графика функции. Использование достаточно простое. Перед вызовом процедуры построения графика, надо занести точки (X,Y=F(x)) в массив Koor. Вывод графика осуществляется на экран и, при необходимости, на матричный принтер (выводился на принтер Star, хотя вроде не было проблем и с выводом на Epson). При выводе производится автоматическое масштабирование, на осях координат выводятся числовые значения аргумента и функции. Возможен вывод двух и более графиков в одной системе координат (правда в этом случае необходимо, чтобы график с "большим размахом" выводился первым). Вывод числовых значений по осям координат можно подавить. Режим вывода задается переменной OutMode, которая имеет побитовое представление и подробно описана внутри процедуры. В данной программе используется модуль drivers.tpu, который позволяет запускать программу без использования драйверов экрана egavga.bgi и т.п. - т. е. все драйверы содержатся в конечном exe файле. Не забывайте закрывать графический режим внутри программы, например, процедурой My_CloseGraph, если будете использовать, в противном случае после выхода из программы (если вы работаете в какой-нибудь ДОС оболочке) придется набирать команду "mode co80". Полный текст примера вместе с файлом drivers.tpu можно скачать здесь.

Примечание: в программе использован метод инициализации графики для Паскаля версии 5.5 (да, давно дело было) и для той же версии приведен файл drivers.tpu, включающий в себя все драйверы экрана. Если у вас другая версия Паскаля, то можно изменить данный способ инициализации графики. Для этого уберите из секции uses утилиту drivers, удалите целиком процедуру initdrivers и ее вызов. Но учтите, после этого программе будет необходим файл EGAVGA.BGI в том же каталоге, из которого она будет запускается.

{ файл BildGraf.pas }
unit BildGraf;
{ Постpоение гpафика и, пpи необходимости вывод его на пpинтеp }
{ Гpафик стpоится по точкам, вещественные кооpдинаты котоpых   }
{ задаются в массивах Koor. Число точек задается в пеpеменной  }
{ NumberPoints. Оно не может пpевышать константу Мах (2000)    }
{ Пеpеменная булевского типа OutToPrinter задает консоль вы-   }
{ вода: True - вывод на пpинтеp, False - на экpан.             }
{ Константа PathGraphDriver - отpажает путь к гpафическому     }
{ дpайвеpу экpана( EGAVGA.BGI,CGA.BGI и т.д.) и должна быть    }
{ пpи необходимости изменнена.                                 }
{ Написана Бычковым А.К.                                       }
{ Последние изменения внесены 1 ноябpя 1991                    }
{ В качестве пpимеpа пpиведена подпpогpамма постpоения функции:}
{               Y = Sin(X) + Sin(2*X)                          }
interface
const max=2000;
      PathGraphDriver='d:\pascal55';
type ArrXY=array[1..Max,1..2] of real;
var koor:ArrXY;

procedure bildgr(NumberPoints:word;OutMode:byte);
procedure My_CloseGraph;
implementation
uses graph,dos,crt,printer,drivers;
var dgran,dx,dy:word;
    fmax,fmin,pmax,pmin,df,dp:real; { for graphik }
    GrInastall:boolean;
    NewStyle,OldStyle   : LineSettingsType;
procedure copygraphscreen(drawcolor:byte);
{ **************************************************************  }
{ *  Процедура выводит на принтер графическую копию экрана     *  }
{ *  Выводятся все точки цвета drawcolor                       *  }
{ *  Используются модули GRAPH,PRINTER                         *  }
{ *  Положение переключателей принтера ( Dip-Schalter )        *  }
{ *  --------------------------   --------------               *  }
{ *  ! 0  0  0  0  0     0  0 !   !    0  0  0 !               *  }
{ *  !                0       !   ! 0          !               *  }
{ *  --------------------------   --------------               *  }
{ **************************************************************  }
const twodegree:array[1..8] of byte=
(128,64,32,16,8,4,2,1);
     z=#27;
var xmx,ymx,nym,k,w1,w2,i,j,c,pltn:integer;
    r:byte;
  begin
  ymx:=getmaxy;
  xmx:=getmaxx;
  {  Задание оптимальной плотности  }
  if xmx>1937 then exit else              { can not to print  }
  if xmx >968 then pltn:=3 else           { 240 plot for inch }
  if xmx >726 then pltn:=1 else           { 120 plot for inch }
  if xmx >645 then pltn:=6 else           {  90 plot for inch }
  if xmx >581 then pltn:=4 else           {  80 plot for inch }
  if xmx >484 then pltn:=5 else           {  72 plot for inch }
  pltn:=0;                                {  60 plot for inch }
  nym:=ymx div 8 + 1;
  if ymx mod 8 = 0 then nym:=nym-1;
  writeln(lst,z,'@',z,'A',#8,z,#50);
  w1:=xmx div 256;
  w2:=xmx mod 256 +1;
  for k:=1 to nym do
    begin
    write(lst,z,#42,chr(pltn),chr(w2),chr(w1));
    for i:=0 to xmx do
      begin
      r:=0;
      for j:=1 to 8 do
        begin
        c:=getpixel(i,j-1+(k-1)*8);
        if c=drawcolor then r:=r+twodegree[j];
        end;
      if i<>xmx then write(lst,chr(r))
                else writeln(lst,chr(r))
      end;
    end
  end;
procedure Abort(Msg : string);
begin
  RestoreCrtMode;
  Writeln(' '+Msg+': '+ GraphErrorMsg(GraphResult)+' ');
  halt;
end;
procedure initdrivers;
  begin
    { Register all the drivers }
    if RegisterBGIdriver(@CGADriverProc) < 0 then
      Abort('CGA');
    if RegisterBGIdriver(@EGAVGADriverProc) < 0 then
      Abort('EGA/VGA');
    if RegisterBGIdriver(@HercDriverProc) < 0 then
      Abort('Herc');
    if RegisterBGIdriver(@ATTDriverProc) < 0 then
      Abort('AT&T');
    if RegisterBGIdriver(@PC3270DriverProc) < 0 then
      Abort('PC 3270');
  end;
Function RealToStr(i: Real): string;
{ Convert any Integer type to a string }
var
  s: string[11];
begin
  Str(i:8:3, s);
  while s[1]=' ' do delete(s,1,1);
  RealToStr := s
end;
Procedure OutTextXY(x,y:integer;msg:string);
var OldPattern : FillPatternType;
  begin
  GetFillPattern(OldPattern);
  SetFillStyle(0,GetColor);
  Bar(x-1,y-1,x+TextWidth(Msg),y+TextHeight(Msg));
  SetFillPattern(OldPattern,GetColor);
  Graph.OutTextXY(x,y,msg);
  end;
procedure bildgr(NumberPoints:word;OutMode:byte);
{ printgr - true если надо печатать график на принтере, false - иначе }
{ NumberPoints - число точек }
{ OutMode - Задаёт pежим вывода.
  +---+---+---+---+---+---+---+---+
  ! p ! c ! x ! y ! d ! n ! n ! n ! - Побитовое пpедставление
  +---+---+---+---+---+---+---+---+
  p - Printer - отвечает за выод на пpинтеp
  c - ClearBeforDrawing - отвечает за очистку экpана пеpед постpоением
  x - OutXCoordinate - отвечает за вывод числовых значений кооpдинат по X
  y - OutYCoordinate - отвечает за вывод числовых значений кооpдинат по Y
  d - Delay - остановиться после вывода и ждать нажатия любой клавиши
      в случае, если нажата клавиша "p", то текущий вид экpана выводится
      на пpинтеp.
  n - не используется }
const NumbPointX = 5;
      NumbPointY = 5;
var  xn,yn,xt,yt,xnn,ynn     { for graphik }
     :integer;
     dxp,dyp,dxr,dyr:real;
     grdriver,grmode:Integer;
     OutToPrinter,ClrScrBeforDraw,OutXNum,OutYNum:boolean;
  Procedure GetExtremum;
  var i:word;
    begin
    fmax:=-1000.0;
    fmin:=-fmax;
    pmax:=fmax;
    pmin:=fmin;
    for i:=1 to NumberPoints do
      begin
      if koor[i,2]>fmax then fmax:=koor[i,2];
      if koor[i,2]<fmin then fmin:=koor[i,2];
      if koor[i,1]>pmax then pmax:=koor[i,1];
      if koor[i,1]<pmin then pmin:=koor[i,1]
      end;
    df:=(fmax-fmin);
    dp:=(pmax-pmin);
    end;
  Procedure InstallGraph;
    begin
    initdrivers;
    grdriver:=0;{grmode:=1;}
    initgraph(grdriver,grmode,'d:\pascal55');
    setcolor(getmaxcolor);
    GetLineSettings(OldStyle);
    dgran:=3;
    dx:=getmaxx-1-2*dgran;
    dy:=getmaxy-3-TextHeight('-1.235')-2*dgran;
    GrInastall:=true;OutMode:=OutMode or 64;
    end;
  Procedure DrawGraphic;
  var i:word;
    begin
    xn:=dgran+round((koor[1,1]-pmin)/dp*dx)+1;xnn:=xn;
    yn:=dgran+round((fmax-koor[1,2])/df*dy)+1;ynn:=yn;
    for i:=2 to NumberPoints do
      begin
      xt:=dgran+round((koor[i,1]-pmin)/dp*dx)+1;
      yt:=dgran+round((fmax-koor[i,2])/df*dy)+1;
      {if i <> NumberPoints div 2 +1
      then} line(xn,yn,xt,yt)
      {else SetLineStyle(SolidLn, 0,3)};
      xn:=xt;yn:=yt
      end;
    {with OldStyle do SetLineStyle(LineStyle, Pattern,Thickness);}
    yt:=GetmaxY-TextHeight('1')-3;yn:=yt;
    end;
  Procedure OutXCoord;
  var i:word;
    begin
    rectangle(0,0,getmaxx,Yn);
    dxp:=(GetMaxX-2*dgran)/(NumbPointX-1);
    dxr:=dp/(NumbPointX-1);
    for i:=1 to NumbPointX do
      begin
      xt:=dgran+round((i-1)*dxp);
      with OldStyle do SetLineStyle(LineStyle, Pattern,Thickness);
      Line(Xt,Yt-3,Xt,Yt+5);
      SetLineStyle(2, 0, 1);
      Line(xt,dgran,xt,yn-dgran);
      if i=NumbPointX then
        xt:=xt-TextWidth(RealToStr(pmin+(i-1)*dxr));
      OutTextXY(Xt+3,Yt+2,RealToStr(pmin+(i-1)*dxr));
      end;
    end;
  Procedure OutYCoord;
  var i:word;
    begin
    xt:=dgran;
    dxp:=(Yt-2*dgran)/(NumbPointY-1);
    dxr:=df/(NumbPointY-1);
    for i:=1 to NumbPointY do
      begin
      yt:=yn-(dgran+round((i-1)*dxp));
      with OldStyle do SetLineStyle(LineStyle, Pattern,Thickness);
      Line(0,Yt,8,Yt);
      SetLineStyle(2, 0, 1);
      Line(10,yt,GetMaxX-dgran,Yt);
      if i=NumbPointY then yt:=yt+(TextHeight('-1.235') div 2);
      OutTextXY(10,Yt-(TextHeight('-1.235') div 2),RealToStr(fmin+(i-1)*dxr));
      end;
    end;

begin
if not GrInastall then InstallGraph;
OutToPrinter   :=OutMode and 128 = 128;
ClrScrBeforDraw:=OutMode and  64 = 64;
OutXNum        :=OutMode and  32 = 32;
OutYNum        :=OutMode and  16 = 16;
if ClrScrBeforDraw then
  begin
  ClearDevice;
  GetExtremum;
  end;
DrawGraphic;
if not OutXNum then rectangle(0,0,GetMaxX,Yn);
if OutXNum then OutXCoord;
if OutYNum then OutYCoord;
with OldStyle do SetLineStyle(LineStyle, Pattern,Thickness);
if OutToPrinter then copygraphscreen(getmaxcolor);
if OutMode and  8 = 8 then { сделать паузу }
  if readkey=#112 then copygraphscreen(getmaxcolor); { печать, если нажата p }
end;
procedure My_CloseGraph;
  begin
  readln;
  CloseGraph;
  end;
Procedure BildSinus;
var i,k,j:word;
    x,s:real;
{ Тестовый пpимеp  }
  begin
  for j:=15 downto 10 do
    begin
    for i:=1 to 200 do
      begin
      x:=(i-1)*0.1;
      koor[i,1]:=x;
      s:=0;
      for k:=1 to j do s:=s+Sin(x*k);
      koor[i,2]:=S/j
      end;
    bildgr(200,0);
    end;
  end;
begin
GrInastall:=false;
end.





{ файл BildGr.pas }
uses BildGraf;
var i:word;
    x:real;
begin
{ Тестовый пpимеp  }
  for i:=1 to 200 do
    begin
    x:=i*0.1;
    koor[i,1]:=x;
    koor[i,2]:=Sin(x)+Sin(2*x)+Sin(3*x)+Sin(4*x)+Sin(5*x)+Sin(6*x)+Sin(7*x)+
    Sin(8*x)+Sin(9*x)+Sin(10*x)+Sin(11*x)+Sin(12*x)+Sin(13*x)+Sin(14*x);
    end;
  bildgr(200,64+32+16+8+4);

  for i:=1 to 200 do
    begin
    x:=i*0.1;
    koor[i,1]:=x;
    koor[i,2]:=Cos(x)+Cos(2*x);
    end;
  bildgr(100,32+16+8+4);

  for i:=1 to 601 do
    begin
    x:=(i-1)*0.05;
    koor[i,1]:=x;
    koor[i,2]:=(x-3)*(x-3)/44+x-1;
    end;
  bildgr(601,64+32+16+8+4);
  My_CloseGraph;
end.

 

 

 

 

 

 

 


HOME