Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > IT форум > Помощь студентам
Регистрация

Восстановить пароль

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 11.01.2009, 11:40   #1
Zerony
Пользователь
 
Аватар для Zerony
 
Регистрация: 16.10.2008
Сообщений: 20
По умолчанию Програма Pascal в Delphi

У меня такая проблемка: в паскале есть программа, которая рисует 3д графики. Нужно её переделать под Delphi. В любом виде.

Кто знает как это сделать?
Даю исходный код. Код

PHP код:
uses crt,graph;
var 
GraphDriver,GraphMode:integer;
function 
f3D(x,y:real):real;
begin f3D:=Sin (x); end;

procedure build_gr_3D(x1,y1,x2,y2,d:integer);
var 
i,j,mx,my,mz,nx,ny,xi,yi:integer;f,x,y,a1,b1,a2,b2,h1,h2,k,min,max:real;
    
up_gor,down_gor:array[0..640]of integer;
begin nx:=50;ny:=50;    {//к-ть ліній на які поділено поверхю(розмір сітки)}
setviewport(x1,y1-d,x2+d,y2,false);
my:=x2-x1;mx:=d;mz:=y2-y1;
a1:=-2;b1:=2;a2:=-4;b2:=5;
h1:=(b1-a1)/mx;h2:=(b2-a2)/my;
max:=f3D(a1,a2);min:=max;
for 
j:=0 to my do for i:=0 to mx do begin x:=a1+h1*i;y:=a2+h2*j;f:=f3D(x,y);
if 
max<f then max:=f;
if 
min>f then min:=f;end;
setcolor(8);setlinestyle(3,1,1);line(mx,0,mx,mz);line(mx,mz,my+mx,mz);line(mx,mz,0,mz+mx);
setlinestyle(0,1,1);
k:=mz/(max-min);setcolor(150);
for 
i:=0 to my do begin up_gor[i]:=round(mz+mx-(f3D(a1,i*h2+a2)-min)*k);down_gor[i]:=up_gor[i];end;
for 
i:=0 to mx do begin up_gor[i+my]:=round(mz+mx-(f3D(i*h1+a1,h2*my+a2)-min)*k-i);down_gor[i+my]:=up_gor[i+my];end;
for 
j:=0 to nx do begin
moveto
(round(j*mx/nx),round(mz+mx-(f3D(h1*j*mx/nx+a1,a2)-min)*k-j*mx/nx));
for 
i:=1 to my do begin xi:=i+round(j*mx/nx);yi:=round(mz+mx-(f3D(h1*j*mx/nx+a1,i*h2+a2)-min)*k-j*mx/nx);
                  if (
down_gor[xi]<=yi)and(yi<=up_gor[xi])and(j<>0then moveto(xi,yi)
                  else 
begin lineto(xi,yi);
                       if 
down_gor[xi]>yi then down_gor[xi]:=yi;
                       if 
up_gor[xi]<yi then up_gor[xi]:=yi;
                       
end;  end;  end;
for 
i:=0 to my do begin up_gor[i]:=round(mz+mx-(f3D(a1,i*h2+a2)-min)*k);down_gor[i]:=up_gor[i];end;
for 
i:=0 to mx do begin up_gor[i+my]:=round(mz+mx-(f3D(i*h1+a1,h2*my+a2)-min)*k-i);down_gor[i+my]:=up_gor[i+my];end;
for 
j:=ny downto 0 do begin
moveto
(round(j*my/ny),round(mz+mx-(f3D(a1,h2*j*my/ny+a2)-min)*k));
for 
i:=1 to mx do begin xi:=i+round(j*my/ny);yi:=round(mz+mx-(f3D(i*h1+a1,h2*j*my/ny+a2)-min)*k-i);
                  if (
down_gor[xi]<=yi)and(yi<=up_gor[xi])and(j<>nythen moveto(xi,yi)
                  else 
begin lineto(xi,yi);
                       if 
down_gor[xi]>yi then down_gor[xi]:=yi;
                       if 
up_gor[xi]<yi then up_gor[xi]:=yi;
                       
endendend;
setcolor(7);rectangle(0,mx,my,mz+mx);
line(0,mx,mx,0);line(mx,0,my+mx,0);line(my+mx,0,my,mx);line(my+mx,0,my+mx,mz);line(my,mz+mx,my+mx,mz);end;
begin
graphDriver
:=VGA;
GraphMode:=VGAHi;
InitGraph(graphDriver,GraphMode,'D:\bp\bgi');
build_gr_3D(1,200,410,479,200);
read;

closegraph;end


Очень нужна ваша помощь! Если кто-то переделает - выставлю пиво)
Zerony вне форума Ответить с цитированием
Старый 11.01.2009, 12:32   #2
Zerony
Пользователь
 
Аватар для Zerony
 
Регистрация: 16.10.2008
Сообщений: 20
По умолчанию

по сути надо вот эти рядки заменить
setcolor(8);setlinestyle(3,1,1);lin e(mx,0,mx,mz);line(mx,mz,my+mx,mz); line(mx,mz,0,mz+mx);
setlinestyle(0,1,1);
Zerony вне форума Ответить с цитированием
Старый 11.01.2009, 14:41   #3
Zerony
Пользователь
 
Аватар для Zerony
 
Регистрация: 16.10.2008
Сообщений: 20
По умолчанию

кто поможет - подарю 7 7мизначных асек.

Пару строчек. Не влом народ.
Zerony вне форума Ответить с цитированием
Старый 11.01.2009, 17:10   #4
Zerony
Пользователь
 
Аватар для Zerony
 
Регистрация: 16.10.2008
Сообщений: 20
По умолчанию

Люди очень надо.

Заплачу даже. В фотошопе всё что попросите сделаю.
Zerony вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Програма на Pascal: нахождение минимума с помощью процедуры в 2мерном массиве. Нужна помощь. Lopirion Помощь студентам 2 28.12.2008 21:23
програма на обработку символьной информации АлександрFRONT Паскаль, Turbo Pascal, PascalABC.NET 1 19.12.2008 13:48
Програма тестирования krolik Помощь студентам 2 21.11.2008 13:11
Запущена ли програма? RealSHELS Общие вопросы Delphi 4 14.06.2008 21:54
Програма тестирования студентов. lin Помощь студентам 6 20.04.2007 09:23