VPF::Програма Pascal в Delphi - Форум программистов

Zerony

Дата 11.1.2009, 11:19 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 89
Регистрация: 21.12.2008

Репутация: нет
Всего: нет

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

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

Код


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<>0) then 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<>ny) then 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;
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.1.2009, 12:32 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 89
Регистрация: 21.12.2008

Репутация: нет
Всего: нет

По сути надо вот это

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);

сделать так как это в делфи делают (или директ х или оупен)

Kesh

Дата 11.1.2009, 15:56 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Эксперт
Сообщений: 2488
Регистрация: 31.7.2002
Где: Германия, Saarbrü cken

Репутация: 1
Всего: 54

Порпобуйте crt и graph скопировать из паскаля в папку с программой.

--------------------

Zerony

Дата 11.1.2009, 16:16 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 89
Регистрация: 21.12.2008

Репутация: нет
Всего: нет

Оно по форме рисовать не будет - 100%

А мне надо чтоб как канва по Panel1 рисовала.

Но странно Panel1.canvas.MoveTo(mx,0); - мне ошибку выдает. Кто в курсе что может быть не так?

Zerony

Дата 11.1.2009, 16:57 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 89
Регистрация: 21.12.2008

Репутация: нет
Всего: нет

Очень прошу помощи.

Если б не спешил то сделал бы сам. А так строки поджимают.

Отдам всё вебмани что есть за помощь. И 7-значные аськи. Плизз очень надо.

Это сообщение отредактировал(а) Zerony - 11.1.2009, 16:58

Alexeis

Дата 12.1.2009, 10:40 (ссылка)

(нет голосов)

Загрузка ...

Амеба

Профиль
Группа: Админ
Сообщений: 11743
Регистрация: 12.10.2005
Где: Зеленоград

Репутация: 55
Всего: 459

Zerony, у панельки нет канвы. На нее нужно кинуть TPaintBox или TImage.

--------------------

Vit вечная память.

Обсуждение действий администрации форума производятся только в этом форуме

гениальность идеи состоит в том, что ее невозможно придумать

marinovsoft

Дата 28.1.2009, 18:35 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 47
Регистрация: 25.1.2009
Где: Кемерово

Репутация: нет
Всего: нет

На форму кинуть Timage. Выставить Width:=640;Height:=480;

Код


unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls;

type
  TForm1 = class(TForm)
    Image1: TImage;
    procedure FormActivate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormActivate(Sender: TObject);
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
  With Image1.Canvas Do
  Begin
    Brush.Color:=Clblack;
    FillRect(Rect(0,0,640,480));
    Nx:=50;
    Ny:=50;
    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;
    Pen.Color:=Clgray;
    //SetColor(8);
    //SetLineStyle(3,1,1);
    Pen.Style := Psdash;
    //Line(Mx,0,Mx,Mz);
    MoveTo(Mx,0);
    LineTo(Mx,Mz);
    //Line(Mx,Mz,My+Mx,Mz);
    MoveTo(Mx,Mz);
    LineTo(My+Mx,Mz);
    //Line(Mx,Mz,0,Mz+Mx);
    MoveTo(Mx,Mz);
    LineTo(0,Mz+Mx);
    Pen.Style := Pssolid;
    //SetLineStyle(0,1,1);
    K:=Mz/(Max-Min);
    //SetColor(150);
    Pen.Color:=$00A0A0;
    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<>0) Then 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<>Ny) Then 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;
    //SetColor(7);
    Pen.Color:=Clwhite;
    //Rectangle(0,Mx,My,Mz+Mx);

    MoveTo(0,Mx);
    LineTo(My,Mx);
    LineTo(My,Mz+Mx);
    LineTo(0,Mz+Mx);
    LineTo(0,Mx);

    //Line(0,Mx,Mx,0);
    MoveTo(0,Mx);
    LineTo(Mx,0);
    //Line(Mx,0,My+Mx,0);
    MoveTo(Mx,0);
    LineTo(My+Mx,0);
    //Line(My+Mx,0,My,Mx);
    MoveTo(My+Mx,0);
    LineTo(My,Mx);
    //Line(My+Mx,0,My+Mx,Mz);
    MoveTo(My+Mx,0);
    LineTo(My+Mx,Mz);
    //Line(My,Mz+Mx,My+Mx,Mz);
    MoveTo(My,Mz+Mx);
    LineTo(My+Mx,Mz);
  End;
End;
Begin
  Build_Gr_3D(1,200,410,479,200);
End;

end.

Удачи!

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Звук, графика и видео \| Следующая тема »