Исходники.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 Нажмите для просмотра прикрепленного файлаGPAHeader Нажмите для просмотра прикрепленного файлаFPC, GraphiX, DirectXDist и BASS, Вы можете скачать отсюда:
http://forum.pascal.net.ru/index.php?showtopic=3958GPASpec отсюда:
http://forum.pascal.net.ru/index.php?showtopic=4435
