Open GL(100分)

  • 主题发起人 主题发起人 小飞点
  • 开始时间 开始时间

小飞点

Unregistered / Unconfirmed
GUEST, unregistred user!
请问:如何在Delphi 7 中使用 Open GL 将一张BMP(JPG)图片生成具有3D效果并能旋转的图象?最好有原代码.
 
好象OpenGl,是图形的东西,而图片是图象的,,图形是需要建模的...图片恐怕不好使吧...
 
有道理,而且需要OPENGL支持
 
你最好直接支持opengl1.2,下在网络上面的open12.pas
因为在opengl.pas当中有几个函数的参数错误。
1)建立场景。
2)创建物体
3)贴图
4)旋转等动作。
 
dcsdcs : 能否具体点.opengl 不太熟悉
 
unit Main;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, GL, GLu, GLext, TGA, CgWindow, CgTexture, CgUtils, CgTypes,
CgGeometry;

type
TTTForm = class(TCGForm)
procedure FormCreate(Sender: TObject);
procedure FormResize(Sender: TObject);
procedure FormPaint(Sender: TObject);
procedure FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
private
{ Private declarations }
public
procedure LoadTerrain;
procedure LoadTextures;
procedure ConfigureSinglePass;
procedure ConfigureMultiPass;
procedure RenderSinglePass;
procedure RenderMultiPass;
procedure Idle(Sender: TObject; var Done: Boolean);
end;

type
TTerrainVertex = record
R, G, B, A: Single;
U1, V1, U2, V2: Single;
X, Y, Z: Single;
end;

var
TTForm: TTTForm;
va: array of TTerrainVertex; // Vertex array
ia: array of array of Cardinal; // Index arrays
T1, T2, T3, L: GLuint; // Texture objects
cam: record // Camera information
pos: TCGVector;
pitch, yaw: Single;
end;
mpos: TPoint; // Mouse position
mW, mH: Integer; // Heightmap dimensions
renderProc: procedure of object; // Single pass/multipass render?

implementation

{$R *.dfm}

procedure TTTForm.LoadTerrain;
var
bmp: TBitmap;
x, y: Integer;
map: array of array of Byte;
LUT, coverage: TBitmap;

function CalcSlope(x, y: Integer): Single;
var
s1, s2, s3, s4, s5, s6, s7, s8: Byte;
begin

// Calculate slope for a pixel on the heightmap by looking at its neighbors.

if (x = 0) or (y = 0) or (x = mW-1) or (y = mH-1) then Result := 0
else begin
s1 := map[x-1, y-1] - map[x,y];
s2 := map[x-1, y] - map[x,y];
s3 := map[x-1, y+1] - map[x,y];
s4 := map[x, y+1] - map[x,y];
s5 := map[x+1, y+1] - map[x,y];
s6 := map[x+1, y] - map[x,y];
s7 := map[x+1, y-1] - map[x,y];
s8 := map[x, y-1] - map[x,y];

Result := (s1 + s2 + s3 + s4 + s5 + s6 + s7 + s8) / (256*8);
end;

end;

procedure Color(x, y: Integer);
var
h, s: Single;
w1, w2, w3, l: Single;
a1, a2: Single;
cl: TColor;
begin

// Encode the blending weights for this heightmap pixel in an RGBA color.

if coverage = nil then
begin
h := map[x,y]/255;
s := CalcSlope(x, y);

cl := LUT.Canvas.Pixels[Trunc(h*LUT.Width), LUT.Height - 1 - Trunc(s*LUT.Height)];
w1 := (cl mod $100) / 255;
w2 := ((cl div $100) mod $100) / 255;
w3 := (cl div $10000) / 255;

l := sqrt(w1*w1 + w2*w2 + w3*w3);
w1 := w1/l;
w2 := w2/l;
w3 := w3/l;

bmp.Canvas.Pixels[x,y] := RGB(Trunc(w1*255), Trunc(w2*255), Trunc(w3*255));
end
else begin
cl := coverage.Canvas.Pixels[x,y];
w1 := (cl mod $100) / 255;
// w2 := ((cl div $100) mod $100) / 255;
w3 := (cl div $10000) / 255;
end;

a1 := w1/(1-w3);
a2 := 1 - w3;

