IPB
ЛогинПароль:

> Прочтите прежде чем задавать вопрос!

1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code], либо быть опубликованы на нашем PasteBin в режиме вечного хранения.
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!

 
 Ответить  Открыть новую тему 
> Программа для рисования графиков
сообщение
Сообщение #1


Perl. Just code it!
******

Группа: Пользователи
Сообщений: 4 100
Пол: Мужской
Реальное имя: Андрей

Репутация: -  44  +


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

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.


Эскизы прикрепленных изображений
Прикрепленное изображение

--------------------
perl -e 'print for (map{chr(hex)}("4861707079204E6577205965617221"=~/(.{2})/g)), "\n";'
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #2


Ищущий истину
******

Группа: Пользователи
Сообщений: 4 825
Пол: Мужской
Реальное имя: Олег

Репутация: -  45  +


назвался горшком полезай в печь!
РАз взялся за это то сделай материал для ФАКа ...
эту свою прогу в качестве фичи, а так все проще напиши!
Как выводить графики !
с пояснениями, красиво что быбыло. эту мессагу удалишь.

lol.gif Типа, Прикрепленное изображение

Сообщение отредактировано: volvo -


--------------------
Помогая друг другу, мы справимся с любыми трудностями!
"Не опускать крылья!" (С)
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 



- Текстовая версия 15.04.2025 11:41
500Gb HDD, 6Gb RAM, 2 Cores, 7 EUR в месяц — такие хостинги правда бывают
Связь с администрацией: bu_gen в домене octagram.name