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

 





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