va[y*mW + x].R := a1;
va[y*mW + x].G := a1;
va[y*mW + x].B := a1;
va[y*mW + x].A := a2;
end;

begin

// Load heightmap:
bmp := TBitmap.Create;
bmp.LoadFromFile('map.bmp');

mW := bmp.Width;
mH := bmp.Height;
SetLength(map, mW);
for x := 0 to mW - 1 do SetLength(map[x], mH);

SetLength(va, mW*mH);

{ LUT is a 2D lookup table that maps slope and height to three coverage
factors. I use a bitmap so that you can easily change the distribution of
the textures. Just edit the bitmap: the horizontal axis is height, the
vertical axis is slope, and R, G and B represent the three input textures.
Red equals grass, green equals dirt, and blue equals rock. }
LUT := TBitmap.Create;
LUT.LoadFromFile('lookup.bmp');

for x := 0 to mW-1 do
begin
for y := 0 to mH-1 do
begin
map[x,y] := bmp.Canvas.Pixels[x,y] mod $100;
end;
end;
bmp.Free;

{ If a file 'coverage.bmp' exists, we will load the coverage factors from it
rather than generating them procedurally. Otherwise, we generate the factors
and then save them to coverage.bmp. You can look at this image and edit it.
If you screw up, just delete the file and a new one will be generated. }
if FileExists('coverage.bmp') then
begin
bmp := nil;
coverage := TBitmap.Create;
coverage.LoadFromFile('coverage.bmp');
end
else begin
bmp := TBitmap.Create;
bmp.PixelFormat := pf24bit;
bmp.Width := mW;
bmp.Height := mH;
coverage := nil;
end;

// Fill up the vertex array:
for x := 0 to mW - 1 do
begin
for y := 0 to mH - 1 do
begin
Color(x, y);

va[y*mW + x].U1 := x;
va[y*mW + x].V1 := y;
va[y*mW + x].U2 := x/mW;
va[y*mW + x].V2 := 1-y/mH;

va[y*mW + x].X := 4000*(x - (mW div 2))/(mW div 2);
va[y*mW + x].Y := 1000*map[x,y]/256;
va[y*mW + x].Z := 4000*(y - (mH div 2))/(mH div 2);
end;
end;

if bmp <> nil then
begin
bmp.SaveToFile('coverage.bmp');
bmp.Free;
end;

LUT.Free;

// Create index arrays for glDrawElements().
SetLength(ia, mW-1);
for x := 0 to mW-2 do
begin
SetLength(ia[x], mH*2);
for y := 0 to mH-1 do
begin
ia[x,y*2] := y*mW + x+1;
ia[x,y*2+1] := y*mH + x;
end;
end;

end;

procedure TTTForm.LoadTextures;
var
img: TCGTexture;
begin

// Load the texture images from disk.

glGenTextures(1, @T1);
glBindTexture(GL_TEXTURE_2D, T1);
img := tgaLoad('tile1.tga');
gluBuild2DMipmaps(GL_TEXTURE_2D, 4, img.Width, img.Height, GL_RGBA, GL_UNSIGNED_BYTE, img.Data);
img.Free;
glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_REPEAT);
glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_REPEAT);
glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR_MIPMAP_LINEAR);
glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR);

glGenTextures(1, @T2);
glBindTexture(GL_TEXTURE_2D, T2);
img := tgaLoad('tile2.tga');
gluBuild2DMipmaps(GL_TEXTURE_2D, 4, img.Width, img.Height, GL_RGBA, GL_UNSIGNED_BYTE, img.Data);
img.Free;
glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_REPEAT);
glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_REPEAT);
glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR_MIPMAP_LINEAR);
glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR);

glGenTextures(1, @T3);
glBindTexture(GL_TEXTURE_2D, T3);
img := tgaLoad('tile3.tga');
gluBuild2DMipmaps(GL_TEXTURE_2D, 4, img.Width, img.Height, GL_RGBA, GL_UNSIGNED_BYTE, img.Data);
img.Free;
glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_REPEAT);
glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_REPEAT);
glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR_MIPMAP_LINEAR);
glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR);

