"3D models" ... 3D graph + sound, Моя первая демка. |
Давайте пожалуйста своим демо названия!
В названии темы указывайте название!
"3D models" ... 3D graph + sound, Моя первая демка. |
Altair |
22.03.2005 13:20
Сообщение
#1
|
Ищущий истину Группа: Модераторы Сообщений: 4 824 Пол: Мужской Реальное имя: Олег Репутация: 45 |
Итак, вот посмотрите, что у меня получилось
DEMO Программа демонстрирует работу следующих систем:
В архиве есть описание программы, и управление (можно самому вращать любую 3D модель. ) линк для скачивания: http://forum.pascalnet.ru/oleg_z/prog/demo.zip обязательно высказывайтесь !!! -------------------- Помогая друг другу, мы справимся с любыми трудностями!
"Не опускать крылья!" (С) |
Altair |
22.03.2005 13:57
Сообщение
#2
|
Ищущий истину Группа: Модераторы Сообщений: 4 824 Пол: Мужской Реальное имя: Олег Репутация: 45 |
Исходники.
1. сама программа (выложу ее прямо текстом) : Исходный код {$APPTYPE GUI} {$mode objfpc} {$mode delphi} uses sysutils,gxcrt,windows,graphix,gximeff,gxtext,gxmouse, classes,LBAss,bassfpc, GPAHeader; Const MaxPixelCount = 100; maxlinecount=100; type TMyThread=class(TThread) private x0,y0:longint; PixelCount:Word; {количество точек в объекте} LineCount:Word; {количество линий в объекте} CUBE :Array[0..MaxPixelCount] of double; {массив точек} lindex: array[0..maxLinecount] of integer; {линии проиндексированны, это показывает как они связанны между собой (0 с 1 ...)} xt,yt,zt:double; {промежуточные переменные для вычисления X,Y в 2D } sx,sy,sx1,sy1:integer; {переменные для прорисовки ребер (line)} zzoom:double; wx,wy,wz:double; protected Procedure ROTATE(Xan,Yan,Zan:double); Procedure DRAW(zoom:double; color:longint); procedure Execute; override; public constructor Create( FILENAME:String; PlusX,PlusY:Longint;z:double); end; Procedure TMyThread.ROTATE(Xan,Yan,Zan:double); var p:byte; {счетчикдля прохода точек} begin for p:=0 to PixelCount div 3 do begin Yt := cube[p*3+1] * COS(xan) - cube[p*3+2] * SIN(xan); Zt := cube[p*3+1] * SIN(xan) + cube[p*3+2] * COS(xan); cube[p*3+1] := Yt; cube[p*3+2] := Zt; Xt := cube[p*3] * COS(yan) - cube[p*3+2] * SIN(yan); Zt := cube[p*3] * SIN(yan) + cube[p*3+2] * COS(yan); cube[p*3] := Xt; cube[p*3+2] := Zt; Xt := cube[p*3] * COS(zan) - cube[p*3+1] * SIN(zan); Yt := cube[p*3] * SIN(zan) + cube[p*3+1] * COS(zan); cube[p*3] := Xt; cube[p*3+1] := Yt; end end; procedure TMyThread.draw(zoom:double; color:longint); {procedure to draw a cube} var p:byte; {счетчикдля прохода точек} begin for p:=0 to LineCount div 2 do begin sx:=round(zoom*cube[lindex[p*2]*3])+x0; sy:=round(zoom*cube[lindex[p*2]*3+1])+y0; sx1:=round(zoom*cube[lindex[p*2+1]*3])+x0; sy1:=round(zoom*cube[lindex[p*2+1]*3+1])+y0; line(SX,SY,sx1,sy1,color); end; end; procedure TMyThread.Execute; var i,j,k:byte; begin repeat rotate(wx,wy,wz); draw(zzoom,rgbcolorrgb(255,255,255)); sleep(20); draw(zzoom,rgbcolorrgb(0,0,0)); until Terminated; end; constructor TMyThread.Create( FILENAME:String; PlusX,PlusY:Longint;z:double); Var f:Text; i:longint; Begin Assign(f,filename); {$I-} reset(f); {$I+} If IOResult<>0 then halt(1); Readln(f,PixelCount); readln(f,LineCount); for i:=0 to pixelCount do readln(f,cube[i]); For i:=0 to linecount do readln(f,lindex[i]); close(f); x0:=PlusX; y0:=PlusY; zzoom:=z; inherited Create(false); end; var t :array[1..20] of TMyThread; gd,gm:smallint; caseobj,n,i:byte; sound:TBASS; CHsys:PFontFNT; f:file; kk,temp:byte; s:array[1..5] of string; begin s[1]:='1.txt'; s[2]:='2.txt'; s[3]:= '3.txt';s[4]:='font2.fnt'; s[5]:='ARYX.S3M'; If GPALoadArchive('mms.gpa') = 0 then begin for kk:=1 to 5 do GPAExtractToFileByID(GPAGetIDByName(pchar(s[kk]), false), pchar(s[kk])); end else halt; randomize; InitGraphiX(ig_col16,ig_col16); SetModeGraphiX(1024,768,ig_col16); bar(0,0,getmaxx,getmaxy,rgbcolorrgb(0,0,0)); InitMouse; new(CHsys,LoadFont('font2.fnt')); CHsys^.outtext(800,8,'Oleg_Z & MeD 2004-2005. ',rgbcolorrgb(165,123,234)); CHsys^.outtext(800,25,'Free Pascal Compiler ver. 1.0.9 ',rgbcolorrgb(255,255,255)); CHsys^.outtext(800,40,'Graphic library "GraphiX"',rgbcolorrgb(255,255,255)); CHsys^.outtext(800,55,'Sound library "BASS" ',rgbcolorrgb(255,255,255)); CHsys^.outtext(800,70,'"3DModels" .Oleg_Z',rgbcolorrgb(255,255,255)); CHsys^.outtext(800,85,'"LBASS" .MeD ',rgbcolorrgb(255,255,255)); CHsys^.outtext(800,115,'"GPA Spec" ',rgbcolorrgb(255,255,255)); sound.initbass; sound.load_music('aryx.s3m',1,true); sound.play_music(1); n:=7; For i:=1 to n-2 do t[i]:=TMyThread.Create('1.txt',random(getmaxx-400),random(getmaxy),random(30)+10); For i:=1 to n-2 do begin t[i].wx:=0.01*(2-random(5)); t[i].wy:=0.01*(2-random(5)); t[i].wz:=0.01*(2-random(5)); end; t[6]:=TMyThread.Create('2.txt',getmaxx div 2,getmaxy div 2,random(30)+10); t[6].wx:=0.01*(2-random(5)); t[6].wy:=0.01*(2-random(5));t[6].wz:=0.01*(2-random(5)); t[7]:=TMyThread.Create('3.txt',100,100,random(30)+10); t[7].wx:=0.01*(2-random(5)); t[7].wy:=0.01*(2-random(5)); t[7].wz:=0.01*(2-random(5)); temp:=0; repeat If keypressed then begin temp:=ord(readkey); if (temp<>27) and (temp<>13) then caseobj:=temp-48; end; if (caseobj<1) or (caseobj>n) then caseobj:=1; if IsMouseInArea(getmaxx-10,0,getmaxx,getmaxy)=128 then begin t[caseobj].wy:=t[caseobj].wy+0.01; sleep(100); end; if IsMouseInArea(0,0,10,getmaxy)=128 then begin t[caseobj].wy:=t[caseobj].wy-0.01; sleep(100); end; If isMouseInArea(0,0,getmaxx,10)=128 then begin t[caseobj].wx:=t[caseobj].wx+0.01; sleep(100); end; If ismouseInArea(0,getmaxy-10,getmaxx,getmaxy)=128 then begin t[caseobj].wx:=t[caseobj].wx-0.01; sleep(100); end; If ismouseinarea(40,40,getmaxx-40,getmaxy-40)=128 then mouseoff else mouseon; until (IsMouseInArea(0,0,getmaxx,getmaxy)>130) or (temp=13) or (temp=27); For i:=1 to n do t[i].Terminate; For i:=1 to n do t[i].Destroy; sound.donebass; for kk:=1 to 5 do begin assign(f,s[kk]); erase(f) end; end. LBASS LBass.pas ( 2.02 килобайт ) Кол-во скачиваний: 1132 GPAHeader GPAHeader.pas ( 2.34 килобайт ) Кол-во скачиваний: 1131 FPC, GraphiX, DirectXDist и BASS, Вы можете скачать отсюда: http://forum.pascalnet.ru/index.php?showtopic=3958 GPASpec отсюда: http://forum.pascalnet.ru/index.php?showtopic=4435 -------------------- Помогая друг другу, мы справимся с любыми трудностями!
"Не опускать крылья!" (С) |
Текстовая версия | 27.04.2024 19:23 |