![]() |
1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code].
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!
![]() ![]() |
![]() |
klem4 |
![]()
Сообщение
#1
|
![]() Perl. Just code it! ![]() ![]() ![]() ![]() ![]() ![]() Группа: Модераторы Сообщений: 4 100 Пол: Мужской Реальное имя: Андрей Репутация: ![]() ![]() ![]() |
Вот от нечего делать решил сделать свою программу, в принципе все делается достаточно стандартными способами, вот только отрисовка осей с точками получилось достаточно громоздкая, но может кому-нибудь пригодится ...
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";'
|
Altair |
![]()
Сообщение
#2
|
![]() Ищущий истину ![]() ![]() ![]() ![]() ![]() ![]() Группа: Модераторы Сообщений: 4 824 Пол: Мужской Реальное имя: Олег Репутация: ![]() ![]() ![]() |
назвался горшком полезай в печь!
РАз взялся за это то сделай материал для ФАКа ... эту свою прогу в качестве фичи, а так все проще напиши! Как выводить графики ! с пояснениями, красиво что быбыло. эту мессагу удалишь. ![]() ![]() Сообщение отредактировано: volvo - 16.11.2005 20:47 -------------------- Помогая друг другу, мы справимся с любыми трудностями!
"Не опускать крылья!" (С) |
![]() ![]() |
![]() |
Текстовая версия | 28.07.2025 9:42 |