glGenTextures(1, @L);
glBindTexture(GL_TEXTURE_2D, L);
img := tgaLoad('lightmap.tga');
gluBuild2DMipmaps(GL_TEXTURE_2D, 4, img.Width, img.Height, GL_RGBA, GL_UNSIGNED_BYTE, img.Data);
img.Free;
glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP_TO_EDGE);
glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP_TO_EDGE);
glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR_MIPMAP_LINEAR);
glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR);

end;

procedure TTTForm.ConfigureSinglePass;
begin

// Configure OpenGL for the single-pass rendering.

glEnableClientState(GL_COLOR_ARRAY);
glColorPointer(4, GL_FLOAT, SizeOf(TTerrainVertex), @va[0].R);

glClientActiveTextureARB(GL_TEXTURE3_ARB);
glEnableClientState(GL_TEXTURE_COORD_ARRAY);
glTexCoordPointer(2, GL_FLOAT, SizeOf(TTerrainVertex), @va[0].U2);

glClientActiveTextureARB(GL_TEXTURE2_ARB);
glEnableClientState(GL_TEXTURE_COORD_ARRAY);
glTexCoordPointer(2, GL_FLOAT, SizeOf(TTerrainVertex), @va[0].U1);

glClientActiveTextureARB(GL_TEXTURE1_ARB);
glEnableClientState(GL_TEXTURE_COORD_ARRAY);
glTexCoordPointer(2, GL_FLOAT, SizeOf(TTerrainVertex), @va[0].U1);

glClientActiveTextureARB(GL_TEXTURE0_ARB);
glEnableClientState(GL_TEXTURE_COORD_ARRAY);
glTexCoordPointer(2, GL_FLOAT, SizeOf(TTerrainVertex), @va[0].U1);

glEnableClientState(GL_VERTEX_ARRAY);
glVertexPointer(3, GL_FLOAT, SizeOf(TTerrainVertex), @va[0].X);

// Texture 3: previous * L
glActiveTextureARB(GL_TEXTURE3_ARB);
glEnable(GL_TEXTURE_2D);
glBindTexture(GL_TEXTURE_2D, L);

glTexEnvi(GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE);

// Texture 2: lerp(C0.alpha, previous, T3)
glActiveTextureARB(GL_TEXTURE2_ARB);
glEnable(GL_TEXTURE_2D);
glBindTexture(GL_TEXTURE_2D, T3);

glMatrixMode(GL_TEXTURE);
glScalef(0.2, 0.2, 0);
glMatrixMode(GL_MODELVIEW);

glTexEnvi(GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_COMBINE_ARB);
glTexEnvi(GL_TEXTURE_ENV, GL_COMBINE_RGB_ARB, GL_INTERPOLATE_ARB);

glTexEnvi(GL_TEXTURE_ENV, GL_SOURCE0_RGB_ARB, GL_PREVIOUS_ARB);
glTexEnvi(GL_TEXTURE_ENV, GL_OPERAND0_RGB_ARB, GL_SRC_COLOR);

glTexEnvi(GL_TEXTURE_ENV, GL_SOURCE1_RGB_ARB, GL_TEXTURE);
glTexEnvi(GL_TEXTURE_ENV, GL_OPERAND1_RGB_ARB, GL_SRC_COLOR);

glTexEnvi(GL_TEXTURE_ENV, GL_SOURCE2_RGB_ARB, GL_PRIMARY_COLOR_ARB);
glTexEnvi(GL_TEXTURE_ENV, GL_OPERAND2_RGB_ARB, GL_SRC_ALPHA);

// Texture 1: lerp(C0.rgb, T1, T2)
glActiveTextureARB(GL_TEXTURE1_ARB);
glEnable(GL_TEXTURE_2D);
glBindTexture(GL_TEXTURE_2D, T1);

glMatrixMode(GL_TEXTURE);
glScalef(0.2, 0.2, 0);
glMatrixMode(GL_MODELVIEW);

glTexEnvi(GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_COMBINE_ARB);
glTexEnvi(GL_TEXTURE_ENV, GL_COMBINE_RGB_ARB, GL_INTERPOLATE_ARB);

glTexEnvi(GL_TEXTURE_ENV, GL_SOURCE0_RGB_ARB, GL_PREVIOUS_ARB);
glTexEnvi(GL_TEXTURE_ENV, GL_OPERAND0_RGB_ARB, GL_SRC_COLOR);

