有高手知道delphi下的集成opengl的控件包吗?(300分)

  • 主题发起人 主题发起人 superbin
  • 开始时间 开始时间
S

superbin

Unregistered / Unconfirmed
GUEST, unregistred user!
我知道有基于C下的TGS公司开发的open Inventor3.1(http://www.tgs.com)是一个很好的集成opengl的3D编程控件包,有谁知道delphi下有什么类似的控件包
 
看看这个:
http://www.delphi-gems.com/Graphics.html#OpenGL12
 
但是我手头上没有这个组件的说明文档,不知道它的好坏,请问你有吗
 
我也没有,不过这个东东是源码,另外你可以到网站上去查查.
这儿还有一个控件:GLScene5也是有源码,并有帮助文档
 
我很想有GLScene5的说明文档,尤其是那些可以打印出来的,不知道谁有?
 
我有,怎么给你,留下EMAIL:
我的:cdyxl@163.com
 
好的,我给你发信了,谢谢你
我的email:super_bin@21cn.com
 
visit3D,很不错...
http://www.51delphi.com
 
其实 Delphi 直接支持 ogl 而不需要其他支持。看下例,这个 ogl 直接编译即可,使用时需要一幅 64X64 位图文件: Spark.bmp ,
随便取一幅什么图片都行,只是效果稍逊( 放烟火效果 )。3D 的例子也有,也是 Delphi 直接支持。看了 Delphi 5 和 Delphi 7 的
ogl 单元,两个版本使用的单元相同,没改动,都一样。只要使用 Delphi ,这个例子就可以编译。
//------------------------------------------------------------------------
// File Name : OpenGLApp.dpr
// Author : Jan Horn
// Description : A basic fireworks display
//------------------------------------------------------------------------
program OpenGLApp;
uses Windows, Messages, OpenGL, BMP;
const
WND_TITLE = 'Fireworks by Jan Horn';
FPS_TIMER = 1; // Timer to calculate FPS
FPS_INTERVAL = 250; // Calculate FPS every 250 ms
EXPLOSION_SIZE = 0.8;
type TParticle = Record
X, Y, Z : glFloat; // X, Y and Z coordinates
dX, dY, dZ : glFloat; // amount of change in X, Y and Z direction
R, G, B : glFloat; // color of the particle
end;
TFirework = Record
Particle : Array[0..127] of TParticle; // particles in the explosion
Trail : Array[0..15] of TParticle; // particles in the tail
StartTime : Integer; // when the firework was set off
Duration : Integer; // how long it should last
Style : Integer; // picture it should create
X, Y : glFloat; // X and Y coordinates
dX, dY : glFloat; // change in X and Y coordinates
end;
var
h_Wnd : HWND; // Global window handle
h_DC : HDC; // Global device context
h_RC : HGLRC; // OpenGL rendering context
keys : Array[0..255] of Boolean; // Holds keystrokes
FPSCount : Integer = 0; // Counter for FPS
ElapsedTime : Integer; // Elapsed time between frames
// Textures
ParticleTex : glUint;
// User vaiables
Fireworks : Integer; // number of active fireworks
Firework : Array[0..9] of TFirework;
{$R *.RES}
procedure glBindTexture(target: GLenum; texture: GLuint); stdcall; external opengl32;
{------------------------------------------------------------------}
{ Function to convert int to string. (No sysutils = smaller EXE) }
{------------------------------------------------------------------}
function IntToStr(Num : Integer) : String; // using SysUtils increase file size by 100K
begin
Str(Num, result);
end;
{------------------------------------------------------------------}
{ setups up the new firework variables }
{------------------------------------------------------------------}
procedure SetupFirework(N : Integer);
var I : Integer;
Clr : Integer;
begin
Randomize;
// select a firework color. 0=red, 1=green, 2=blue
Clr :=Random(3);
Firework[N].StartTime :=ElapsedTime;
FireWork[N].Duration :=random(1000)+3000;
Firework[N].X :=random(20) - 10;
Firework[N].Y :=-20;
Firework[N].dX :=(random*2-1)/80;
Firework[N].dY :=(random + 1.5)/80;
Firework[N].Style :=Random(10); // if style = 0, 1 then its a ring. 20% chance
// exploding particles
for I :=0 to 127 do
with Firework[N].Particle do
begin
if Firework[N].Style < 2 then
R := (random/6 +0.4)/10*EXPLOSION_SIZE
else
R := (random/10 -0.05)*EXPLOSION_SIZE;
dX :=R*cos(I/10);
dY :=R*sin(I/10);
dZ :=R*cos(I/4);
X :=dX;
Y :=dY;
Z :=dZ;
if Clr = 0 then R :=random/3 + 0.7 else R :=random/3 + 0.4;
if Clr = 1 then G :=random/3 + 0.7 else G :=random/3 + 0.4;
if Clr = 2 then B :=random/3 + 0.7 else B :=random/3 + 0.4;
end;
// tail particles
for I :=0 to 15 do
with Firework[N].Trail do
begin
X :=0;
Y :=0;
Z :=50 + random(50); // will act as duration for particle
dX :=-0.7*Firework[N].dX;
dY :=-random/20-0.001;
if Clr = 0 then R :=random/3 + 0.8 else R :=random/3 + 0.4;
if Clr = 1 then G :=random/3 + 0.8 else G :=random/3 + 0.4;
if Clr = 2 then B :=random/3 + 0.8 else B :=random/3 + 0.4;
end;
end;
{------------------------------------------------------------------}
{ draws the firework tail as it goes up }
{------------------------------------------------------------------}
procedure FireworkTail(const N : Integer);
var I : Integer;
begin
glTranslatef(Firework[N].X, Firework[N].Y, 0);
// the main part of the rocket
glColor3f(1, 1, 1); // here Z is used as the alpha value
glBegin(GL_QUADS);
glTexCoord2f(0.0, 0.0); glVertex3f(-1.0, -1.0, 0);
glTexCoord2f(1.0, 0.0); glVertex3f( 1.0, -1.0, 0);
glTexCoord2f(1.0, 1.0); glVertex3f( 1.0, 1.0, 0);
glTexCoord2f(0.0, 1.0); glVertex3f(-1.0, 1.0, 0);
glEnd();
// the tail of the rocket
glBegin(GL_QUADS);
for I :=0 to 15 do
with Firework[N].Trail do
begin
glColor4f(R, G, B, Z/100); // here Z is used as the alpha value
glTexCoord2f(0.0, 0.0); glVertex3f(X-1.0, Y-1.0, 0);
glTexCoord2f(1.0, 0.0); glVertex3f(X+1.0, Y-1.0, 0);
glTexCoord2f(1.0, 1.0); glVertex3f(X+1.0, Y+1.0, 0);
glTexCoord2f(0.0, 1.0); glVertex3f(X-1.0, Y+1.0, 0);
X :=X+dX;
Y :=Y+dY;
Z :=Z-1;
if Z = 0 then
begin
X := 0;
Y := 0;
Z :=50 + random(50);
end;
end;
glEnd();
end;
{------------------------------------------------------------------}
{ draws the exploding firework }
{------------------------------------------------------------------}
procedure FireworkExplode(const N : Integer);
var I : Integer;
SlowDown : glFloat;
begin
glTranslatef(Firework[N].X, Firework[N].Y, 0);
glBegin(GL_QUADS);
for I :=0 to 127 do
with Firework[N].Particle do
begin
glColor4f(R, G, B, 1.8-(ElapsedTime-Firework[N].StartTime-1000)/1200);
glTexCoord2f(0.0, 0.0); glVertex3f(X-1.0, Y-1.0, Z);
glTexCoord2f(1.0, 0.0); glVertex3f(X+1.0, Y-1.0, Z);
glTexCoord2f(1.0, 1.0); glVertex3f(X+1.0, Y+1.0, Z);
glTexCoord2f(0.0, 1.0); glVertex3f(X-1.0, Y+1.0, Z);
// Calculate the new coords based on the change, dX, in a direction
// and slow the change down as time goes by.
slowdown :=((ElapsedTime-Firework[N].StartTime-1000) - Sqr(1000+Firework[N].StartTime-ElapsedTime)/5000)/6;
X :=dX * slowdown;
Y :=dY * slowdown;
Z :=dZ * slowdown;
end;
glEnd();
end;
{------------------------------------------------------------------}
{ Function to draw the actual scene }
{------------------------------------------------------------------}
procedure glDraw();
var N : Integer;
Slowdown : glFLoat;
begin
glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT); // Clear The Screen And The Depth Buffer
glLoadIdentity(); // Reset The View
glTranslatef(0.0,0.0,-50);
for N :=0 to Fireworks-1 do
begin
glPushMatrix();
// Display the firework
if ElapsedTime-Firework[N].StartTime < 1000 then
FireworkTail(N)
else
FireworkExplode(N);
// create a new firework
if ElapsedTime - Firework[N].StartTime - FireWork[N].Duration >=0 then
SetupFirework(N);
// keep moving and slowing down firework
Slowdown :=Sqr(Firework[N].StartTime-ElapsedTime);
Firework[N].X :=Firework[N].dX * ((ElapsedTime-Firework[N].StartTime) - Slowdown/7000);
Firework[N].Y :=Firework[N].dY * ((ElapsedTime-Firework[N].StartTime) - Slowdown/4500) - 20;
glPopMatrix;
end;
end;
{------------------------------------------------------------------}
{ Initialise OpenGL }
{------------------------------------------------------------------}
procedure glInit();
var I : Integer;
begin
glClearColor(0.0, 0.0, 0.0, 0.0); // Black Background
glShadeModel(GL_SMOOTH); // Enables Smooth Color Shading
glClearDepth(1.0); // Depth Buffer Setup
glDisable(GL_DEPTH_TEST);
glBlendFunc(GL_SRC_ALPHA, GL_ONE);
glEnable(GL_BLEND);
glHint(GL_PERSPECTIVE_CORRECTION_HINT, GL_NICEST); //Realy Nice perspective calculations
glEnable(GL_TEXTURE_2D); // Enable Texture Mapping
LoadTexture('spark.bmp', ParticleTex); // Load the Texture
glBindTexture(GL_TEXTURE_2D, ParticleTex); // Bind the Texture to the object
randomize;
Fireworks :=3;
for I :=0 to Fireworks-1 do
begin
SetupFirework(I);
Firework.StartTime :=-1000*I;
end;
end;
{------------------------------------------------------------------}
{ Handle window resize }
{------------------------------------------------------------------}
procedure glResizeWnd(Width, Height : Integer);
begin
if (Height = 0) then // prevent divide by zero exception
Height := 1;
glViewport(0, 0, Width, Height); // Set the viewport for the OpenGL window
glMatrixMode(GL_PROJECTION); // Change Matrix Mode to Projection
glLoadIdentity(); // Reset View
gluPerspective(45.0, Width/Height, 1.0, 100.0); // Do the perspective calculations. Last value = max clipping depth
glMatrixMode(GL_MODELVIEW); // Return to the modelview matrix
glLoadIdentity(); // Reset View
end;
{------------------------------------------------------------------}
{ Processes all the keystrokes }
{------------------------------------------------------------------}
procedure ProcessKeys;
begin
if Keys[VK_ADD] then
begin
Inc(Fireworks);
if Fireworks > 10 then
Fireworks :=10;
Keys[VK_ADD] :=FALSE;
end;
if Keys[VK_SUBTRACT] then
begin
Dec(Fireworks);
if Fireworks < 1 then
Fireworks :=1;
Keys[VK_SUBTRACT] :=FALSE;
end;
end;
{------------------------------------------------------------------}
{ Determines the application抯 response to the messages received }
{------------------------------------------------------------------}
function WndProc(hWnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
begin
case (Msg) of
WM_CREATE:
begin
// Insert stuff you want executed when the program starts
end;
WM_CLOSE:
begin
PostQuitMessage(0);
Result := 0
end;
WM_KEYDOWN: // Set the pressed key (wparam) to equal true so we can check if its pressed
begin
keys[wParam] := True;
Result := 0;
end;
WM_KEYUP: // Set the released key (wparam) to equal false so we can check if its pressed
begin
keys[wParam] := False;
Result := 0;
end;
WM_SIZE: // Resize the window with the new width and height
begin
glResizeWnd(LOWORD(lParam),HIWORD(lParam));
Result := 0;
end;
WM_TIMER : // Add code here for all timers to be used.
begin
if wParam = FPS_TIMER then
begin
FPSCount :=Round(FPSCount * 1000/FPS_INTERVAL); // calculate to get per Second incase intercal is less or greater than 1 second
SetWindowText(h_Wnd, PChar(WND_TITLE + ' [' + intToStr(FPSCount) + ' FPS] Fireworks=' + intToStr(Fireworks)));
FPSCount := 0;
Result := 0;
end;
end;
else
Result := DefWindowProc(hWnd, Msg, wParam, lParam); // Default result if nothing happens
end;
end;
{---------------------------------------------------------------------}
{ Properly destroys the window created at startup (no memory leaks) }
{---------------------------------------------------------------------}
procedure glKillWnd(Fullscreen : Boolean);
begin
if Fullscreen then // Change back to non fullscreen
begin
ChangeDisplaySettings(devmode(nil^), 0);
ShowCursor(True);
end;
// Makes current rendering context not current, and releases the device
// context that is used by the rendering context.
if (not wglMakeCurrent(h_DC, 0)) then
MessageBox(0, 'Release of DC and RC failed!', 'Error', MB_OK or MB_ICONERROR);
// Attempts to delete the rendering context
if (not wglDeleteContext(h_RC)) then
begin
MessageBox(0, 'Release of rendering context failed!', 'Error', MB_OK or MB_ICONERROR);
h_RC := 0;
end;
// Attemps to release the device context
if ((h_DC = 1) and (ReleaseDC(h_Wnd, h_DC) <> 0)) then
begin
MessageBox(0, 'Release of device context failed!', 'Error', MB_OK or MB_ICONERROR);
h_DC := 0;
end;
// Attempts to destroy the window
if ((h_Wnd <> 0) and (not DestroyWindow(h_Wnd))) then
begin
MessageBox(0, 'Unable to destroy window!', 'Error', MB_OK or MB_ICONERROR);
h_Wnd := 0;
end;
// Attempts to unregister the window class
if (not UnRegisterClass('OpenGL', hInstance)) then
begin
MessageBox(0, 'Unable to unregister window class!', 'Error', MB_OK or MB_ICONERROR);
hInstance := NULL;
end;
end;
{--------------------------------------------------------------------}
{ Creates the window and attaches a OpenGL rendering context to it }
{--------------------------------------------------------------------}
function glCreateWnd(Width, Height : Integer; Fullscreen : Boolean; PixelDepth : Integer) : Boolean;
var
wndClass : TWndClass; // Window class
dwStyle : DWORD; // Window styles
dwExStyle : DWORD; // Extended window styles
dmScreenSettings : DEVMODE; // Screen settings (fullscreen, etc...)
PixelFormat : GLuint; // Settings for the OpenGL rendering
h_Instance : HINST; // Current instance
pfd : PIXELFORMATDESCRIPTOR; // Settings for the OpenGL window
begin
h_Instance := GetModuleHandle(nil); //Grab An Instance For Our Window
ZeroMemory(@wndClass, SizeOf(wndClass)); // Clear the window class structure
with wndClass do // Set up the window class
begin
style := CS_HREDRAW or // Redraws entire window if length changes
CS_VREDRAW or // Redraws entire window if height changes
CS_OWNDC; // Unique device context for the window
lpfnWndProc := @WndProc; // Set the window procedure to our func WndProc
hInstance := h_Instance;
hCursor := LoadCursor(0, IDC_ARROW);
lpszClassName := 'OpenGL';
end;
if (RegisterClass(wndClass) = 0) then // Attemp to register the window class
begin
MessageBox(0, 'Failed to register the window class!', 'Error', MB_OK or MB_ICONERROR);
Result := False;
Exit
end;
// Change to fullscreen if so desired
if Fullscreen then
begin
ZeroMemory(@dmScreenSettings, SizeOf(dmScreenSettings));
with dmScreenSettings do begin // Set parameters for the screen setting
dmSize := SizeOf(dmScreenSettings);
dmPelsWidth := Width; // Window width
dmPelsHeight := Height; // Window height
dmBitsPerPel := PixelDepth; // Window color depth
dmFields := DM_PELSWIDTH or DM_PELSHEIGHT or DM_BITSPERPEL;
end;
// Try to change screen mode to fullscreen
if (ChangeDisplaySettings(dmScreenSettings, CDS_FULLSCREEN) = DISP_CHANGE_FAILED) then
begin
MessageBox(0, 'Unable to switch to fullscreen!', 'Error', MB_OK or MB_ICONERROR);
Fullscreen := False;
end;
end;
// If we are still in fullscreen then
if (Fullscreen) then
begin
dwStyle := WS_POPUP or // Creates a popup window
WS_CLIPCHILDREN // Doesn't draw within child windows
or WS_CLIPSIBLINGS; // Doesn't draw within sibling windows
dwExStyle := WS_EX_APPWINDOW; // Top level window
ShowCursor(False); // Turn of the cursor (gets in the way)
end
else
begin
dwStyle := WS_OVERLAPPEDWINDOW or // Creates an overlapping window
WS_CLIPCHILDREN or // Doesn't draw within child windows
WS_CLIPSIBLINGS; // Doesn't draw within sibling windows
dwExStyle := WS_EX_APPWINDOW or // Top level window
WS_EX_WINDOWEDGE; // Border with a raised edge
end;
// Attempt to create the actual window
h_Wnd := CreateWindowEx(dwExStyle, // Extended window styles
'OpenGL', // Class name
WND_TITLE, // Window title (caption)
dwStyle, // Window styles
0, 0, // Window position
Width, Height, // Size of window
0, // No parent window
0, // No menu
h_Instance, // Instance
nil); // Pass nothing to WM_CREATE
if h_Wnd = 0 then
begin
glKillWnd(Fullscreen); // Undo all the settings we've changed
MessageBox(0, 'Unable to create window!', 'Error', MB_OK or MB_ICONERROR);
Result := False;
Exit;
end;
// Try to get a device context
h_DC := GetDC(h_Wnd);
if (h_DC = 0) then
begin
glKillWnd(Fullscreen);
MessageBox(0, 'Unable to get a device context!', 'Error', MB_OK or MB_ICONERROR);
Result := False;
Exit;
end;
// Settings for the OpenGL window
with pfd do
begin
nSize := SizeOf(PIXELFORMATDESCRIPTOR); // Size Of This Pixel Format Descriptor
nVersion := 1; // The version of this data structure
dwFlags := PFD_DRAW_TO_WINDOW // Buffer supports drawing to window
or PFD_SUPPORT_OPENGL // Buffer supports OpenGL drawing
or PFD_DOUBLEBUFFER; // Supports double buffering
iPixelType := PFD_TYPE_RGBA; // RGBA color format
cColorBits := PixelDepth; // OpenGL color depth
cRedBits := 0; // Number of red bitplanes
cRedShift := 0; // Shift count for red bitplanes
cGreenBits := 0; // Number of green bitplanes
cGreenShift := 0; // Shift count for green bitplanes
cBlueBits := 0; // Number of blue bitplanes
cBlueShift := 0; // Shift count for blue bitplanes
cAlphaBits := 0; // Not supported
cAlphaShift := 0; // Not supported
cAccumBits := 0; // No accumulation buffer
cAccumRedBits := 0; // Number of red bits in a-buffer
cAccumGreenBits := 0; // Number of green bits in a-buffer
cAccumBlueBits := 0; // Number of blue bits in a-buffer
cAccumAlphaBits := 0; // Number of alpha bits in a-buffer
cDepthBits := 16; // Specifies the depth of the depth buffer
cStencilBits := 0; // Turn off stencil buffer
cAuxBuffers := 0; // Not supported
iLayerType := PFD_MAIN_PLANE; // Ignored
bReserved := 0; // Number of overlay and underlay planes
dwLayerMask := 0; // Ignored
dwVisibleMask := 0; // Transparent color of underlay plane
dwDamageMask := 0; // Ignored
end;
// Attempts to find the pixel format supported by a device context that is the best match to a given pixel format specification.
PixelFormat := ChoosePixelFormat(h_DC, @pfd);
if (PixelFormat = 0) then
begin
glKillWnd(Fullscreen);
MessageBox(0, 'Unable to find a suitable pixel format', 'Error', MB_OK or MB_ICONERROR);
Result := False;
Exit;
end;
// Sets the specified device context's pixel format to the format specified by the PixelFormat.
if (not SetPixelFormat(h_DC, PixelFormat, @pfd)) then
begin
glKillWnd(Fullscreen);
MessageBox(0, 'Unable to set the pixel format', 'Error', MB_OK or MB_ICONERROR);
Result := False;
Exit;
end;
// Create a OpenGL rendering context
h_RC := wglCreateContext(h_DC);
if (h_RC = 0) then
begin
glKillWnd(Fullscreen);
MessageBox(0, 'Unable to create an OpenGL rendering context', 'Error', MB_OK or MB_ICONERROR);
Result := False;
Exit;
end;
// Makes the specified OpenGL rendering context the calling thread's current rendering context
if (not wglMakeCurrent(h_DC, h_RC)) then
begin
glKillWnd(Fullscreen);
MessageBox(0, 'Unable to activate OpenGL rendering context', 'Error', MB_OK or MB_ICONERROR);
Result := False;
Exit;
end;
// Initializes the timer used to calculate the FPS
SetTimer(h_Wnd, FPS_TIMER, FPS_INTERVAL, nil);
// Settings to ensure that the window is the topmost window
ShowWindow(h_Wnd, SW_SHOW);
SetForegroundWindow(h_Wnd);
SetFocus(h_Wnd);
// Ensure the OpenGL window is resized properly
glResizeWnd(Width, Height);
glInit();
Result := True;
end;
{--------------------------------------------------------------------}
{ Main message loop for the application }
{--------------------------------------------------------------------}
function WinMain(hInstance : HINST; hPrevInstance : HINST;
lpCmdLine : PChar; nCmdShow : Integer) : Integer; stdcall;
var
msg : TMsg;
finished : Boolean;
DemoStart, LastTime : DWord;
begin
finished := False;
// Perform application initialization:
if not glCreateWnd(800, 600, FALSE, 32) then
begin
Result := 0;
Exit;
end;
DemoStart := GetTickCount(); // Get Time when demo started
// Main message loop:
while not finished do
begin
if (PeekMessage(msg, 0, 0, 0, PM_REMOVE)) then // Check if there is a message for this window
begin
if (msg.message = WM_QUIT) then // If WM_QUIT message received then we are done
finished := True
else
begin // Else translate and dispatch the message to this window
TranslateMessage(msg);
DispatchMessage(msg);
end;
end
else
begin
Inc(FPSCount); // Increment FPS Counter
LastTime :=ElapsedTime;
ElapsedTime :=GetTickCount() - DemoStart; // Calculate Elapsed Time
ElapsedTime :=(LastTime + ElapsedTime) DIV 2; // Average it out for smoother movement
glDraw(); // Draw the scene
SwapBuffers(h_DC); // Display the scene
if (keys[VK_ESCAPE]) then // If user pressed ESC then set finised TRUE
finished := True
else
ProcessKeys; // Check for any other key Pressed
end;
end;
glKillWnd(FALSE);
Result := msg.wParam;
end;
begin
WinMain( hInstance, hPrevInst, CmdLine, CmdShow );
end.
//----------------------------------------------------------------------------
// File Name : BMP.pas
// Author : Jan Horn
// Description : A unit that used with OpenGL projects to load BMP files
// Usage : LoadTexture(BMPFilename, TextureName); eg : LoadTexture('logo.bmp', LogoTex);
//----------------------------------------------------------------------------
unit BMP;
interface
uses Windows, OpenGL;
function LoadTexture(Filename: String; var Texture: GLuint): Boolean;
implementation
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;
{------------------------------------------------------------------}
{ Load BMP file }
{------------------------------------------------------------------}
procedure LoadBitmap(Filename: String; out Width: Cardinal; out Height: Cardinal; out pData: Pointer);
var
FileHeader: BITMAPFILEHEADER;
InfoHeader: BITMAPINFOHEADER;
Palette: array of RGBQUAD;
BitmapFile: THandle;
BitmapLength: Cardinal;
PaletteLength: Cardinal;
ReadBytes: Cardinal;
Front: ^Byte;
Back: ^Byte;
Temp: Byte;
I : Cardinal;
begin
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);
// Bitmaps are stored BGR and not RGB, so swap the R and B bytes.
for I :=0 to Width * Height - 1 do
begin
Front := Pointer(Cardinal(pData) + I*3);
Back := Pointer(Cardinal(pData) + I*3 + 2);
Temp := Front^;
Front^ := Back^;
Back^ := Temp;
end;
end;
{------------------------------------------------------------------}
{ Load BMP textures }
{------------------------------------------------------------------}
function LoadTexture(Filename: String; var Texture: GLuint): Boolean;
var
pData: Pointer;
Width: Cardinal;
Height: Cardinal;
begin
pData :=nil;
LoadBitmap(Filename, Width, Height, pData);
if (Assigned(pData)) then
Result := True
else
begin
Result := False;
MessageBox(0, PChar('Unable to load ' + filename), 'Loading Textures', MB_OK);
Halt(1);
end;
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); {Texture does 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 }
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
end;
end.

 
也就是说,我更喜欢不用第三方控件。
 
我现在是在做一个建筑结构的可视化程序开发,我不是很想对opgl的具体实现进行研究,
也没有足够的时间.有了第三方控件我就可以省点心,把精力集中在我结构方面的开发.
各位的意见对我都很有帮助,谢了!
 
我已经把帮助文档发到你的邮箱了,请查收!
cdyxl@163.com
 
后退
顶部