Code:
unit project1unit1;
{$MODE Delphi}
interface
{$IFDEF VER140}
{$DEFINE CLX}
{$ELSE}
{$DEFINE VCL}
{$ENDIF}
uses
Classes,
{$IFDEF VCL}
LCLIntf, LCLType, LMessages,
Messages,
Graphics,
Controls,
Forms,
Dialogs,
StdCtrls,
ExtCtrls,
ComCtrls,
Buttons,
ExtDlgs,
Spin,
{$ENDIF}
{$IFDEF CLX}
QT,
QGraphics,
QControls,
QForms,
QDialogs,
QStdCtrls,
QExtCtrls,
QComCtrls,
QButtons,
Types,
{$ENDIF}
SysUtils,
sdl,OpenGLContext,GL,GLU,glext,logger,
fastevents in 'fastevents.pas';
type
{ TForm1 }
TForm1 = class(TForm)
Button1: TButton;
Panel1: TPanel;
procedure Button1Click(Sender: TObject);
procedure OpenGLControl1Paint(Sender: TObject);
private
{ private declarations }
public
{ public declarations }
end;
const
// screen width, height, and bit depth
SCREEN_WIDTH = 640;
SCREEN_HEIGHT = 480;
SCREEN_BPP = 16;
var
Form1: TForm1;
// This is our SDL surface
surface : PSDL_Surface;
xrot : GLfloat; // X Rotation ( NEW )
yrot : GLfloat; // Y Rotation ( NEW )
zrot : GLfloat ; // Z Rotation ( NEW )
texture : GLuint; // Storage For One Texture ( NEW )
//Status indicator
Status : Boolean = false;
implementation
{$IFDEF Win32}
{$R *.lfm}
{$ENDIF}
{$IFDEF Linux}
{$R *.xfm}
{$ENDIF}
{ TForm1 }
// The main drawing function.
procedure DrawGLScene;
begin
// Clear The Screen And The Depth Buffer
glClear( GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT );
// Move Into The Screen 5 Units
glLoadIdentity;
glTranslatef( 0.0, 0.0, -5.0 );
glRotatef( xrot, 1.0, 0.0, 0.0 ); // Rotate On The X Axis
glRotatef( yrot, 0.0, 1.0, 0.0 ); // Rotate On The Y Axis
glRotatef( zrot, 0.0, 0.0, 1.0 ); // Rotate On The Z Axis
// Select Our Texture
glBindTexture( GL_TEXTURE_2D, texture );
// NOTE:
// * The x coordinates of the glTexCoord2f function need to inverted
// * for SDL because of the way SDL_LoadBmp loads the data. So where
// * in the tutorial it has glTexCoord2f( 1.0, 0.0 ); it should
// * now read glTexCoord2f( 0.0, 0.0 );
glBindTexture( GL_TEXTURE_2D, texture );
glBegin( GL_QUADS );
// Front Face
// Bottom Left Of The Texture and Quad
glTexCoord2f( 0.0, 1.0 );
glVertex3f( -1.0, -1.0, 1.0 );
// Bottom Right Of The Texture and Quad
glTexCoord2f( 1.0, 1.0 );
glVertex3f( 1.0, -1.0, 1.0 );
// Top Right Of The Texture and Quad
glTexCoord2f( 1.0, 0.0 );
glVertex3f( 1.0, 1.0, 1.0 );
// Top Left Of The Texture and Quad
glTexCoord2f( 0.0, 0.0 );
glVertex3f( -1.0, 1.0, 1.0 );
// Back Face
// Bottom Right Of The Texture and Quad
glTexCoord2f( 0.0, 0.0 );
glVertex3f( -1.0, -1.0, -1.0 );
// Top Right Of The Texture and Quad
glTexCoord2f( 0.0, 1.0 );
glVertex3f( -1.0, 1.0, -1.0 );
// Top Left Of The Texture and Quad
glTexCoord2f( 1.0, 1.0 );
glVertex3f( 1.0, 1.0, -1.0 );
// Bottom Left Of The Texture and Quad
glTexCoord2f( 1.0, 0.0 );
glVertex3f( 1.0, -1.0, -1.0 );
// Top Face
// Top Left Of The Texture and Quad
glTexCoord2f( 1.0, 1.0 );
glVertex3f( -1.0, 1.0, -1.0 );
// Bottom Left Of The Texture and Quad
glTexCoord2f( 1.0, 0.0 );
glVertex3f( -1.0, 1.0, 1.0 );
// Bottom Right Of The Texture and Quad
glTexCoord2f( 0.0, 0.0 );
glVertex3f( 1.0, 1.0, 1.0 );
// Top Right Of The Texture and Quad
glTexCoord2f( 0.0, 1.0 );
glVertex3f( 1.0, 1.0, -1.0 );
// Bottom Face
// Top Right Of The Texture and Quad
glTexCoord2f( 0.0, 1.0 );
glVertex3f( -1.0, -1.0, -1.0 );
// Top Left Of The Texture and Quad
glTexCoord2f( 1.0, 1.0 );
glVertex3f( 1.0, -1.0, -1.0 );
// Bottom Left Of The Texture and Quad
glTexCoord2f( 1.0, 0.0 );
glVertex3f( 1.0, -1.0, 1.0 );
// Bottom Right Of The Texture and Quad
glTexCoord2f( 0.0, 0.0 );
glVertex3f( -1.0, -1.0, 1.0 );
// Right face
// Bottom Right Of The Texture and Quad
glTexCoord2f( 0.0, 0.0 );
glVertex3f( 1.0, -1.0, -1.0 );
// Top Right Of The Texture and Quad
glTexCoord2f( 0.0, 1.0 );
glVertex3f( 1.0, 1.0, -1.0 );
// Top Left Of The Texture and Quad
glTexCoord2f( 1.0, 1.0 );
glVertex3f( 1.0, 1.0, 1.0 );
// Bottom Left Of The Texture and Quad
glTexCoord2f( 1.0, 0.0 );
glVertex3f( 1.0, -1.0, 1.0 );
// Left Face
// Bottom Left Of The Texture and Quad
glTexCoord2f( 1.0, 0.0 );
glVertex3f( -1.0, -1.0, -1.0 );
// Bottom Right Of The Texture and Quad
glTexCoord2f( 0.0, 0.0 );
glVertex3f( -1.0, -1.0, 1.0 );
// Top Right Of The Texture and Quad
glTexCoord2f( 0.0, 1.0 );
glVertex3f( -1.0, 1.0, 1.0 );
// Top Left Of The Texture and Quad
glTexCoord2f( 1.0, 1.0 );
glVertex3f( -1.0, 1.0, -1.0 );
glEnd;
// swap buffers to display, since we're double buffered.
SDL_GL_SwapBuffers;
xrot := xrot + 0.3; // X Axis Rotation
yrot := yrot + 0.2; // Y Axis Rotation
zrot := zrot + 0.4; // Z Axis Rotation
end;
procedure TerminateApplication;
begin
SDL_QUIT;
Halt(0);
end;
// function to reset our viewport after a window resize
function ResizeWindow( width : integer; height : integer ) : Boolean;
begin
// Protect against a divide by zero
if ( height = 0 ) then
height := 1;
// Setup our viewport.
glViewport( 0, 0, width, height );
// change to the projection matrix and set our viewing volume.
glMatrixMode( GL_PROJECTION );
glLoadIdentity;
// Set our perspective
gluPerspective( 45.0, width / height, 0.1, 100.0 );
// Make sure we're changing the model view and not the projection
glMatrixMode( GL_MODELVIEW );
// Reset The View
glLoadIdentity;
result := true;
end;
// function to handle key press events
procedure HandleKeyPress( keysym : PSDL_keysym );
begin
case keysym^.sym of
SDLK_ESCAPE :
// ESC key was pressed
TerminateApplication;
SDLK_RETURN :
begin
if (keysym^.Modifier and KMOD_ALT <> 0) then
begin
{* Alt+Enter key was pressed
* this toggles fullscreen mode
*}
SDL_WM_ToggleFullScreen( surface );
end;
end;
end;
end;
// Load Bitmaps And Convert To Textures
function LoadGLTextures : Boolean;
var
// Create storage space for the texture
TextureImage: PSDL_Surface;
begin
// Load The Bitmap, Check For Errors, If Bitmap's Not Found Quit
TextureImage := SDL_LoadBMP('ashwood.bmp');
if ( TextureImage <> nil ) then
begin
// Set the status to true
Status := true;
// Create Texture
glGenTextures( 1, @texture );
// Typical Texture Generation Using Data From The Bitmap
glBindTexture( GL_TEXTURE_2D, texture );
// Generate The Texture
glTexImage2D( GL_TEXTURE_2D, 0, 3, TextureImage^.w,
TextureImage^.h, 0, GL_BGR,
GL_UNSIGNED_BYTE, TextureImage^.pixels );
// Linear Filtering
// scale linearly when image bigger than texture
glTexParameteri( GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR );
// scale linearly when image smaller than texture
glTexParameteri( GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR );
end
else
begin
Log.LogError( Format( 'Could not Load Image : %s', [SDL_GetError] ),
'LoadGLTextures' );
TerminateApplication;
end;
// Free up any memory we may have used
if ( TextureImage <> nil ) then
SDL_FreeSurface( TextureImage );
result := Status;
end;
function InitGL : Boolean;
begin
// Load in the texture
if ( not LoadGLTextures ) then
begin
result := false;
exit;
end;
// Enable Texture Mapping ( NEW )
glEnable( GL_TEXTURE_2D );
// Enable smooth shading
glShadeModel( GL_SMOOTH );
// Set the background black
glClearColor( 0.0, 0.0, 0.0, 0.0 );
// Depth buffer setup
glClearDepth( 1.0 );
// Enables Depth Testing
glEnable( GL_DEPTH_TEST );
// The Type Of Depth Test To Do
glDepthFunc( GL_LEQUAL );
// Really Nice Perspective Calculations
glHint( GL_PERSPECTIVE_CORRECTION_HINT, GL_NICEST );
result := true;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
Done : Boolean;
event : TSDL_Event;
videoflags : Uint32;
videoInfo : PSDL_VideoInfo;
EnvVal:string;
hwnd:integer;
black: Uint32;
pixels: PUint8;
i:integer;
label
tekrar;
begin
hwnd:=0;
tekrar:
hwnd:=panel1.Handle;
if hwnd = 0 then goto tekrar;
{$IFDEF VCL}
SDL_putenv( 'SDL_VIDEODRIVER=windib' );
EnvVal := 'SDL_WINDOWID=' + inttostr(Integer(Panel1.Handle));
{$ENDIF}
{$IFDEF CLX}
// EnvVal := 'SDL_WINDOWID=' + inttostr(QWidget_WinId(Panel1.Handle));
{$ENDIF}
// Initialize SDL
if ( SDL_Init( SDL_INIT_EVERYTHING ) < 0 ) then
begin
Log.LogError( Format( 'Could not initialize SDL : %s', [SDL_GetError] ),
'Main' );
TerminateApplication;
end;
// Fetch the video info
videoInfo := SDL_GetVideoInfo;
if ( videoInfo = nil ) then
begin
Log.LogError( Format( 'Video query failed : %s', [SDL_GetError] ),
'Main' );
TerminateApplication;
end;
// the flags to pass to SDL_SetVideoMode
videoFlags := SDL_OPENGL; // Enable OpenGL in SDL
videoFlags := videoFlags or SDL_DOUBLEBUF; // Enable double buffering
videoFlags := videoFlags or SDL_HWPALETTE; // Store the palette in hardware
videoflags := videoflags or SDL_NOFRAME;
// This checks to see if surfaces can be stored in memory
if ( videoInfo^.hw_available <> 0 ) then
videoFlags := videoFlags or SDL_HWSURFACE
else
videoFlags := videoFlags or SDL_SWSURFACE;
// This checks if hardware blits can be done * /
if ( videoInfo^.blit_hw <> 0 ) then
videoFlags := videoFlags or SDL_HWACCEL;
// Set the OpenGL Attributes
SDL_GL_SetAttribute( SDL_GL_RED_SIZE, 5 );
SDL_GL_SetAttribute( SDL_GL_GREEN_SIZE, 5 );
SDL_GL_SetAttribute( SDL_GL_BLUE_SIZE, 5 );
SDL_GL_SetAttribute( SDL_GL_DEPTH_SIZE, 16 );
SDL_GL_SetAttribute( SDL_GL_DOUBLEBUFFER, 1 );
// Set the title bar in environments that support it
SDL_WM_SetCaption( 'Jeff Molofee''s OpenGL Code Tutorial 6 using JEDI-SDL', nil );
videoflags := videoFlags or SDL_RESIZABLE; // Enable window resizing
//SDL_SetVideoMode(seWidth.Value, seHeight.Value, seBPP.Value,
// video_flags);
surface := SDL_SetVideoMode( panel1.Width, panel1.Height, SCREEN_BPP, videoflags );
if ( surface = nil ) then
begin
Log.LogError( Format( 'Unable to create OpenGL screen : %s', [SDL_GetError]
),
'Main' );
TerminateApplication;
end;
// Loop, drawing and checking events
InitGL;
ReSizeWindow( SCREEN_WIDTH, SCREEN_HEIGHT );
Done := False;
while ( not Done ) do
begin
// This could go in a separate function
while ( SDL_PollEvent( @event ) = 1 ) do
begin
case event.type_ of
SDL_QUITEV :
begin
Done := true;
end;
SDL_KEYDOWN :
begin
// handle key presses
HandleKeyPress( @event.key.keysym );
end;
SDL_VIDEORESIZE :
begin
surface := SDL_SetVideoMode( event.resize.w, event.resize.h, SCREEN_BPP, videoflags );
if ( surface = nil ) then
begin
Log.LogError( Format( 'Could not get a surface after resize : %s', [SDL_GetError] ),
'Main' );
TerminateApplication;
end;
InitGL;
ResizeWindow( event.resize.w, event.resize.h );
end;
end;
end;
// draw the scene
DrawGLScene;
end;
TerminateApplication;
end;
procedure TForm1.OpenGLControl1Paint(Sender: TObject);
begin
// DrawGLScene;
// openglcontrol1.SwapBuffers;
end;
end.
Reply With Quote
Bookmarks