glTexEnvi(GL_TEXTURE_ENV, GL_SOURCE1_RGB_ARB, GL_TEXTURE);
glTexEnvi(GL_TEXTURE_ENV, GL_OPERAND1_RGB_ARB, GL_SRC_COLOR);

glTexEnvi(GL_TEXTURE_ENV, GL_SOURCE2_RGB_ARB, GL_PRIMARY_COLOR_ARB);
glTexEnvi(GL_TEXTURE_ENV, GL_OPERAND2_RGB_ARB, GL_SRC_COLOR);

// Texture 0: T1
glActiveTextureARB(GL_TEXTURE0_ARB);
glEnable(GL_TEXTURE_2D);
glBindTexture(GL_TEXTURE_2D, T2);

glMatrixMode(GL_TEXTURE);
glScalef(0.2, 0.2, 0);
glMatrixMode(GL_MODELVIEW);

glTexEnvi(GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE);

end;

procedure TTTForm.ConfigureMultiPass;
begin

// Configure OpenGL for the multipass rendering.

glEnable(GL_BLEND);
glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
glDepthFunc(GL_LEQUAL);

glActiveTextureARB(GL_TEXTURE1_ARB);
glClientActiveTextureARB(GL_TEXTURE1_ARB);
glEnableClientState(GL_TEXTURE_COORD_ARRAY);
glEnable(GL_TEXTURE_2D);

glMatrixMode(GL_TEXTURE);
glScalef(0.2, 0.2, 0);
glMatrixMode(GL_MODELVIEW);

glActiveTextureARB(GL_TEXTURE0_ARB);
glClientActiveTextureARB(GL_TEXTURE0_ARB);
glEnableClientState(GL_TEXTURE_COORD_ARRAY);
glEnable(GL_TEXTURE_2D);

glMatrixMode(GL_TEXTURE);
glScalef(0.2, 0.2, 0);
glMatrixMode(GL_MODELVIEW);

glEnableClientState(GL_VERTEX_ARRAY);
glVertexPointer(3, GL_FLOAT, SizeOf(TTerrainVertex), @va[0].X);

end;

procedure TTTForm.FormCreate(Sender: TObject);
const
CSKY: array [0..3] of GLfloat = (0.2, 0.6, 1, 1);
var
TUs: Integer;
begin

InitGL;

try
// Multitexture
if not glext_ExtensionSupported('GL_ARB_multitexture') then
raise Exception.Create('This demo requires GL_ARB_multitexture!');
glActiveTextureARB := wglGetProcAddress('glActiveTextureARB');
glClientActiveTextureARB := wglGetProcAddress('glClientActiveTextureARB');
glMultiTexCoord2fARB := wglGetProcAddress('glMultiTexCoord2fARB');
if (not Assigned(glActiveTextureARB)) or
(not Assigned(glClientActiveTextureARB)) or
(not Assigned(glMultiTexCoord2fARB)) then
raise Exception.Create('Error loading GL_ARB_multitexture!');

// Texture_env_combine
if not glext_ExtensionSupported('GL_ARB_texture_env_combine') then
raise Exception.Create('This demo requires GL_ARB_texture_env_combine!');

// Load the terrain data:
LoadTerrain;
LoadTextures;

// Check if we can do it in a single pass:
glGetIntegerv(GL_MAX_TEXTURE_UNITS_ARB, @TUs);
if TUs >= 4 then
begin
ConfigureSinglePass;
renderProc := RenderSinglePass;
end
else if TUs >= 2 then
begin
ConfigureMultiPass;
renderProc := RenderMultiPass;
end
else raise Exception.Create('This demo requires at least two texture units!');

// Basic stuff:
glClearColor(CSKY[0], CSKY[1], CSKY[2], CSKY[3]);

glEnable(GL_CULL_FACE);
glCullFace(GL_BACK);
glFrontFace(GL_CCW);

glEnable(GL_DEPTH_TEST);
Resize;

cam.pos := cgVector(0, 500, 0);
cam.pitch := 0;
cam.yaw := 0;
GetCursorPos(mpos);
mpos := ScreenToClient(mpos);

cgStartTiming;
Application.OnIdle := Idle;
except on E: Exception do
begin
MessageDlg(E.Message, mtError, [mbOk], 0);
Halt(1);
end;
end;

