怎样操纵3D模型(100)

请问怎样实现对某个3D模型进行操纵，如上下转动等基本操纵。不一定要用delphi实现(当然最好能用delphi实现咯)，大概需要写什么哪方面的技术？谢谢了

呵，把积分给我，我帮你实现。用Delphi+opengl你可以到这里的OPENGL的论坛　www.szshunfa.com/bbs

谢谢你了！

To stjacket,做好了没有啊？

To gimido还没有哦，有无什么好建议。

学OpenGL编3D游戏里就有显示3D模型(3DS模型)的代码,楼主可以去搜索一下,只不过那是vc+OpenGL版的,其中显示3DS模型的代码，我用Delphi翻译过来了，不知道楼主要不要，因为代码有点长,贴出来比较占页面,你如果要我就把代码贴出来。

好的，麻烦wangdonghai把代码贴出来大家参考一下啦，您也可以发到我的邮箱：stjacket@126.com 谢谢了!

纹理图片如果是256色的，需要转换为24位program Read3DS;uses Windows, Messages, OpenGL, Classes, Textures in 'Textures.pas', _3DSUtils in '_3DSUtils.pas';const Width=400;
Height=350;
c_Speed=0.5;var g_HRC:HGLRC;
g_HDC:HDC;var _3DS:TLoad3DS;
keyPressed:array[0..255] of Boolean;procedure SetupPixelFormat(ADC:HDC);var iPF:Integer;
pfdIXELFORMATDESCRIPTOR;
begin
FillChar(pfd,sizeof(pfd),0);
pfd.nSize:=sizeof(pfd);
pfd.nVersion:=1;
pfd.dwFlags:=PFD_DRAW_TO_WINDOW or PFD_SUPPORT_OPENGL or PFD_DOUBLEBUFFER;
pfd.iPixelType:=PFD_TYPE_RGBA;
pfd.iLayerType:=PFD_MAIN_PLANE;
pfd.cColorBits:=32;
pfd.cDepthBits:=16;
iPF:=ChoosePixelFormat(ADC,@pfd);
SetPixelFormat(ADC,iPF,@pfd);
end;
function IntToStr(Num : Integer) : String;
// using SysUtils increase file size by 100Kbegin
Str(Num, result);
end;
procedure Render;
begin
glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
glLoadIdentity();
if _3DS=nil then
exit;
glTranslatef(0.0,0.0,-_3DS.Scale);
_3DS.DrawModel;
glFlush;
SwapBuffers(g_HDC);
sleep(1);
end;
function WndProc(hWnd:THandle;uMsg:UINT;wParam:WPARAM;lParam:LPARAM):LRESULT;stdcall;var iw,ih:integer;
begin
case uMsg of WM_CREATE: begin
g_HDC:=GetDC(hWnd);
SetupPixelFormat(g_HDC);
g_HRC:=wglCreateContext(g_HDC);
wglMakeCurrent(g_HDC,g_HRC);
glClearColor(0.0, 0.0, 0.0, 0.0); glShadeModel(GL_SMOOTH); // use smooth shading glEnable(GL_DEPTH_TEST); // hidden surface removal glHint(GL_PERSPECTIVE_CORRECTION_HINT, GL_NICEST); // Really Nice Perspective Calculations glEnable(GL_LIGHTING); // setup cheap-o lighting glEnable(GL_LIGHT0); glEnable(GL_COLOR_MATERIAL); glEnable(GL_TEXTURE_2D);
_3DS:=TLoad3DS.Create('1.3ds');
result:=0;
exit;
end;
WM_CLOSE: begin
_3DS.Free;
wglMakeCurrent(g_HDC,0);
wglDeleteContext(g_HRC);
PostQuitMessage(0);
result:=0;
exit;
end;
WM_SIZE: begin
ih:=HiWord(lParam);
iw:=LoWord(lParam);
if ih=0 then
ih:=1;
glViewPort(0,0,iw,ih);
glMatrixMode(GL_PROJECTION);
glLoadIdentity;
gluPerspective(54.0,iw/ih,1.0,1000.0);
glMatrixMode(GL_MODELVIEW);
glLoadIdentity;
result:=0;
exit;
end;
WM_KEYDOWN: begin
keyPressed[wParam]:=True;
result:=0;
exit;
end;
WM_KEYUP: begin
keyPressed[wParam]:=False;
result:=0;
exit;
end;
end;
result:=DefWindowProc(hWnd,uMsg,wParam,lParam);
end;
function WinMain(hInstance,hPrevInstance:LongInt;
lpCmdLineChar;nShowCmd:Integer):Integer;stdcall;var wc:WNDCLASSEX;
hWnd:THandle;
msg:TMSG;
do
ne:bool;
dwExStyle,dwStyleWORD;
wRect:TRECT;
begin
result:=0;
wRect.Left:=0;
wRect.Right:=Width;
wRect.Top:=0;
wRect.Bottom:=Height;
FillChar(wc,sizeof(wc),0);
wc.cbSize:=sizeof(WNDCLASSEX);
wc.style:=CS_HREDRAW or CS_VREDRAW or CS_OWNDC;
wc.hInstance:=hInstance;
wc.lpfnWndProc:=@WndProc;
wc.hIcon:=LoadICon(0,IDI_APPLICATION);
wc.hCursor:=LoadCursor(0,IDC_ARROW);
wc.lpszClassName:='MyClass';
wc.hIconSm:=LoadIcon(0,IDI_WINLOGO);
if RegisterClassEx(wc)=0 then
exit;
dwExStyle:=WS_EX_APPWINDOW or WS_EX_WINDOWEDGE;
dwStyle:=WS_OVERLAPPEDWINDOW;
AdjustWindowRectEx(wRect,dwStyle,false,dwExStyle);
hWnd:=CreateWindowEx(0,'MyClass','3DS Viewer', dwStyle or WS_CLIPCHILDREN or WS_CLIPSIBLINGS,120,120, Width,Height,0,0,hInstance,nil);
if hWnd=0 then
exit;
ShowWindow(hWnd,SW_SHOW);
UpdateWindow(hWnd);
do
ne:=False;
while notdo
nedo
begin
PeekMessage(msg,0,0,0,PM_REMOVE);
if msg.message=WM_QUIT then
do
ne:=True else
begin
if keyPressed[VK_ESCAPE] then
do
ne:=True else
begin
Render;
TranslateMessage(msg);
DispatchMessage(msg);
end;
end;
end;
result:=msg.wParam;
end;
begin
WinMain(hInstance,0,nil,SW_SHOW);
end.

