Maprendszer bolygói

Top  Previous  Next

A naprendszer nagyboylgóit jelenítjük meg 3D-ben. A képernyőn lenyomott bal, ill jobb egérgombbal csúsztatva, a forgási szöget, a tengely dőlést és a nagyítást lehet változtatni.

 

 

Mars

Jupi

 

unit Unit1;

 

interface

 

uses

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

StdCtrls, ExtCtrls, AL_OpenGl, Opengl, DGLut, Buttons, ComCtrls;

 

type

    PPixelArray = ^TPixelArray;

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

 

TForm1 = class(TForm)

   Panel1: TPanel;

   ALO: TALOpenGL;

   Timer1: TTimer;

   SpeedButton1: TSpeedButton;

   SpeedButton2: TSpeedButton;

   SpeedButton3: TSpeedButton;

   SpeedButton4: TSpeedButton;

   SpeedButton5: TSpeedButton;

   SpeedButton6: TSpeedButton;

   SpeedButton7: TSpeedButton;

   MeretCheckBox: TCheckBox;

   TrackBar1: TTrackBar;

   TrackBar2: TTrackBar;

   TrackBar3: TTrackBar;

   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);

   procedure SpeedButton1Click(Sender: TObject);

   procedure MeretCheckBoxClick(Sender: TObject);

   procedure TrackBar1Change(Sender: TObject);

   procedure TrackBar2Change(Sender: TObject);

   procedure TrackBar3Change(Sender: TObject);

   procedure ALOMouseWheel(Sender: TObject; Shift: TShiftState;

     WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);

   procedure ALOMouseDown(Sender: TObject; Button: TMouseButton;

     Shift: TShiftState; X, Y: Integer);

   procedure ALOMouseMove(Sender: TObject; Shift: TShiftState; X,

     Y: Integer);

private

   FPlanet: integer;

   FPlanetAxis: double;

   procedure SetPlanet(const Value: integer);

   procedure SetPlanetAxis(const Value: double);

   { Private declarations }

public

   property Planet: integer read FPlanet write SetPlanet;

   property PlanetAxis: double read FPlanetAxis write SetPlanetAxis;

end;

 

var

Form1: TForm1;

xrot: GLfloat;

yrot: GLfloat;

zrot: GLfloat;

xspeed: GLfloat;

yspeed: GLfloat;

Mode:GLenum;

Radius:GLFloat;

Origin,movept: TPoint;

 

Tex : array[1..7] of Cardinal;

 

Const Bolygok : array[1..7] of string =

             ('Merkur','Venusz','Earth','Mars','Jupiter','Neptunusz','Moon');

     BolygSugar : array[1..7] of double = (0.38,0.94,1,0.53,11.19,3.85,0.25);

 

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 := 0.4;

yspeed := 0.4;

xrot:=0;

yrot:=0;

zrot:=0;

 

PlanetAxis:=90;

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);

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(-PlanetAxis,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[FPlanet]);

gluSphere(quadObj,1,36,18);

 

glpopmatrix;

 

end;

 

procedure TForm1.ALOInitGL(Sender: TObject);

var i:Integer;

begin

  glEnable(GL_LIGHTING);

  glEnable(GL_LIGHT0);

  glEnable(GL_DEPTH_TEST);

  glEnable(GL_LINE_SMOOTH);

 

  for i:=1 to 7 do

      Tex[i]:=CreateTexture(Bolygok[i]+'.bmp');

  FPlanet := 3;

 

end;

 

procedure TForm1.Timer1Timer(Sender: TObject);

begin

xrot := xrot + xspeed;

yrot := yrot + yspeed;

zrot := zrot + yspeed;

alo.repaint;

end;

 

procedure TForm1.SetPlanet(const Value: integer);

begin

FPlanet := Value;

Caption := 'NAPRENDSZER BOLYGÓI  -  '+Bolygok[FPlanet];

end;

 

procedure TForm1.SpeedButton1Click(Sender: TObject);

begin

Planet := TComponent(Sender).Tag;

if MeretCheckBox.Checked then

    Radius := 1

else

    Radius := 0.1*BolygSugar[Planet];

Caption := 'NAPRENDSZER BOLYGÓI  -  '+Bolygok[FPlanet];

end;

 

procedure TForm1.MeretCheckBoxClick(Sender: TObject);

begin

if MeretCheckBox.Checked then

    Radius := 1

else

    Radius := 0.1*BolygSugar[Planet];

end;

 

procedure TForm1.SetPlanetAxis(const Value: double);

begin

FPlanetAxis := Value;

alo.Repaint;

end;

 

procedure TForm1.TrackBar1Change(Sender: TObject);

begin

PlanetAxis := TrackBar1.Position;

end;

 

procedure TForm1.TrackBar2Change(Sender: TObject);

begin

xspeed := 0.1*TrackBar2.Position;

yspeed := 0.1*TrackBar2.Position;

end;

 

procedure TForm1.TrackBar3Change(Sender: TObject);

begin

Radius := TrackBar3.Position/50;

end;

 

procedure TForm1.ALOMouseWheel(Sender: TObject; Shift: TShiftState;

WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);

begin

if WheelDelta>0 then Radius:=1.05*Radius else Radius:=0.95*Radius;

end;

 

procedure TForm1.ALOMouseDown(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

begin

Origin:=Point(x,y);

MovePt:=Origin;

end;

 

procedure TForm1.ALOMouseMove(Sender: TObject; Shift: TShiftState; X,

Y: Integer);

begin

if Shift=[ssRight] then begin

    if (y-MovePt.y)>0 then Radius:=1.01*Radius else Radius:=0.99*Radius;

end;

if Shift=[ssLeft] then begin

    if (y-MovePt.y)<0 then PlanetAxis:=PlanetAxis+0.5*(y-MovePt.y)

       else PlanetAxis:=PlanetAxis-0.5*(MovePt.y-y);

    if PlanetAxis>180 then PlanetAxis:=180;

    if PlanetAxis<0 then PlanetAxis:=0;

    if (x-MovePt.x)<0 then zrot:=zrot+0.5*(x-MovePt.x)

       else zrot:=zrot+0.5*(x-MovePt.x)

end;

MovePt:=Point(x,y);

end;

 

end.