end;

procedure TTTForm.FormResize(Sender: TObject);
begin

glViewport(0, 0, ClientWidth, ClientHeight);
glMatrixMode(GL_PROJECTION);
glLoadIdentity;
gluPerspective(60, ClientWidth/ClientHeight, 1, 10000);
glMatrixMode(GL_MODELVIEW);

end;

procedure TTTForm.RenderSinglePass;
var
i: Integer;
begin

for i := 0 to mW-2 do
glDrawElements(GL_TRIANGLE_STRIP, mH*2, GL_UNSIGNED_INT, @ia[0]);

end;

procedure TTTForm.RenderMultiPass;
var
i: Integer;
begin

// Pass 1: LERP(C0.RGB, T1, T2)

glDisable(GL_BLEND);

glEnable(GL_COLOR_ARRAY);
glColorPointer(4, GL_FLOAT, SizeOf(TTerrainVertex), @va[0].R);

glActiveTextureARB(GL_TEXTURE1_ARB);
glClientActiveTextureARB(GL_TEXTURE1_ARB);
glTexCoordPointer(2, GL_FLOAT, SizeOf(TTerrainVertex), @va[0].U1);
glEnable(GL_TEXTURE_2D);

glBindTexture(GL_TEXTURE_2D, T1);
glTexEnvi(GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_COMBINE_ARB);

glTexEnvi(GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_COMBINE_ARB);
glTexEnvi(GL_TEXTURE_ENV, GL_COMBINE_RGB_ARB, GL_INTERPOLATE_ARB);

glTexEnvi(GL_TEXTURE_ENV, GL_SOURCE0_RGB_ARB, GL_PREVIOUS_ARB);
glTexEnvi(GL_TEXTURE_ENV, GL_OPERAND0_RGB_ARB, GL_SRC_COLOR);

glTexEnvi(GL_TEXTURE_ENV, GL_SOURCE1_RGB_ARB, GL_TEXTURE);
glTexEnvi(GL_TEXTURE_ENV, GL_OPERAND1_RGB_ARB, GL_SRC_COLOR);

glTexEnvi(GL_TEXTURE_ENV, GL_SOURCE2_RGB_ARB, GL_PRIMARY_COLOR_ARB);
glTexEnvi(GL_TEXTURE_ENV, GL_OPERAND2_RGB_ARB, GL_SRC_COLOR);

glActiveTextureARB(GL_TEXTURE0_ARB);
glClientActiveTextureARB(GL_TEXTURE0_ARB);
glTexCoordPointer(2, GL_FLOAT, SizeOf(TTerrainVertex), @va[0].U1);

glBindTexture(GL_TEXTURE_2D, T2);
glTexEnvi(GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE);

for i := 0 to mW-2 do
glDrawElements(GL_TRIANGLE_STRIP, mH*2, GL_UNSIGNED_INT, @ia[0]);

// Pass 2: LERP(C0.A, T3, FB)

glEnable(GL_BLEND);
glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);

glActiveTextureARB(GL_TEXTURE1_ARB);
glDisable(GL_TEXTURE_2D);

glActiveTextureARB(GL_TEXTURE0_ARB);
glBindTexture(GL_TEXTURE_2D, T3);
glTexEnvi(GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_COMBINE_ARB);

glTexEnvi(GL_TEXTURE_ENV, GL_COMBINE_RGB_ARB, GL_REPLACE);
glTexEnvi(GL_TEXTURE_ENV, GL_SOURCE0_RGB_ARB, GL_TEXTURE);
glTexEnvi(GL_TEXTURE_ENV, GL_OPERAND0_RGB_ARB, GL_SRC_COLOR);

glTexEnvi(GL_TEXTURE_ENV, GL_COMBINE_ALPHA_ARB, GL_REPLACE);
glTexEnvi(GL_TEXTURE_ENV, GL_SOURCE0_ALPHA_ARB, GL_PRIMARY_COLOR_ARB);
glTexEnvi(GL_TEXTURE_ENV, GL_OPERAND0_ALPHA_ARB, GL_ONE_MINUS_SRC_ALPHA);

for i := 0 to mW-2 do
glDrawElements(GL_TRIANGLE_STRIP, mH*2, GL_UNSIGNED_INT, @ia[0]);

