OpenGL Földgömb!

Top  Previous  Next

Textúrázott Földgömb TTimer-rel időzítve forog a képernyőn.

 

földgomb

 

unit Unit1;

 

interface

 

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

StdCtrls, ExtCtrls, AL_OpenGl, Opengl, DGLut;

 

type

    PPixelArray = ^TPixelArray;

    TPixelArray = array [0..0] of Byte;

 

TForm1 = class(TForm)

   Panel1: TPanel;

   ALO: TALOpenGL;

   Button1: TButton;

   Timer1: TTimer;

   procedure ALOPaint(Sender: TObject);

   procedure FormCreate(Sender: TObject);

   procedure FormKeyDown(Sender: TObject; var Key: Word;

     Shift: TShiftState);

   procedure ALOInitGL(Sender: TObject);

   procedure Timer1Timer(Sender: TObject);

private

   { Private declarations }

public

   { Public declarations }

end;

 

var

Form1: TForm1;

xrot: GLfloat;

yrot: GLfloat;

zrot: GLfloat;

xspeed: GLfloat;

yspeed: GLfloat;

Mode:GLenum;

Radius:GLFloat;

Tex:Cardinal;

 

function CreateTexture(Texture : String): cardinal;

 

implementation

 

{$R *.DFM}

 

function CreateTexture(Texture : String): cardinal;

var

bitmap: TBitmap;

BMInfo : TBitmapInfo;

I, ImageSize : Integer;

Temp : Byte;

MemDC : HDC;

Tex: PPixelArray;

begin

glenable(GL_TEXTURE_2D);

glGenTextures(1, @Result);

glBindTexture(GL_TEXTURE_2D, Result);

 

Bitmap:=TBitMap.Create;

Bitmap.LoadFromFile(Texture);

with BMinfo.bmiHeader do begin

   FillChar (BMInfo, SizeOf(BMInfo), 0);

   biSize := sizeof (TBitmapInfoHeader);

   biBitCount := 24;

   biWidth := Bitmap.Width;

   biHeight := Bitmap.Height;

   ImageSize := biWidth * biHeight;

   biPlanes := 1;

   biCompression := BI_RGB;

 

   MemDC := CreateCompatibleDC (0);

   GetMem (Tex, ImageSize *3);

   try

     GetDIBits (MemDC, Bitmap.Handle, 0, biHeight, Tex, BMInfo, DIB_RGB_COLORS);

     glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR);

     glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER,GL_LINEAR);

     glTexImage2d(GL_TEXTURE_2D, 0, 3, biwidth, biheight, 0, GL_BGR_EXT, GL_UNSIGNED_BYTE, tex);

     For I := 0 to ImageSize - 1 do begin

         Temp := tex [I * 3];

         tex [I * 3] := tex [I * 3 + 2];

         tex [I * 3 + 2] := Temp;

     end;

    finally

     DeleteDC (MemDC);

     Bitmap.Free;

     FreeMem(tex);

  end;

end;

end;

 

procedure TForm1.FormCreate(Sender: TObject);

begin

Radius:=1;

xspeed := 1;

yspeed := 1;

xrot:=0;

yrot:=0;

zrot:=0;

 

glEnable(GL_TEXTURE_GEN_S);

glEnable(GL_TEXTURE_GEN_T);

glTexEnvf(GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE);

glTexGenf(GL_S, GL_TEXTURE_GEN_MODE, GL_OBJECT_LINEAR);

glTexGenf(GL_T, GL_TEXTURE_GEN_MODE, GL_OBJECT_LINEAR);

 

quadObj := gluNewQuadric;

gluQuadricDrawStyle(quadObj, GLU_FILL);

gluQuadricNormals(quadObj, GLU_SMOOTH);

gluQuadricTexture(quadObj,GL_TRUE);

glBindTexture(GL_TEXTURE_2D,tex);

end;

 

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;

Shift: TShiftState);

begin

if Key=VK_ADD then Radius:=Radius+0.1;

if Key=VK_SUBTRACT then Radius:=Radius-0.1;

ALO.Repaint;

end;

 

procedure TForm1.ALOPaint(Sender: TObject);

var

I:Integer;

begin

glViewport(0, 0, Width, Height);

 

glMatrixMode(GL_PROJECTION);

glLoadIdentity();

gluPerspective(45.0,Width/Height,0.1,100.0);

glMatrixMode(GL_MODELVIEW);

 

glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);

//  glLoadIdentity();

 

glTranslatef(0,0,-5);

gltranslatef(0,0,Radius);

 

glpushmatrix;

 

//  glScalef(Radius,radius,Radius);

glRotatef(-90,1.0,0.0,0.0);

glRotatef(zrot,0.0,0.0,1.0);

//  glRotatef(xrot,1.0,0.0,0.0);

//  glRotatef(yrot,0.0,1.0,0.0);

 

glBindTexture(GL_TEXTURE_2D,tex);

gluSphere(quadObj,1,36,18);

 

glpopmatrix;

 

end;

 

procedure TForm1.ALOInitGL(Sender: TObject);

begin

  glEnable(GL_LIGHTING);

  glEnable(GL_LIGHT0);

  glEnable(GL_DEPTH_TEST);

  glEnable(GL_LINE_SMOOTH);

 

  Tex:=CreateTexture('Earth1.bmp');

end;

 

procedure TForm1.Timer1Timer(Sender: TObject);

begin

xrot := xrot + xspeed;

yrot := yrot + yspeed;

zrot := zrot + yspeed;

alo.repaint;

end;

 

end.