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

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

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

 
 Ответить  Открыть новую тему 
> Программа для рисования графиков
klem4
сообщение 16.11.2005 15:36
Сообщение #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 
 К началу страницы 
+ Ответить 
Altair
сообщение 16.11.2005 20:38
Сообщение #2


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

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

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


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

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

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


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

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

 

- Текстовая версия 28.07.2025 9:42
Хостинг предоставлен компанией "Веб Сервис Центр" при поддержке компании "ДокЛаб"