unit _3DSUtils;interfaceuses Windows,Classes,Opengl;const //基本块(Primary Chunk),位于文件的开始 PRIMARY= $4D4D;
//主块(Main Chunks) OBJECTINFO= $3D3D;
VERSION= $0002;
EDITKEYFRAME= $B000;
//对象的次级定义(包括对象的材质和对象) MATERIAL= $AFFF;
_OBJECT= $4000;
//材质的次级定义 MATNAME= $A000;
MATDIFFUSE= $A020;
MATMAP= $A200;
MATMAPFILE= $A300;
OBJ_MESH= $4100;
MAX_TEXTURES= 100;
//OBJ_MESH的次级定义 OBJ_VERTICES= $4110;
OBJ_FACES= $4120;
OBJ_MATERIAL= $4130;
OBJ_UV= $4140;type pVector3=^TVector3;
TVector3=record x,y,z:single;
end;
pVector2=^TVector2;
TVector2=record x,y:single;
end;
type TA_Vec3=array of TVector3;type TA_Vec2=array of TVector2;
pFace=^TFace;
TFace=record vertIndex:array[0..2] of Integer;
coordIndex:array[0..2] of Integer;
end;
type TA_Face=array of TFace;
pMatInfo=^TMatInfo;
TMatInfo=record strName:array[0..254] of char;
strFile:array[0..254] of char;
color:array[0..2] of Byte;
textureID:Integer;
uTile:single;
vTile:single;
uOffset:single;
vOffset:single;
end;
p3DObject=^T3DObject;
T3DObject=record numOfVerts:Integer;
numOfFaces:Integer;
numTexVertex:Integer;
materialID:Integer;
bHasTexture:boolean;
strName:array[0..254] of char;
pVertsVector3;
pNormalsVector3;
pTexVertsVector2;
pFacesFace;
end;
type p3DModel=^T3DModel;
T3DModel=record numOfObjects:Integer;
numOfMaterials:Integer;
pMaterials:TList;
pObject:TList;
end;
type pChunk=^TChunk;
TChunk=record ID:Word;
length:Cardinal;
bytesRead:Cardinal;
end;
type TA_char=array of char;type TA_Byte=array of Byte;type TLoad3DS=class private FFileName:string;
FModel:T3DModel;
FObject3DObject;
FMaterialMatInfo;
FHandle:THandle;
FReadBytes:Cardinal;
m_CurrentChunkChunk;
m_TempChunkChunk;
FTexArray:array[0..99] of Cardinal;
FScale:single;
FRotate:single;
function Load3DS:Boolean;
procedure ReadChunk(pCKChunk);
procedure ReadNextChunk(pPreCKChunk);
procedure ReadNextMatChunk(pPreCKChunk);
procedure ReadNextObjChunk(pObject3DObject;pPreCKChunk);
procedure ReadColor(pMaterialMatInfo;pPreCKChunk);
procedure ReadVertices(pObject3DObject;pPreCKChunk);
procedure ReadVertexIndices(pObject3DObject;pPreCKChunk);
procedure ReadUVCoordinates(pObject3DObject;pPreCKChunk);
procedure ReadObjMat(pObject3DObject;pPreCKChunk);
function GetString(pBufferChar):integer;
procedure ComputeNormals;
function CalcScale:single;
public constructor Create(AFileName:string);
destructor Destroy;override;
procedure DrawModel;
property Scale:single read FScale;
end;
function gluBuild2DMipmaps(Target: GLenum;
Components, Width, Height: GLint;
Format, atype: GLenum;
Data: Pointer): GLint;
stdcall;
external glu32;procedure glGenTextures(n: GLsizei;
var textures: GLuint);
stdcall;
external opengl32;procedure glBindTexture(target: GLenum;
texture: GLuint);
stdcall;
external opengl32;implementationuses Textures;{ TLoad3DS }function StrLen(const Str: PChar): Cardinal;
assembler;asm MOV EDX,EDI MOV EDI,EAX MOV ECX,0FFFFFFFFH XOR AL,AL REPNE SCASB MOV EAX,0FFFFFFFEH SUB EAX,ECX MOV EDI,EDXend;
function StrComp(const Str1, Str2: PChar): Integer;
assembler;asm PUSH EDI PUSH ESI MOV EDI,EDX MOV ESI,EAX MOV ECX,0FFFFFFFFH XOR EAX,EAX REPNE SCASB NOT ECX MOV EDI,EDX XOR EDX,EDX REPE CMPSB MOV AL,[ESI-1] MOV DL,[EDI-1] SUB EAX,EDX POP ESI POP EDIend;
function Vector(v1,v2:TVector3):TVector3;
begin
result.x:=v1.x-v2.x;
result.y:=v1.y-v2.y;
result.z:=v1.z-v2.z;
end;
function AddVector(v1,v2:TVector3):TVector3;
begin
result.x:=v2.x+v1.x;
result.y:=v2.y+v1.y;
result.z:=v2.z+v1.z;
end;
function DivideVectorByScaler(v:TVector3;Scaler:single):TVector3;
begin
result.x:=v.x/Scaler;
result.y:=v.y/Scaler;
result.z:=v.z/Scaler;
end;
function Cross(v1,v2:TVector3):TVector3;
begin
result.x:=v1.y*v2.z-v1.z*v2.y;
result.y:=v1.z*v2.x-v1.x*v2.z;
result.z:=v1.x*v2.y-v1.y*v2.x;
end;
function Mag(v:TVector3)ouble;
begin
result:=sqrt(v.x*v.x+v.y*v.y+v.z*v.z);
end;
function Normalize(v:TVector3):TVector3;var f_Magouble;
begin
f_Mag:=Mag(v);
v.x:=v.x/f_Mag;
v.y:=v.y/f_Mag;
v.z:=v.z/f_Mag;
result:=v;
end;
function TLoad3DS.CalcScale: single;var i,j:integer;
fMax,fMin:single;
pObject3DObject;
begin
fMax:=0.0;
fMin:=0.0;
for i:=0 to FModel.pObject.Count-1do
begin
pObject:=FModel.pObject;
for j:=0 to pObject.numOfVerts-1do
begin
if fMax<TA_Vec3(pObject.pVerts)[j].x then
fMax:=TA_Vec3(pObject.pVerts)[j].x;
if fMax<TA_Vec3(pObject.pVerts)[j].y then
fMax:=TA_Vec3(pObject.pVerts)[j].y;
if fMax<TA_Vec3(pObject.pVerts)[j].z then
fMax:=TA_Vec3(pObject.pVerts)[j].z;
if fMin>TA_Vec3(pObject.pVerts)[j].x then
fMin:=TA_Vec3(pObject.pVerts)[j].x;
if fMin>TA_Vec3(pObject.pVerts)[j].y then
fMin:=TA_Vec3(pObject.pVerts)[j].y;
if fMin>TA_Vec3(pObject.pVerts)[j].z then
fMin:=TA_Vec3(pObject.pVerts)[j].z;
end;
end;
FScale:=fMax-fMin;
result:=FScale;
end;
procedure TLoad3DS.ComputeNormals;var v1,v2,vNormal:TVector3;
vPoly:array[0..2] of TVector3;
i,index,j,shared:Integer;
pObject3DObject;
pNormals,pTmpNormalsVector3;
vSum,vZero:TVector3;
begin
if FModel.numOfObjects<=0 then
exit;
for index:=0 to FModel.numOfObjects-1do
begin
pObject:=p3DObject(FModel.pObject[index]);
GetMem(pNormals,pObject.numOfFaces*sizeof(TVector3));
GetMem(pTmpNormals,pObject.numOfFaces*sizeof(TVector3));
GetMem(pObject.pNormals,pObject.numOfVerts*sizeof(TVector3));
for i:=0 to pObject.numOfFaces-1do
begin
vPoly[0]:=TA_Vec3(pObject.pVerts)[TA_Face(pObject.pFaces).vertIndex[0]];
vPoly[1]:=TA_Vec3(pObject.pVerts)[TA_Face(pObject.pFaces).vertIndex[1]];
vPoly[2]:=TA_Vec3(pObject.pVerts)[TA_Face(pObject.pFaces).vertIndex[2]];
v1:=Vector(vPoly[0],vPoly[2]);
v2:=Vector(vPoly[2],vPoly[1]);
vNormal:=Cross(v1,v2);
TA_Vec3(pTmpNormals):=vNormal;
vNormal:=Normalize(vNormal);
TA_Vec3(pNormals):=vNormal;
end;
vSum.x:=0.0;
vSum.y:=0.0;
vSum.z:=0.0;
vZero:=vSum;
{vZero.x:=0.0;
vZero.y:=0.0;
vZero.z:=0.0;} shared:=0;
for i:=0 to pObject.numOfVerts-1do
begin
for j:=0 to pObject.numOfFaces-1do
begin
if (TA_Face(pObject.pFaces)[j].vertIndex[0]=i) or (TA_Face(pObject.pFaces)[j].vertIndex[1]=i) or (TA_Face(pObject.pFaces)[j].vertIndex[2]=i) then
begin
vSum:=AddVector(vSum,TA_Vec3(pTmpNormals)[j]);
inc(shared);
end;
end;
TA_Vec3(pObject.pNormals):=DivideVectorByScaler(vSum,-shared);
TA_Vec3(pObject.pNormals):=Normalize(TA_Vec3(pObject.pNormals));
vSum:=vZero;
shared:=0;
end;
FreeMem(pTmpNormals);
FreeMem(pNormals);
end;
end;
constructor TLoad3DS.Create(AFileName:string);
begin
GetMem(m_CurrentChunk,sizeof(TChunk));
GetMem(m_TempChunk,sizeof(TChunk));
FFileName:=AFileName;
FModel.pMaterials:=TList.Create;
FModel.pObject:=TList.Create;
//FS:=TFileStream.Create(FFileName,fmOpenRead);
FHandle:=CreateFile(PChar(FFilename), GENERIC_READ, FILE_SHARE_READ, nil, OPEN_EXISTING, 0, 0);
if (FHandle = INVALID_HANDLE_VALUE) then
begin
MessageBox(0, PChar('Error opening ' + FFilename), PChar('BMP Unit'), MB_OK);
Exit;
end;
Load3DS;
end;
destructor TLoad3DS.Destroy;
begin
FreeMem(m_TempChunk);
FreeMem(m_CurrentChunk);
FModel.pMaterials.Free;
FModel.pObject.Free;
CloseHandle(FHandle);
inherited Destroy;
end;
procedure TLoad3DS.DrawModel;var i,j,index,tex:Integer;
pObject3DObject;
begin
glPushAttrib(GL_CURRENT_BIT);
glPushMatrix;
glDisable(GL_TEXTURE_2D);
if FRotate>=360.0 then
FRotate:=0.0 else
FRotate:=FRotate+0.3;
glRotatef(FRotate, 0, 1.0, 0);
for i:=0 to FModel.numOfObjects-1do
begin
if FModel.pObject.Count<=0 then
exit;
pObject:=p3DObject(FModel.pObject);
if pObject.bHasTexture then
begin
glEnable(GL_TEXTURE_2D);
glBindTexture(GL_TEXTURE_2D,FTexArray[pObject.materialID]);
end else
glDisable(GL_TEXTURE_2D);
glbegin
(GL_TRIANGLES);
for j:=0 to pObject.numOfFaces-1do
begin
for tex:=0 to 2do
begin
index:=TA_Face(pObject.pFaces)[j].vertIndex[tex];
glNormal3fv(@TA_Vec3(pObject.pNormals)[index]);
if pObject.bHasTexture then
begin
if pObject.pTexVerts<>nil then
glTexCoord2fv(@TA_Vec2(pObject.pTexVerts)[index]);
end else
glColor3ubv(@(pMatInfo(FModel.pMaterials[pObject.materialID]).color));
glVertex3fv(@TA_Vec3(pObject.pVerts)[index]);
end;
end;
glend;
glColor3f(1.0, 1.0, 1.0);
glEnable(GL_TEXTURE_2D);
glPopMatrix;
glPopAttrib;
end;
end;
function TLoad3DS.GetString(pBuffer: PChar): integer;var index:Cardinal;
//c:char;
begin
index:=0;
//FS.Read(pBuffer^,1);
ReadFile(FHandle,pBuffer^,1,FReadBytes,nil);
while PChar(pBuffer+index)^<>#0do
begin
inc(index);
//FS.Read(PChar(pBuffer+index)^,1);
ReadFile(FHandle,PChar(pBuffer+index)^,1,FReadBytes,nil);
end;
{FS.Read(c,1);
while c<>#0do
begin
TA_char(pBuffer)[index]:=c;
FS.Read(c,1);
inc(index);
end;
} result:=strlen(pBuffer)+1;
end;
function TLoad3DS.Load3DS: Boolean;var i:Cardinal;
begin
result:=False;
ReadChunk(m_CurrentChunk);
if m_CurrentChunk.ID<>PRIMARY then
exit;
ReadNextChunk(m_CurrentChunk);
ComputeNormals;
for i:=0 to FModel.numOfMaterials-1do
begin
if strlen(pMatInfo(FModel.pMaterials)^.strFile)>0 then
LoadTexture(pMatInfo(FModel.pMaterials)^.strFile,FTexArray,False);
pMatInfo(FModel.pMaterials)^.textureID:=i;
end;
CalcScale;
end;
procedure TLoad3DS.ReadChunk(pCK: pChunk);
begin
ReadFile(FHandle,pCK.ID,2,FReadBytes,nil);
pCK.bytesRead:=FReadBytes;
ReadFile(FHandle,pCK.length,4,FReadBytes,nil);
pCK.bytesRead:=pCK.bytesRead+FReadBytes;
end;
procedure TLoad3DS.ReadColor(pMaterial: pMatInfo;
pPreCK: pChunk);
begin
ReadChunk(m_TempChunk);
ReadFile(FHandle,pMaterial.color[0],m_TempChunk.length-m_TempChunk.bytesRead, FReadBytes,nil);
m_TempChunk.bytesRead:=m_TempChunk.bytesRead+FReadBytes;
inc(pPreCK.bytesRead,m_TempChunk.bytesRead);
end;
procedure TLoad3DS.ReadNextChunk(pPreCK: pChunk);var TmpChunkChunk;
vs:Cardinal;
newObject3DObject;
newTextureMatInfo;
begin
GetMem(TmpChunk,sizeof(TChunk));
m_CurrentChunk:=TmpChunk;
while pPreCK.bytesRead<pPreCK.lengthdo
begin
ReadChunk(m_CurrentChunk);
case m_CurrentChunk.ID of VERSION: // begin
ReadFile(FHandle,vs,m_CurrentChunk.length-m_CurrentChunk.bytesRead, FReadBytes,nil);
m_CurrentChunk.bytesRead:=m_CurrentChunk.bytesRead+FReadBytes;
if vs>$03 then
exit;
end;
OBJECTINFO: // begin
ReadChunk(m_TempChunk);
ReadFile(FHandle,vs,m_TempChunk.length-m_TempChunk.bytesRead, FReadBytes,nil);
m_TempChunk.bytesRead:=m_TempChunk.bytesRead+FReadBytes;
inc(m_CurrentChunk.bytesRead,m_TempChunk.bytesRead);
ReadNextChunk(m_CurrentChunk);
end;
MATERIAL: // begin
inc(FModel.numOfMaterials);
GetMem(newTexture,sizeof(TMatInfo));
FModel.pMaterials.Add(newTexture);
FMaterial:=pMatInfo(FModel.pMaterials[FModel.numOfMaterials-1]);
FillChar(FMaterial.strName,255,#0);
FillChar(FMaterial.strFile,255,#0);
ReadNextMatChunk(m_CurrentChunk);
end;
_OBJECT: // begin
inc(FModel.numOfObjects);
GetMem(newObject,sizeof(T3DObject));
FModel.pObject.Add(newObject);
FObject:=p3DObject(FModel.pObject[FModel.numOfObjects-1]);
FillChar(FObject.strName,255,#0);
m_CurrentChunk.bytesRead:=m_CurrentChunk.bytesRead+ Cardinal(GetString(FObject.strName));
ReadNextObjChunk(FObject,m_CurrentChunk);
end;
EDITKEYFRAME: // begin
SetFilePointer(FHandle,m_CurrentChunk.length-m_CurrentChunk.bytesRead, nil,1);
inc(m_CurrentChunk.bytesRead,m_CurrentChunk.length-m_CurrentChunk.bytesRead);
end;
else
begin
SetFilePointer(FHandle,m_CurrentChunk.length-m_CurrentChunk.bytesRead, nil,1);
inc(m_CurrentChunk.bytesRead,m_CurrentChunk.length-m_CurrentChunk.bytesRead);
end;
end;
pPreCK.bytesRead:=pPreCK.bytesRead+m_CurrentChunk.bytesRead;
end;
FreeMem(m_CurrentChunk);
m_CurrentChunk:=pPreCK;
end;
procedure TLoad3DS.ReadNextMatChunk(pPreCK: pChunk);var //buffer:array[0..50000] of Integer;
TmpChunkChunk;
begin
GetMem(TmpChunk,sizeof(TChunk));
m_CurrentChunk:=TmpChunk;
while pPreCK.bytesRead<pPreCK.lengthdo
begin
ReadChunk(m_CurrentChunk);
case m_CurrentChunk.ID of MATNAME: begin
FillChar(FMaterial^.strName,255,#0);
ReadFile(FHandle,FMaterial^.strName,m_CurrentChunk.length- m_CurrentChunk.bytesRead,FReadBytes,nil);
m_CurrentChunk.bytesRead:=m_CurrentChunk.bytesRead+FReadBytes;
end;
MATDIFFUSE: begin
ReadColor(FMaterial,m_CurrentChunk);
end;
MATMAP: begin
ReadNextMatChunk(m_CurrentChunk);
end;
MATMAPFILE: begin
FillChar(FMaterial.strFile,255,#0);
ReadFile(FHandle,FMaterial^.strFile,m_CurrentChunk.length- m_CurrentChunk.bytesRead,FReadBytes,nil);
m_CurrentChunk.bytesRead:=m_CurrentChunk.bytesRead+FReadBytes;
end;
else
begin
SetFilePointer(FHandle,m_CurrentChunk.length-m_CurrentChunk.bytesRead, nil,1);
inc(m_CurrentChunk.bytesRead,m_CurrentChunk.length-m_CurrentChunk.bytesRead);
end;
end;
inc(pPreCK.bytesRead,m_CurrentChunk.bytesRead);
end;
FreeMem(m_CurrentChunk);
m_CurrentChunk:=pPreCK;
end;
procedure TLoad3DS.ReadNextObjChunk(pObject: p3DObject;
pPreCK: pChunk);var //buffer:array[0..50000] of Integer;
TmpChunkChunk;
begin
GetMem(TmpChunk,sizeof(TChunk));
m_CurrentChunk:=TmpChunk;
while pPreCK.bytesRead<pPreCK.lengthdo
begin
ReadChunk(m_CurrentChunk);
case m_CurrentChunk.ID of OBJ_MESH: ReadNextObjChunk(FObject,m_CurrentChunk);
OBJ_VERTICES: ReadVertices(FObject,m_CurrentChunk);
OBJ_FACES: ReadVertexIndices(FObject,m_CurrentChunk);
OBJ_MATERIAL: ReadObjMat(FObject,m_CurrentChunk);
OBJ_UV: ReadUVCoordinates(FObject,m_CurrentChunk);
else
begin
SetFilePointer(FHandle,m_CurrentChunk.length-m_CurrentChunk.bytesRead, nil,1);
inc(m_CurrentChunk.bytesRead,m_CurrentChunk.length-m_CurrentChunk.bytesRead);
end;
end;
inc(pPreCK.bytesRead,m_CurrentChunk.bytesRead);
end;
FreeMem(m_CurrentChunk);
m_CurrentChunk:=pPreCK;
end;
procedure TLoad3DS.ReadObjMat(pObject: p3DObject;
pPreCK: pChunk);var strMaterial:array[0..254] of char;
//buffer:array[0..50000] of Integer;
i:integer;
begin
fillchar(strMaterial,255,#0);
inc(pPreCK.bytesRead,GetString(strMaterial));
for i:=0 to FModel.numOfMaterials-1do
begin
if strcomp(strMaterial,pMatInfo(FModel.pMaterials).strName)=0 then
begin
FObject.materialID:=i;
if strlen(pMatInfo(FModel.pMaterials).strFile)>0 then
FObject.bHasTexture:=True;
break;
end else
FObject.materialID:=-1;
end;
SetFilePointer(FHandle,pPreCK.length-pPreCK.bytesRead,nil,1);
inc(pPreCK.bytesRead,pPreCK.length-pPreCK.bytesRead);
end;
procedure TLoad3DS.ReadUVCoordinates(pObject: p3DObject;
pPreCK: pChunk);
begin
ReadFile(FHandle,FObject.numTexVertex,2,FReadBytes,nil);
pPreCK.bytesRead:=pPreCK.bytesRead+FReadBytes;
GetMem(FObject.pTexVerts,FObject.numTexVertex*sizeof(TVector2));
ReadFile(FHandle,FObject.pTexVerts^,pPreCk.length-pPreCK.bytesRead, FReadBytes,nil);
pPreCK.bytesRead:=pPreCK.bytesRead+FReadBytes;
end;
procedure TLoad3DS.ReadVertexIndices(pObject: p3DObject;
pPreCK: pChunk);var i,j,index:Word;
begin
ReadFile(FHandle,FObject.numOfFaces,2,FReadBytes,nil);
pPreCK.bytesRead:=pPreCK.bytesRead+FReadBytes;
GetMem(FObject.pFaces,FObject.numOfFaces*sizeof(TFace));
FillChar(FObject.pFaces^,FObject.numOfFaces*sizeof(TFace),0);
for i:=0 to FObject.numOfFaces-1do
for j:=0 to 3do
begin
ReadFile(FHandle,index,sizeof(Word),FReadBytes,nil);
pPreCK.bytesRead:=pPreCK.bytesRead+FReadBytes;
if j<3 then
TA_Face(FObject.pFaces).vertIndex[j]:=index;
end;
end;
procedure TLoad3DS.ReadVertices(pObject: p3DObject;
pPreCK: pChunk);var i:Integer;
fTempY:single;
begin
ReadFile(FHandle,FObject.numOfVerts,2,FReadBytes,nil);
pPreCK.bytesRead:=pPreCK.bytesRead+FReadBytes;
GetMem(FObject.pVerts,FObject.numOfVerts*sizeof(TVector3));
FillChar(FObject.pVerts^,FObject.numOfVerts*sizeof(TVector3),0);
ReadFile(FHandle,FObject.pVerts^,pPreCK.length-pPreCK.bytesRead, FReadBytes,nil);
pPreCK.bytesRead:=pPreCK.bytesRead+FReadBytes;
for i:=0 to FObject.numOfVerts-1do
begin
fTempY:=TA_Vec3(FObject.pVerts).y;
TA_Vec3(FObject.pVerts).y:=TA_Vec3(FObject.pVerts).z;
TA_Vec3(FObject.pVerts).z:=-fTempY;
end;
end;
end.

//----------------------------------------------------------------------------//// Author : Jan Horn// Email : jhorn@global.co.za// Website : http://www.sulaco.co.za// http://home.global.co.za/~jhorn// Version : 1.02// Date : 1 May 2001// Changes : 2 October - Added support for 32bit TGA files// 28 July - Faster BGR to RGB swapping routine//// Description : A unit that used with OpenGL projects to load BMP, JPG and TGA// files from the disk or a resource file.// Usage : LoadTexture(Filename, TextureName, LoadFromResource);//// eg : LoadTexture('logo.jpg', LogoTex, TRUE);// will load a JPG texture from the resource included// with the EXE. File has to be loaded into the Resource// using this format "logo JPEG logo.jpg"////----------------------------------------------------------------------------unit Textures;interfaceuses Windows, OpenGL, Graphics, Classes, JPEG, SysUtils;function LoadTexture(Filename: String;
var Texture: GLuint;
LoadFromRes : Boolean): Boolean;implementationfunction gluBuild2DMipmaps(Target: GLenum;
Components, Width, Height: GLint;
Format, atype: GLenum;
Data: Pointer): GLint;
stdcall;
external glu32;procedure glGenTextures(n: GLsizei;
var textures: GLuint);
stdcall;
external opengl32;procedure glBindTexture(target: GLenum;
texture: GLuint);
stdcall;
external opengl32;{------------------------------------------------------------------}{ Swap bitmap format from BGR to RGB }{------------------------------------------------------------------}procedure SwapRGB(data : Pointer;
Size : Integer);asm mov ebx, eax mov ecx, size@@loop : mov al,[ebx+0] mov ah,[ebx+2] mov [ebx+2],al mov [ebx+0],ah add ebx,3 dec ecx jnz @@loopend;
{------------------------------------------------------------------}{ Create the Texture }{------------------------------------------------------------------}function CreateTexture(Width, Height, Format : Word;
pData : Pointer) : Integer;var Texture : GLuint;
begin
glGenTextures(1, Texture);
glBindTexture(GL_TEXTURE_2D, Texture);
glTexEnvi(GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE);
{Texture blends with object background}// glTexEnvi(GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_DECAL);
{Texturedo
es NOT blend with object background} { Select a filtering type. BiLinear filtering produces very good results with little performance impact GL_NEAREST - Basic texture (grainy looking texture) GL_LINEAR - BiLinear filtering GL_LINEAR_MIPMAP_NEAREST - Basic mipmapped texture GL_LINEAR_MIPMAP_LINEAR - BiLinear Mipmapped texture } glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR);
{ only first two can be used } glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
{ all of the above can be used } if Format = GL_RGBA then
gluBuild2DMipmaps(GL_TEXTURE_2D, GL_RGBA, Width, Height, GL_RGBA, GL_UNSIGNED_BYTE, pData) else
gluBuild2DMipmaps(GL_TEXTURE_2D, 3, Width, Height, GL_RGB, GL_UNSIGNED_BYTE, pData);// glTexImage2D(GL_TEXTURE_2D, 0, 3, Width, Height, 0, GL_RGB, GL_UNSIGNED_BYTE, pData);
// Use when not wanting mipmaps to be built by openGL result :=Texture;
end;
{------------------------------------------------------------------}{ Load BMP textures }{------------------------------------------------------------------}function LoadBMPTexture(Filename: String;
var Texture : GLuint;
LoadFromResource : Boolean) : Boolean;var FileHeader: BITMAPFILEHEADER;
InfoHeader: BITMAPINFOHEADER;
Palette: array of RGBQUAD;
BitmapFile: THandle;
BitmapLength: LongWord;
PaletteLength: LongWord;
ReadBytes: LongWord;
Width, Height : Integer;
pData : Pointer;
// used for loading from resource ResStream : TResourceStream;
begin
result :=FALSE;
if LoadFromResource then
// Load from resource begin
try ResStream := TResourceStream.Create(hInstance, PChar(copy(Filename, 1, Pos('.', Filename)-1)), 'BMP');
ResStream.ReadBuffer(FileHeader, SizeOf(FileHeader));
// FileHeader ResStream.ReadBuffer(InfoHeader, SizeOf(InfoHeader));
// InfoHeader PaletteLength := InfoHeader.biClrUsed;
SetLength(Palette, PaletteLength);
ResStream.ReadBuffer(Palette, PaletteLength);
// Palette Width := InfoHeader.biWidth;
Height := InfoHeader.biHeight;
BitmapLength := InfoHeader.biSizeImage;
if BitmapLength = 0 then
BitmapLength := Width * Height * InfoHeader.biBitCount Div 8;
GetMem(pData, BitmapLength);
ResStream.ReadBuffer(pData^, BitmapLength);
// Bitmap Data ResStream.Free;
except on EResNotFounddo
begin
MessageBox(0, PChar('File not found in resource - ' + Filename), PChar('BMP Texture'), MB_OK);
Exit;
end else
begin
MessageBox(0, PChar('Unable to read from resource - ' + Filename), PChar('BMP Unit'), MB_OK);
Exit;
end;
end;
end else
begin
// Load image from file BitmapFile := CreateFile(PChar(Filename), GENERIC_READ, FILE_SHARE_READ, nil, OPEN_EXISTING, 0, 0);
if (BitmapFile = INVALID_HANDLE_VALUE) then
begin
MessageBox(0, PChar('Error opening ' + Filename), PChar('BMP Unit'), MB_OK);
Exit;
end;
// Get header information ReadFile(BitmapFile, FileHeader, SizeOf(FileHeader), ReadBytes, nil);
ReadFile(BitmapFile, InfoHeader, SizeOf(InfoHeader), ReadBytes, nil);
// Get palette PaletteLength := InfoHeader.biClrUsed;
SetLength(Palette, PaletteLength);
ReadFile(BitmapFile, Palette, PaletteLength, ReadBytes, nil);
if (ReadBytes <> PaletteLength) then
begin
MessageBox(0, PChar('Error reading palette'), PChar('BMP Unit'), MB_OK);
Exit;
end;
Width := InfoHeader.biWidth;
Height := InfoHeader.biHeight;
BitmapLength := InfoHeader.biSizeImage;
if BitmapLength = 0 then
BitmapLength := Width * Height * InfoHeader.biBitCount Div 8;
// Get the actual pixel data GetMem(pData, BitmapLength);
ReadFile(BitmapFile, pData^, BitmapLength, ReadBytes, nil);
if (ReadBytes <> BitmapLength) then
begin
MessageBox(0, PChar('Error reading bitmap data'), PChar('BMP Unit'), MB_OK);
Exit;
end;
CloseHandle(BitmapFile);
end;
// Bitmaps are stored BGR and not RGB, so swap the R and B bytes. SwapRGB(pData, Width*Height);
Texture :=CreateTexture(Width, Height, GL_RGB, pData);
FreeMem(pData);
result :=TRUE;
end;
{------------------------------------------------------------------}{ Load JPEG textures }{------------------------------------------------------------------}function LoadJPGTexture(Filename: String;
var Texture: GLuint;
LoadFromResource : Boolean): Boolean;var Data : Array of LongWord;
W, Width : Integer;
H, Height : Integer;
BMP : TBitmap;
JPG : TJPEGImage;
C : LongWord;
Line : ^LongWord;
ResStream : TResourceStream;
// used for loading from resourcebegin
result :=FALSE;
JPG:=TJPEGImage.Create;
if LoadFromResource then
// Load from resource begin
try ResStream := TResourceStream.Create(hInstance, PChar(copy(Filename, 1, Pos('.', Filename)-1)), 'JPEG');
JPG.LoadFromStream(ResStream);
ResStream.Free;
except on EResNotFounddo
begin
MessageBox(0, PChar('File not found in resource - ' + Filename), PChar('JPG Texture'), MB_OK);
Exit;
end else
begin
MessageBox(0, PChar('Couldn''t load JPG Resource - "'+ Filename +'"'), PChar('BMP Unit'), MB_OK);
Exit;
end;
end;
end else
begin
try JPG.LoadFromFile(Filename);
except MessageBox(0, PChar('Couldn''t load JPG - "'+ Filename +'"'), PChar('BMP Unit'), MB_OK);
Exit;
end;
end;
// Create Bitmap BMP:=TBitmap.Create;
BMP.pixelformat:=pf32bit;
BMP.width:=JPG.width;
BMP.height:=JPG.height;
BMP.canvas.draw(0,0,JPG);
// Copy the JPEG onto the Bitmap // BMP.SaveToFile('D:/test.bmp');
Width :=BMP.Width;
Height :=BMP.Height;
SetLength(Data, Width*Height);
For H:=0 to Height-1do
begin
Line :=BMP.scanline[Height-H-1];
// flip JPEG For W:=0 to Width-1do
begin
c:=Line^ and $FFFFFF;
// Need todo
a color swap Data[W+(H*Width)] :=(((c and $FF) shl 16)+(c shr 16)+(c and $FF00)) or $FF000000;
// 4 channel. inc(Line);
end;
end;
BMP.free;
JPG.free;
Texture :=CreateTexture(Width, Height, GL_RGBA, addr(Data[0]));
result :=TRUE;
end;
{------------------------------------------------------------------}{ Loads 24 and 32bpp (alpha channel) TGA textures }{------------------------------------------------------------------}function LoadTGATexture(Filename: String;
var Texture: GLuint;
LoadFromResource : Boolean): Boolean;var TGAHeader : packed record // Header type for TGA images FileType : Byte;
ColorMapType : Byte;
ImageType : Byte;
ColorMapSpec : Array[0..4] of Byte;
OrigX : Array [0..1] of Byte;
OrigY : Array [0..1] of Byte;
Width : Array [0..1] of Byte;
Height : Array [0..1] of Byte;
BPP : Byte;
ImageInfo : Byte;
end;
TGAFile : File;
bytesRead : Integer;
image : Pointer;
{or PRGBTRIPLE} Width, Height : Integer;
ColorDepth : Integer;
ImageSize : Integer;
I : Integer;
Front: ^Byte;
Back: ^Byte;
Temp: Byte;
ResStream : TResourceStream;
// used for loading from resourcebegin
result :=FALSE;
GetMem(Image, 0);
if LoadFromResource then
// Load from resource begin
try ResStream := TResourceStream.Create(hInstance, PChar(copy(Filename, 1, Pos('.', Filename)-1)), 'TGA');
ResStream.ReadBuffer(TGAHeader, SizeOf(TGAHeader));
// FileHeader result :=TRUE;
except on EResNotFounddo
begin
MessageBox(0, PChar('File not found in resource - ' + Filename), PChar('TGA Texture'), MB_OK);
Exit;
end else
begin
MessageBox(0, PChar('Unable to read from resource - ' + Filename), PChar('BMP Unit'), MB_OK);
Exit;
end;
end;
end else
begin
if FileExists(Filename) then
begin
AssignFile(TGAFile, Filename);
Reset(TGAFile, 1);
// Read in the bitmap file header BlockRead(TGAFile, TGAHeader, SizeOf(TGAHeader));
result :=TRUE;
end else
begin
MessageBox(0, PChar('File not found - ' + Filename), PChar('TGA Texture'), MB_OK);
Exit;
end;
end;
if Result = TRUE then
begin
Result :=FALSE;
// Only support uncompressed images if (TGAHeader.ImageType <> 2) then
{ TGA_RGB } begin
Result := False;
CloseFile(tgaFile);
MessageBox(0, PChar('Couldn''t load "'+ Filename +'". Compressed TGA files not supported.'), PChar('TGA File Error'), MB_OK);
Exit;
end;
//do
n't support colormapped files if TGAHeader.ColorMapType <> 0 then
begin
Result := False;
CloseFile(TGAFile);
MessageBox(0, PChar('Couldn''t load "'+ Filename +'". Colormapped TGA files not supported.'), PChar('TGA File Error'), MB_OK);
Exit;
end;
// Get the width, height, and color depth Width := TGAHeader.Width[0] + TGAHeader.Width[1] * 256;
Height := TGAHeader.Height[0] + TGAHeader.Height[1] * 256;
ColorDepth := TGAHeader.BPP;
ImageSize := Width*Height*(ColorDepth div 8);
if ColorDepth < 24 then
begin
Result := False;
CloseFile(TGAFile);
MessageBox(0, PChar('Couldn''t load "'+ Filename +'". Only 24 bit TGA files supported.'), PChar('TGA File Error'), MB_OK);
Exit;
end;
GetMem(Image, ImageSize);
if LoadFromResource then
// Load from resource begin
try ResStream.ReadBuffer(Image^, ImageSize);
ResStream.Free;
except MessageBox(0, PChar('Unable to read from resource - ' + Filename), PChar('BMP Unit'), MB_OK);
Exit;
end;
end else
// Read in the image from file begin
BlockRead(TGAFile, image^, ImageSize, bytesRead);
if bytesRead <> ImageSize then
begin
Result := False;
CloseFile(TGAFile);
MessageBox(0, PChar('Couldn''t read file "'+ Filename +'".'), PChar('TGA File Error'), MB_OK);
Exit;
end;
end;
end;
// TGAs are stored BGR and not RGB, so swap the R and B bytes. // 32 bit TGA files have alpha channel and gets loaded differently if TGAHeader.BPP = 24 then
begin
for I :=0 to Width * Height - 1do
begin
Front := Pointer(Integer(Image) + I*3);
Back := Pointer(Integer(Image) + I*3 + 2);
Temp := Front^;
Front^ := Back^;
Back^ := Temp;
end;
Texture :=CreateTexture(Width, Height, GL_RGB, Image);
end else
begin
for I :=0 to Width * Height - 1do
begin
Front := Pointer(Integer(Image) + I*4);
Back := Pointer(Integer(Image) + I*4 + 2);
Temp := Front^;
Front^ := Back^;
Back^ := Temp;
end;
Texture :=CreateTexture(Width, Height, GL_RGBA, Image);
end;
Result :=TRUE;
FreeMem(Image);
end;
{------------------------------------------------------------------}{ Determines file type and sends to correct function }{------------------------------------------------------------------}function LoadTexture(Filename: String;
var Texture : GLuint;
LoadFromRes : Boolean) : Boolean;
begin
if copy(Uppercase(filename), length(filename)-3, 4) = '.BMP' then
LoadBMPTexture(Filename, Texture, LoadFromRes);
if copy(Uppercase(filename), length(filename)-3, 4) = '.JPG' then
LoadJPGTexture(Filename, Texture, LoadFromRes);
if copy(Uppercase(filename), length(filename)-3, 4) = '.TGA' then
LoadTGATexture(Filename, Texture, LoadFromRes);
end;
end.

多谢各位仁兄的热心帮助!