// Pass 3: FB * L

glEnable(GL_BLEND);
glBlendFunc(GL_DST_COLOR, GL_ZERO);

glActiveTextureARB(GL_TEXTURE1_ARB);
glDisable(GL_TEXTURE_2D);

glDisable(GL_COLOR_ARRAY);

glActiveTextureARB(GL_TEXTURE0_ARB);
glBindTexture(GL_TEXTURE_2D, L);
glTexCoordPointer(2, GL_FLOAT, SizeOf(TTerrainVertex), @va[0].U2);
glTexEnvi(GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE);

glMatrixMode(GL_TEXTURE);
glPushMatrix;
glLoadIdentity;

for i := 0 to mW-2 do
glDrawElements(GL_TRIANGLE_STRIP, mH*2, GL_UNSIGNED_INT, @ia[0]);

glPopMatrix;
glMatrixMode(GL_MODELVIEW);

end;

procedure TTTForm.FormPaint(Sender: TObject);
begin

glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
glLoadIdentity;

glRotatef(-cam.pitch, 1, 0, 0);
glRotatef(-cam.yaw, 0, 1, 0);

glTranslatef(-cam.pos.x, -cam.pos.y, -cam.pos.z);

renderProc;

PageFlip;

end;

var
fps: Single = 0; // Sum of framerate samples.
fpsc: Integer = 0; // Number of framerate samples taken.

const
FPS_SMOOVE = 20; // Number of samples to use for smoothing the fps counter.

procedure TTTForm.Idle(Sender: TObject; var Done: Boolean);
var
dt, speed: Single;
v: TCGVector;
begin

Done := FALSE;

dt := cgTimeElapsed;
cgStartTiming;

// Take framerate sample.
fps := fps + 1000/dt;
INC(fpsc);

// If number of samples is high enough, average them and display the result.
if fpsc = FPS_SMOOVE then
begin
fpsc := 0;
fps := fps / FPS_SMOOVE;
Caption := Format('Terrain texturing -- %.0f fps', [fps]);
fps := 0;
end;

if GetAsyncKeyState(VK_SHIFT) <> 0 then speed := 1
else speed := 0.5;
v := cgVector(0, 0, 0);
if GetAsyncKeyState(VK_UP) <> 0 then v.z := -dt*speed
else if GetAsyncKeyState(VK_DOWN) <> 0 then v.z := dt*speed;
if GetAsyncKeyState(VK_LEFT) <> 0 then v.x := -dt*speed
else if GetAsyncKeyState(VK_RIGHT) <> 0 then v.x := dt*speed;

cgRotateX(v, cam.pitch*PI/180);
cgRotateY(v, cam.yaw*PI/180);
cam.pos := cgVecAdd(cam.pos, v);

Paint;

end;

procedure TTTForm.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin

if Key = VK_ESCAPE then Close;

end;

procedure TTTForm.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin

if ssLeft in Shift then
begin
cam.pitch := cam.pitch - (Y - mpos.Y)/5;
cam.yaw := cam.yaw - (X - mpos.X)/5;

if cam.pitch > 90 then cam.pitch := 90
else if cam.pitch < -90 then cam.pitch := -90;

if cam.yaw > 360 then cam.yaw := cam.yaw - 360
else if cam.yaw < 0 then cam.yaw := cam.yaw + 360;

end;
mpos := Point(X, Y);

end;

end.
 
duhai_lee:GL, GLu, GLext, TGA, CgWindow, CgTexture, CgUtils, CgTypes,CgGeometry
哪里去找??
 
有个gl的控件, 是delphi下面的, 非常棒, 我这台机器上没有, 你可以搜一下,如果找不到, 再找我. 那个控件叫 glsence.
另外你可以去 Gamedev网站去看看. 有很多delphi相关的东西..
 
多人接受答案了。
 

Similar threads

D
回复
0
查看
793
DelphiTeacher的专栏
D
D
回复
0
查看
828
DelphiTeacher的专栏
D
D
回复
0
查看
660
DelphiTeacher的专栏
D
D
回复
0
查看
2K
DelphiTeacher的专栏
D
D
回复
0
查看
2K
DelphiTeacher的专栏
D
后退
顶部