Kamera (3): Unterschied zwischen den Versionen

Aus DGL Wiki
Wechseln zu: Navigation, Suche
Zeile 64: Zeile 64:
 
   TArrVector = array [0..3] of TGLFloat;
 
   TArrVector = array [0..3] of TGLFloat;
  
 +
  function GetMatrixX (matrix: TArrMatrix): TGLvector;
 +
  function GetMatrixY (matrix: TArrMatrix): TGLvector;
 +
  function GetMatrixZ (matrix: TArrMatrix): TGLvector;
 +
  function GetMatrixPos (matrix: TArrMatrix): TGLvector;
 +
  procedure SetMatrixX (var matrix: TArrMatrix; v: TGLvector);
 +
  procedure SetMatrixY (var matrix: TArrMatrix; v: TGLvector);
 +
  procedure SetMatrixZ (var matrix: TArrMatrix; v: TGLvector);
 +
  procedure SetMatrixPos (var matrix: TArrMatrix; v: TGLvector);
 
   function Multiply (Color: TGLcolor; m: TGLdouble): TGLcolor;overload;
 
   function Multiply (Color: TGLcolor; m: TGLdouble): TGLcolor;overload;
 
   function Multiply (V1, V2: TGLVector): TGLVector;overload;
 
   function Multiply (V1, V2: TGLVector): TGLVector;overload;
Zeile 98: Zeile 106:
 
   function AddVector (Vec: TGLVector; X, Y, Z: TGLdouble): TGLVector;overload;
 
   function AddVector (Vec: TGLVector; X, Y, Z: TGLdouble): TGLVector;overload;
 
   function ForceForegroundWindow(hwnd: THandle): Boolean;
 
   function ForceForegroundWindow(hwnd: THandle): Boolean;
 +
  procedure InitGLEnv (dc: HDC; rc: HGLRC; hndl: THandle);// pixelformat setzen
 
   procedure CopyVector (FromVektor: TGLVector; var ToVektor: TGLVector);
 
   procedure CopyVector (FromVektor: TGLVector; var ToVektor: TGLVector);
 
   procedure InitVector (var V1: TGLVector; x, y, z: TGLdouble);overload;
 
   procedure InitVector (var V1: TGLVector; x, y, z: TGLdouble);overload;
Zeile 108: Zeile 117:
 
                       out pData: Pointer);
 
                       out pData: Pointer);
 
   procedure GetRotation (V1, V2: TGLVector;
 
   procedure GetRotation (V1, V2: TGLVector;
−
                         var Rotation: TRotation;
+
                         var Rotation: TRotation);
−
                        var normale: TGLVector);
 
 
   function MakeTextureFromBitmap (Bitmap: string; var BitmapList: TTextureList): GLenum;
 
   function MakeTextureFromBitmap (Bitmap: string; var BitmapList: TTextureList): GLenum;
 
   procedure EnableTexture (Texture: GLenum; TextureTiled: boolean);
 
   procedure EnableTexture (Texture: GLenum; TextureTiled: boolean);
Zeile 137: Zeile 145:
 
implementation
 
implementation
  
−
uses Forms, KanalUtil;
+
uses Forms, KanalUtil, OGLinclude, Controls;
  
 
function MyPower (Base: extended; Exp: integer): extended;
 
function MyPower (Base: extended; Exp: integer): extended;
−
// ist nicht ausprogrammiert. funktioniert nur fuer eine einfache zweierpotenz
 
 
begin
 
begin
 
   result := Base * Base;
 
   result := Base * Base;
Zeile 150: Zeile 157:
 
   ToVektor.Y := FromVektor.Y;
 
   ToVektor.Y := FromVektor.Y;
 
   ToVektor.Z := FromVektor.Z;
 
   ToVektor.Z := FromVektor.Z;
 +
end;
 +
 +
function GetMatrixX (matrix: TArrMatrix): TGLvector;
 +
// holt den X-vektor aus matrix und gibt ihn zurück
 +
begin
 +
  result.X := matrix[00];
 +
  result.Y := matrix[01];
 +
  result.Z := matrix[02];
 +
end;
 +
 +
function GetMatrixY (matrix: TArrMatrix): TGLvector;
 +
// holt den Y-vektor aus matrix und gibt ihn zurück
 +
begin
 +
  result.X := matrix[04];
 +
  result.Y := matrix[05];
 +
  result.Z := matrix[06];
 +
end;
 +
 +
function GetMatrixZ (matrix: TArrMatrix): TGLvector;
 +
// holt den Z-vektor aus matrix und gibt ihn zurück
 +
begin
 +
  result.X := matrix[08];
 +
  result.Y := matrix[09];
 +
  result.Z := matrix[10];
 +
end;
 +
 +
function GetMatrixPos (matrix: TArrMatrix): TGLvector;
 +
// holt den Position-vektor aus matrix und gibt ihn zurück
 +
begin
 +
  result.X := matrix[12];
 +
  result.Y := matrix[13];
 +
  result.Z := matrix[14];
 +
end;
 +
 +
procedure SetMatrixX (var matrix: TArrMatrix; v: TGLvector);
 +
// setzt den durch v bestimmten X-vektor in matrix
 +
begin
 +
  matrix[00] := v.X;
 +
  matrix[01] := v.Y;
 +
  matrix[02] := v.Z;
 +
end;
 +
 +
procedure SetMatrixY (var matrix: TArrMatrix; v: TGLvector);
 +
// setzt den durch v bestimmten Y-vektor in matrix
 +
begin
 +
  matrix[04] := v.X;
 +
  matrix[05] := v.Y;
 +
  matrix[06] := v.Z;
 +
end;
 +
 +
procedure SetMatrixZ (var matrix: TArrMatrix; v: TGLvector);
 +
// setzt den durch v bestimmten Z-vektor in matrix
 +
begin
 +
  matrix[08] := v.X;
 +
  matrix[09] := v.Y;
 +
  matrix[10] := v.Z;
 +
end;
 +
 +
procedure SetMatrixPos (var matrix: TArrMatrix; v: TGLvector);
 +
// setzt den durch v bestimmten Position-vektor in matrix
 +
begin
 +
  matrix[12] := v.X;
 +
  matrix[13] := v.Y;
 +
  matrix[14] := v.Z;
 
end;
 
end;
  
Zeile 308: Zeile 379:
  
 
function LoadTexture(Filename: String; var Texture: GLuint): Boolean;
 
function LoadTexture(Filename: String; var Texture: GLuint): Boolean;
 +
resourcestring
 +
  Res_LoadUnable = 'Unable to load ';
 +
  Res_LoadingTex = 'Loading Textures';
 
var
 
var
 
   pData: Pointer;
 
   pData: Pointer;
 
   Width: Cardinal;
 
   Width: Cardinal;
 
   Height: Cardinal;
 
   Height: Cardinal;
 +
  newTexture: GLint;
 
begin
 
begin
 
   pData :=nil;
 
   pData :=nil;
Zeile 321: Zeile 396:
 
   begin
 
   begin
 
     Result := False;
 
     Result := False;
−
     MessageBox(0, PChar('Unable to load ' + filename), 'Loading Textures', MB_OK);
+
     MessageBox(0, PChar(Res_LoadUnable + filename),
 +
              pchar (Res_LoadingTex), MB_OK);
 
     exit;
 
     exit;
 
   end;
 
   end;
  
−
   glGenTextures(1, @Texture);
+
   glGenTextures(1, @NewTexture);
−
   glBindTexture(GL_TEXTURE_2D, Texture);
+
   glBindTexture(GL_TEXTURE_2D, NewTexture);
 
   glTexEnvi(GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE);  {Texture blends with object background}
 
   glTexEnvi(GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE);  {Texture blends with object background}
  
Zeile 333: Zeile 409:
  
 
   gluBuild2DMipmaps(GL_TEXTURE_2D, 3, Width, Height, GL_RGB, GL_UNSIGNED_BYTE, pData);
 
   gluBuild2DMipmaps(GL_TEXTURE_2D, 3, Width, Height, GL_RGB, GL_UNSIGNED_BYTE, pData);
 +
 +
  Texture := newTexture;
 
end;
 
end;
  
Zeile 339: Zeile 417:
 
                     out Height: Cardinal;
 
                     out Height: Cardinal;
 
                     out pData: Pointer);
 
                     out pData: Pointer);
 +
resourcestring
 +
  Res_ReadErr = 'Error reading palette';
 +
  Res_OpenErr = 'Error opening: ';
 +
  Res_BitmapDataErr = 'Error reading bitmap data';
 +
  Res_BmpUnit = 'BMP Unit';
 
var
 
var
 
   FileHeader: BITMAPFILEHEADER;
 
   FileHeader: BITMAPFILEHEADER;
Zeile 354: Zeile 437:
 
   BitmapFile := CreateFile(PChar(Filename), GENERIC_READ, FILE_SHARE_READ, nil, OPEN_EXISTING, 0, 0);
 
   BitmapFile := CreateFile(PChar(Filename), GENERIC_READ, FILE_SHARE_READ, nil, OPEN_EXISTING, 0, 0);
 
   if (BitmapFile = INVALID_HANDLE_VALUE) then begin
 
   if (BitmapFile = INVALID_HANDLE_VALUE) then begin
−
     MessageBox(0, PChar('Error opening "' + Filename), PChar('BMP Unit'), MB_OK);
+
     MessageBox(0, PChar(Res_OpenErr+Filename), PChar(Res_BmpUnit), MB_OK);
 
     Exit;
 
     Exit;
 
   end;
 
   end;
Zeile 367: Zeile 450:
 
   ReadFile(BitmapFile, Palette, PaletteLength, ReadBytes, nil);
 
   ReadFile(BitmapFile, Palette, PaletteLength, ReadBytes, nil);
 
   if (ReadBytes <> PaletteLength) then begin
 
   if (ReadBytes <> PaletteLength) then begin
−
     MessageBox(0, PChar('Error reading palette'), PChar('BMP Unit'), MB_OK);
+
     MessageBox(0, PChar(Res_ReadErr), PChar(Res_BmpUnit), MB_OK);
 
     CloseHandle(BitmapFile);
 
     CloseHandle(BitmapFile);
 
     Exit;
 
     Exit;
Zeile 382: Zeile 465:
 
   ReadFile(BitmapFile, pData^, BitmapLength, ReadBytes, nil);
 
   ReadFile(BitmapFile, pData^, BitmapLength, ReadBytes, nil);
 
   if (ReadBytes <> BitmapLength) then begin
 
   if (ReadBytes <> BitmapLength) then begin
−
     MessageBox(0, PChar('Error reading bitmap data'), PChar('BMP Unit'), MB_OK);
+
     MessageBox(0, PChar(Res_BitmapDataErr), PChar(Res_BmpUnit), MB_OK);
 
     CloseHandle(BitmapFile);
 
     CloseHandle(BitmapFile);
 
     Exit;
 
     Exit;
Zeile 431: Zeile 514:
  
 
procedure GetRotation (V1, V2: TGLVector;
 
procedure GetRotation (V1, V2: TGLVector;
−
                       var Rotation: TRotation;
+
                       var Rotation: TRotation);
−
                      var normale: TGLVector);
 
−
// errechnet einen drehwinkel um von V1 nach V2 zu kommen.
 
−
// die beiden geraden werden in den nullpunkt projiziert.
 
−
// dann wird die normale zu diesem dreieck gebildet. um diese
 
−
// normale kann dann nachher gedreht werden. zum schluss wird
 
−
// der zu drehende winkel ausgerechnet.
 
−
// man kann dann mit glrotatef (Rotation.Angle,
 
−
//                              Rotation.X,
 
−
//                              Rotation.Y,
 
−
//                              Rotation.Z);
 
−
// die matricx von V1 nach V2 verschieben.
 
 
var
 
var
 
   tmpCyl, tmpZiel, nullVec: TGLVector;
 
   tmpCyl, tmpZiel, nullVec: TGLVector;
−
   ResultLen: TGLVector;
+
   normale, ResultLen: TGLVector;
 
   VectorLength: GLfloat;
 
   VectorLength: GLfloat;
 
begin
 
begin
Zeile 479: Zeile 551:
 
// zurück. ist das bitmap schon im array BitmapList enthalten, wird die bereits
 
// zurück. ist das bitmap schon im array BitmapList enthalten, wird die bereits
 
// vergeben nummer zurückgegeben.
 
// vergeben nummer zurückgegeben.
 +
resourcestring
 +
  Res_TextureNotFound = 'Texturdatei nicht gefunden: ';
 +
  Res_Error = 'Error';
 
var
 
var
 
   i, Laenge: integer;
 
   i, Laenge: integer;
−
  pfad: string;
 
 
begin
 
begin
 
   result := 0;
 
   result := 0;
 
   if length (trim (Bitmap)) = 0 then
 
   if length (trim (Bitmap)) = 0 then
 
     exit;
 
     exit;
−
  pfad := ExePath;
+
   Bitmap := uppercase (ExePath + trim (Bitmap));
−
   Bitmap := uppercase (pfad) + trim (uppercase (Bitmap));
 
 
   // suchen, ob die textur schon geladen wurde
 
   // suchen, ob die textur schon geladen wurde
 
   Laenge := length (BitmapList);
 
   Laenge := length (BitmapList);
Zeile 494: Zeile 567:
 
     begin
 
     begin
 
       if (BitmapList[i].BitmapName = Bitmap) and
 
       if (BitmapList[i].BitmapName = Bitmap) and
−
         (glIsList (BitmapList[i].TextureNum)) then
+
         (glIsTexture (BitmapList[i].TextureNum)) then
 
         result := BitmapList[i].TextureNum;
 
         result := BitmapList[i].TextureNum;
 
     end;
 
     end;
 +
 +
  if result = 0 then
 +
  begin
 +
    if not fileexists (Bitmap) then
 +
    begin
 +
      MessageBox (0, PChar (Res_TextureNotFound+Bitmap),
 +
                  pchar (Res_Error), MB_OK or MB_ICONERROR);
 +
      exit;
 +
    end;
 +
  end;
  
 
   if (result = 0) then
 
   if (result = 0) then
Zeile 509: Zeile 592:
 
       BitMapList[Laenge].theBmp.GenTexture (false, false);
 
       BitMapList[Laenge].theBmp.GenTexture (false, false);
 
       result := BitmapList[Laenge].theBmp.TextureID;
 
       result := BitmapList[Laenge].theBmp.TextureID;
−
       BitmapList[Laenge].TextureNum := result;
+
       BitmapList[Laenge].TextureNum := BitmapList[Laenge].theBmp.TextureID;
 
     end;
 
     end;
 
   end;
 
   end;
Zeile 1.043: Zeile 1.126:
 
end; { ForceForegroundWindow }
 
end; { ForceForegroundWindow }
  
−
end.</pascal>
+
procedure InitGLEnv (dc: HDC; rc: HGLRC; hndl: THandle);
 +
resourcestring
 +
  Res_ChooseFailed = 'ChoosePixelFormat failed with ';
 +
var
 +
  pfd: TPixelFormatDescriptor;
 +
  PixelFormat: TGLUint;
 +
  pFlags: TPFDFlags;
 +
  flags: word absolute pFlags;
 +
  StencilBits,
 +
  ColorBits,
 +
  DepthBits: integer;
 +
begin
 +
  pflags := [];
 +
  include (pflags, DoubleBuffer);
 +
  include (pflags, Stereo);
 +
  include (pflags, Draw_To_Window);
 +
  include (pflags, Draw_To_Bitmap);
 +
  include (pflags, Support_GDI);
 +
  include (pflags, Support_OpenGL);
 +
  include (pflags, Generic_Format);
 +
  include (pflags, Need_Palette);
 +
  include (pflags, Need_System_Palette);
 +
  include (pflags, Swap_Exchange);
 +
  include (pflags, Swap_Copy);
 +
  include (pflags, Swap_Layer_Buffers);
 +
  include (pflags, Generic_Accelerated);
 +
 
 +
  ColorBits := 24;
 +
  DepthBits := 32;
 +
  StencilBits := 0;
 +
 
 +
  with TWinControl(hndl) do
 +
  begin
 +
    fillchar(pfd,SizeOf(pfd),0);
 +
    with pfd do
 +
    begin
 +
      nSize          := SizeOf(pfd);
 +
      nVersion        := 1;
 +
      dwFlags        := flags or
 +
                        PFD_DRAW_TO_WINDOW
 +
                        or PFD_SUPPORT_OPENGL
 +
                        or PFD_DOUBLEBUFFER;
 +
      iPixelType      := PFD_TYPE_RGBA;
 +
      cColorBits      := ColorBits;
 +
      cDepthBits      := DepthBits;
 +
      cStencilBits    := StencilBits;
 +
      iLayerType      := PFD_MAIN_PLANE;
 +
      cRedBits        := 0;
 +
      cRedShift      := 0;
 +
      cGreenBits      := 0;
 +
      cBlueBits      := 0;
 +
      cBlueShift      := 0;
 +
      cAlphaBits      := 0;
 +
      cAlphaShift    := 0;
 +
      cAccumBits      := 0;
 +
      cAccumRedBits  := 0;
 +
      cAccumGreenBits := 0;
 +
      cAccumBlueBits  := 0;
 +
      cAccumAlphaBits := 0;
 +
      cAuxBuffers    := 0;
 +
      bReserved      := 0;
 +
      dwLayerMask    := 0;
 +
      dwVisibleMask  := 0;
 +
      dwDamageMask    := 0;
 +
    end; {with}
 +
 
 +
    PixelFormat := ChoosePixelFormat(dc, @pfd);
 +
    if PixelFormat=0 then
 +
      raise Exception.Create(Res_ChooseFailed+IntToStr(GetLastError));
 +
 
 +
    //if not SetPixelFormat(FglDC, PixelFormat, @pfd) then
 +
    //  raise Exception.Create('SetPixelFormat failed with '+
 +
    //    IntToStr(GetLastError));
 +
  end;
 +
end;
 +
 
 +
end.
 +
</pascal>
 
[[Kategorie:Anleitung]]
 
[[Kategorie:Anleitung]]

Version vom 8. Januar 2006, 08:05 Uhr

Eine Beschreibung findet ihr unter Kamera (1).
Den Kameracode findet ihr unter Kamera (2).

Ich habe einfach alle Funktionen meiner Toolsammlung hierhin kopiert. Ich wollte jetzt nicht offline etwas weglöschen was vielleicht benötigt wird. Ihr findet also hier einen ganzen Wust von Funktionen, der zum Betrieb der Kamera nicht benötigt wird. Vielleicht könnt Ihr das eine oder andere aber brauchen... 

unit OpenGLUtil;

interface

uses DglOpenGL, Math, Windows, Graphics, SysUtils, Dialogs, glBmp;

type
  TProjection=(Frustum, Orthographic, Perspective);

  TGLPlace=packed record
    X,Y,Z: glFloat;
  end;

  TScale=packed record
    X,Y,Z: glFloat;
  end;

  TGLPosition=packed record
    X,Y,Z,W: glFloat;
  end;

  TPosition = packed record
    X,Y,Z,W: GLdouble;
  end;

  TGLVector = packed record
    X,Y,Z: GLfloat;
  end;
  TGLVectorArray = array of TGLvector;
  TGLfloatArray = array of TGLfloat;

  TGKVector = packed record
    X,Y,Z: GLfloat;
  end;

  TAngle = packed record
    X,Y,Z: GLdouble;
  end;

  TGLColor=record
    red,green,blue,alpha: GLclampf;
  end;

  TRotation = packed record
    angle, x, y, z: GLfloat;
  end;

  TTextureInfo = packed record
    BitmapName: string;
    TextureNum: GLUint;
    theBmp: TGLbmp;
  end;
  TTextureList = array of TTextureInfo;

  TMatrix = array [0..3,0..3] of TGLFloat;
  TArrMatrix = array [0..15] of TGLFloat;
  TFrustum = array [0..5,0..3] of TGLFloat;
  TArrVector = array [0..3] of TGLFloat;

  function GetMatrixX (matrix: TArrMatrix): TGLvector;
  function GetMatrixY (matrix: TArrMatrix): TGLvector;
  function GetMatrixZ (matrix: TArrMatrix): TGLvector;
  function GetMatrixPos (matrix: TArrMatrix): TGLvector;
  procedure SetMatrixX (var matrix: TArrMatrix; v: TGLvector);
  procedure SetMatrixY (var matrix: TArrMatrix; v: TGLvector);
  procedure SetMatrixZ (var matrix: TArrMatrix; v: TGLvector);
  procedure SetMatrixPos (var matrix: TArrMatrix; v: TGLvector);
  function Multiply (Color: TGLcolor; m: TGLdouble): TGLcolor;overload;
  function Multiply (V1, V2: TGLVector): TGLVector;overload;
  function Multiply (M1, M2: TArrMatrix): TArrMatrix;overload;
  function Divide (V1, V2: TGLVector): TGLVector;overload;
  function Divide (V1: TGLVector; d: TGLdouble): TGLVector;overload;
  function MakeVector(X,Y,Z:TGLFloat):TArrVector;overload;
  function MakeVector(X,Y,Z,W:TGLFloat):TArrVector;overload;
  procedure Normalize(aVector:TArrVector;var RVec:TArrVector);overload;
  procedure Normalize(aVector:TGLVector;var RVec:TGLVector);overload;
  function GetIdentity(Matrix:TMatrix):TMatrix;overload;
  function GetIdentity(Matrix:TArrMatrix):TArrMatrix;overload;
  function MatrixTranspose(const M:TMatrix):TMatrix;register;
  function VectorRotateX(v:TArrVector;a:TGLFloat):TArrVector;overload;
  function VectorRotateY(v:TArrVector;a:TGLFloat):TArrVector;overload;
  function VectorRotateZ(v:TArrVector;a:TGLFloat):TArrVector;overload;
  function VectorRotateX(v:TGLVector;a:TGLFloat):TGLVector;overload;
  function VectorRotateY(v:TGLVector;a:TGLFloat):TGLVector;overload;
  function VectorRotateZ(v:TGLVector;a:TGLFloat):TGLVector;overload;

  function GL2GKVector (V: TGLVector): TGKVector;
  function GK2GLVector (V: TGKVector): TGLVector;
  function GL2WinColor (GLcol: TGLcolor): TColor;
  function Win2GLColor (WinCol: Tcolor): TGLcolor;
  function CalcNormale (V1, V2, V3: TGLVector): TGLVector;
  function CrossProduct(V1, V2: TGLVector): TGLVector;
  function DotProduct (V1, V2: TGLVector): GLdouble;
  function LoadTexture(Filename: String; var Texture: GLuint): Boolean;
  function Magnitude(V1 : TGLVector) : GLdouble;
  function ScalarProduct (V1, V2: TGLVector): GLdouble;
  function SubtractVector (Vec1, Vec2: TGLVector): TGLVector;overload;
  function SubtractVector (Vec: TGLVector; X, Y, Z: TGLdouble): TGLVector;overload;
  function AddVector (Vec1, Vec2: TGLVector): TGLVector;overload;
  function AddVector (Vec: TGLVector; X, Y, Z: TGLdouble): TGLVector;overload;
  function ForceForegroundWindow(hwnd: THandle): Boolean;
  procedure InitGLEnv (dc: HDC; rc: HGLRC; hndl: THandle);// pixelformat setzen
  procedure CopyVector (FromVektor: TGLVector; var ToVektor: TGLVector);
  procedure InitVector (var V1: TGLVector; x, y, z: TGLdouble);overload;
  procedure InitVector (var V1: TGKVector; x, y, z: TGLdouble);overload;
  procedure InitVector (var V1: TArrVector; x, y, z: TGLdouble);overload;
  procedure InitScale (var S1: TScale; x, y, z: TGLdouble);
  procedure LoadBitmap(Filename: String;
                       out Width: Cardinal;
                       out Height: Cardinal;
                       out pData: Pointer);
  procedure GetRotation (V1, V2: TGLVector;
                         var Rotation: TRotation);
  function MakeTextureFromBitmap (Bitmap: string; var BitmapList: TTextureList): GLenum;
  procedure EnableTexture (Texture: GLenum; TextureTiled: boolean);
  procedure DisableTexture;
  function TextToGLVector (VTxt: string): TGLVector;
  function TextToGKVector (VTxt: string): TGKVector;
  function GKVectorToText (V1: TGKVector): string;overload;
  function GKVectorToText (V1: TGKVector; digits: byte): string;overload;
  function GLVectorToText (V1: TGLVector): string;overload;
  function GLVectorToText (V1: TGLVector; digits: byte): string;overload;
  function MyCone (Start, Ende: TGLVector;
                   RadiusStart, RadiusEnde: TGLfloat;
                   Slices: Integer): boolean;
  function InvertMatrix (src: TArrMatrix; var inverse: TArrMatrix): boolean;

const
  C_X = 0;
  C_Y = 1;
  C_Z = 2;
  C_W = 3;
  C_EPS:TGLFloat=0.01;
  C_DEGTORAD:TGLFloat=3.1412/180;
  C_RADTODEG:TGLFloat=180/3.1412;
  C_LAMBDA_INCREMENT:TGLFloat=0.01;


implementation

uses Forms, KanalUtil, OGLinclude, Controls;

function MyPower (Base: extended; Exp: integer): extended;
begin
  result := Base * Base;
end;

procedure CopyVector (FromVektor: TGLVector; var ToVektor: TGLVector);
begin
  ToVektor.X := FromVektor.X;
  ToVektor.Y := FromVektor.Y;
  ToVektor.Z := FromVektor.Z;
end;

function GetMatrixX (matrix: TArrMatrix): TGLvector;
// holt den X-vektor aus matrix und gibt ihn zurück
begin
  result.X := matrix[00];
  result.Y := matrix[01];
  result.Z := matrix[02];
end;

function GetMatrixY (matrix: TArrMatrix): TGLvector;
// holt den Y-vektor aus matrix und gibt ihn zurück
begin
  result.X := matrix[04];
  result.Y := matrix[05];
  result.Z := matrix[06];
end;

function GetMatrixZ (matrix: TArrMatrix): TGLvector;
// holt den Z-vektor aus matrix und gibt ihn zurück
begin
  result.X := matrix[08];
  result.Y := matrix[09];
  result.Z := matrix[10];
end;

function GetMatrixPos (matrix: TArrMatrix): TGLvector;
// holt den Position-vektor aus matrix und gibt ihn zurück
begin
  result.X := matrix[12];
  result.Y := matrix[13];
  result.Z := matrix[14];
end;

procedure SetMatrixX (var matrix: TArrMatrix; v: TGLvector);
// setzt den durch v bestimmten X-vektor in matrix
begin
  matrix[00] := v.X;
  matrix[01] := v.Y;
  matrix[02] := v.Z;
end;

procedure SetMatrixY (var matrix: TArrMatrix; v: TGLvector);
// setzt den durch v bestimmten Y-vektor in matrix
begin
  matrix[04] := v.X;
  matrix[05] := v.Y;
  matrix[06] := v.Z;
end;

procedure SetMatrixZ (var matrix: TArrMatrix; v: TGLvector);
// setzt den durch v bestimmten Z-vektor in matrix
begin
  matrix[08] := v.X;
  matrix[09] := v.Y;
  matrix[10] := v.Z;
end;

procedure SetMatrixPos (var matrix: TArrMatrix; v: TGLvector);
// setzt den durch v bestimmten Position-vektor in matrix
begin
  matrix[12] := v.X;
  matrix[13] := v.Y;
  matrix[14] := v.Z;
end;

function SubtractVector (Vec1, Vec2: TGLVector): TGLVector;
// subtrahiert Vec2 von vec1 und gibt das ergebnis in vec3 zurück
var
  Vec3: TGLVector;
begin
  Vec3 .X := Vec1.X - Vec2.X;
  Vec3 .Y := Vec1.Y - Vec2.Y;
  Vec3 .Z := Vec1.Z - Vec2.Z;
  result := Vec3;
end;

function SubtractVector (Vec: TGLVector; X, Y, Z: TGLdouble): TGLVector;
// subtrahiert X, Y, Z von vec.x, vec.y, vec.z  und gibt das
// ergebnis zurück
begin
  Vec .X := Vec.X - X;
  Vec .Y := Vec.Y - Y;
  Vec .Z := Vec.Z - Z;
  result := Vec;
end;

function AddVector (Vec1, Vec2: TGLVector): TGLVector;
// addiert Vec2 auf vec1 und gibt das ergebnis in vec3 zurück
var
  Vec3: TGLVector;
begin
  Vec3 .X := Vec1.X + Vec2.X;
  Vec3 .Y := Vec1.Y + Vec2.Y;
  Vec3 .Z := Vec1.Z + Vec2.Z;
  result := Vec3;
end;

function AddVector (Vec: TGLVector; X, Y, Z: TGLdouble): TGLVector;
// addiert X, Y, Z auf vec.x, vec.y, vec.z  und gibt das
// ergebnis zurück
begin
  Vec .X := Vec.X + X;
  Vec .Y := Vec.Y + Y;
  Vec .Z := Vec.Z + Z;
  result := Vec;
end;

function Magnitude(V1 : TGLVector) : GLdouble;
var
  Ergebnis: GLdouble;
begin
// gibt die länge des vektors zurück
  Ergebnis := MyPower(V1.X,2)+MyPower(V1.Y,2)+MyPower(V1.Z,2);
  try
    result := sqrt(Ergebnis);
  except
    result := 0;
  end;
end;

function DotProduct (V1, V2: TGLVector): GLdouble;
var
  len1, len2: GLdouble;
  Ergebnis: GLdouble;
begin
  //len1 := MyPower(V1.X,2)+MyPower(V1.Y,2)+MyPower(V1.Z,2);
  //len2 := MyPower(V2.X,2)+MyPower(V2.Y,2)+MyPower(V2.Z,2);
  len1 := Magnitude (V1);
  len2 := Magnitude (V2);
  Ergebnis := ScalarProduct (V1, V2);
  Ergebnis := arccos (Ergebnis / (len1 * len2));
  result := radtodeg (Ergebnis) * 2.0;
end;

function CrossProduct(V1, V2: TGLVector): TGLVector;
var
  CrossVec: TGLVector;
begin
	//CrossVec.X := +((V1.Y*V2.Z) - (V1.Z*V2.Y));
	//CrossVec.Y := -((V1.X*V2.Z) - (V1.Z*V2.X));
	//CrossVec.Z := +((V1.X*V2.Y) - (V1.Y*V2.X));
	CrossVec.X := ((V1.Y*V2.Z) - (V1.Z*V2.Y));
	CrossVec.Y := ((V1.Z*V2.X) - (V1.X*V2.Z));
	CrossVec.Z := ((V1.X*V2.Y) - (V1.Y*V2.X));
  result := CrossVec;
 end;

function CalcNormale (V1, V2, V3: TGLVector): TGLVector;
var
  Kreuz: TGLvector;
  V1V2, V1V3: TGLvector;
begin
  // gibt die normale von 3 vektoren zurück (die senkrechte auf die
  // durch die drei vektoren gebildete ebene)
  V1V2 := SubtractVector (V2, V1);
  V1V3 := SubtractVector (V3, V1);

  Kreuz := CrossProduct (V1V2, V1V3);

  Normalize (Kreuz, result);
end;

procedure InitVector (var V1: TGLVector; x, y, z: TGLdouble);
begin
  V1.x := x;
  V1.y := y;
  V1.z := z;
end;

procedure InitVector (var V1: TGKVector; x, y, z: TGLdouble);
begin
  V1.x := x;
  V1.y := y;
  V1.z := z;
end;

procedure InitVector (var V1: TArrVector; x, y, z: TGLdouble);
begin
  V1[C_X] := x;
  V1[C_Y] := y;
  V1[C_Z] := z;
end;

procedure InitScale (var S1: TScale; x, y, z: TGLdouble);
begin
  S1.x := x;
  S1.y := y;
  S1.z := z;
end;

function Multiply (V1, V2: TGLVector): TGLVector;
var
  ret: TGLVector;
begin
// zwei vektoren miteinander multiplizieren
  ret.X := V1.X * V2.X;
  ret.Y := V1.Y * V2.Y;
  ret.Z := V1.Z * V2.Z;
  result := ret;
end;

function Divide (V1, V2: TGLVector): TGLVector;
var
  ret: TGLVector;
begin
// zwei vektoren miteinander multiplizieren
  ret.X := V1.X / V2.X;
  ret.Y := V1.Y / V2.Y;
  ret.Z := V1.Z / V2.Z;
  result := ret;
end;

function ScalarProduct (V1, V2: TGLVector): GLdouble;
begin
// die summe der potenzen der einzelnen achsen von zwei vektoren errechnen
  result := (V1.X*V2.X +
             V1.Y*V2.Y +
             V1.Z*V2.Z);
end;

function LoadTexture(Filename: String; var Texture: GLuint): Boolean;
resourcestring
  Res_LoadUnable = 'Unable to load ';
  Res_LoadingTex = 'Loading Textures';
var
  pData: Pointer;
  Width: Cardinal;
  Height: Cardinal;
  newTexture: GLint;
begin
  pData :=nil;
  LoadBitmap(Filename, Width, Height, pData);

  if (Assigned(pData)) then
    Result := True
  else
  begin
    Result := False;
    MessageBox(0, PChar(Res_LoadUnable + filename),
               pchar (Res_LoadingTex), MB_OK);
    exit;
  end;

  glGenTextures(1, @NewTexture);
  glBindTexture(GL_TEXTURE_2D, NewTexture);
  glTexEnvi(GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE);  {Texture blends with object background}

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

  Texture := newTexture;
end;

procedure LoadBitmap(Filename: String;
                     out Width: Cardinal;
                     out Height: Cardinal;
                     out pData: Pointer);
resourcestring
  Res_ReadErr = 'Error reading palette';
  Res_OpenErr = 'Error opening: ';
  Res_BitmapDataErr = 'Error reading bitmap data';
  Res_BmpUnit = 'BMP Unit';
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(Res_OpenErr+Filename), PChar(Res_BmpUnit), 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(Res_ReadErr), PChar(Res_BmpUnit), MB_OK);
    CloseHandle(BitmapFile);
    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(Res_BitmapDataErr), PChar(Res_BmpUnit), MB_OK);
    CloseHandle(BitmapFile);
    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;

function GK2GLVector (V: TGKVector): TGLVector;
// ändert Gauss-Krüger Koordinaten in OpenGL Koordinaten um
begin
  result.X := V.X;
  result.Y := V.Z;
  result.Z := V.Y;
end;

function GL2GKVector (V: TGLVector): TGKVector;
// ändert OpenGL Koordinaten in Gauss-Krüger Koordinaten um
begin
  result.X := V.X;
  result.Y := V.Z;
  result.Z := V.Y;
end;

function Win2GLColor (WinCol: TColor): TGLcolor;
begin
  result.Red := GetRValue (WinCol) / 255;
  result.Green := GetGValue (WinCol) / 255;
  result.Blue := GetBValue (WinCol) / 255;
  result.Alpha := 0.0;
end;

function GL2WinColor (GLcol: TGLcolor): TColor;
begin
  result := Rgb (StrToInt (FloatToStr (int (GLcol.Red * 255))),
                 StrToInt (FloatToStr (int (GLcol.Green * 255))),
                 StrToInt (FloatToStr (int (GLcol.Blue * 255))));
end;

procedure GetRotation (V1, V2: TGLVector;
                       var Rotation: TRotation);
var
  tmpCyl, tmpZiel, nullVec: TGLVector;
  normale, ResultLen: TGLVector;
  VectorLength: GLfloat;
begin
  // temporäre vektoren initialisieren
  InitVector (nullVec, 0,0,0);
  InitVector (tmpCyl, 0,0,0);

  // länge des zu drehenden objekts ermitteln
  ResultLen := SubtractVector (V2, V1);
  VectorLength := Magnitude (ResultLen);

  // vektoren zur bildung der dreiecksfläche bilden.
  // die schenkel schneiden sich im nullpunkt
  // der Cylinder läuft immer entlang der Z-Achse
  tmpCyl.Z := VectorLength;
  tmpZiel := SubtractVector (V2, V1);
  tmpZiel.Z := tmpZiel.Z + VectorLength;

  // senkrechte zu den beiden vektoren bilden
  // (um diese achse soll nachher gedreht werden)
  // drehachse für späteren gebrauch speichern
  normale := CalcNormale (tmpCyl, tmpZiel, nullVec);

  // um "Angle" Grad soll nachher gedreht werden
  Rotation.Angle := DotProduct(tmpCyl, tmpZiel);
  Rotation.X     := normale.X;
  Rotation.Y     := normale.Y;
  Rotation.Z     := normale.Z;
end;

function MakeTextureFromBitmap (Bitmap: string; var BitmapList: TTextureList): GLenum;
// die funktion lädt die in Bitmap übergebene Grafik und gibt die Textturnummer
// zurück. ist das bitmap schon im array BitmapList enthalten, wird die bereits
// vergeben nummer zurückgegeben.
resourcestring
  Res_TextureNotFound = 'Texturdatei nicht gefunden: ';
  Res_Error = 'Error';
var
  i, Laenge: integer;
begin
  result := 0;
  if length (trim (Bitmap)) = 0 then
    exit;
  Bitmap := uppercase (ExePath + trim (Bitmap));
  // suchen, ob die textur schon geladen wurde
  Laenge := length (BitmapList);
  if Laenge > 0 then
    for i := 0 to Laenge-1 do
    begin
      if (BitmapList[i].BitmapName = Bitmap) and
         (glIsTexture (BitmapList[i].TextureNum)) then
        result := BitmapList[i].TextureNum;
    end;

  if result = 0 then
  begin
    if not fileexists (Bitmap) then
    begin
      MessageBox (0, PChar (Res_TextureNotFound+Bitmap),
                  pchar (Res_Error), MB_OK or MB_ICONERROR);
      exit;
    end;
  end;

  if (result = 0) then
  begin
    setlength (BitmapList, Laenge+1);
    BitmapList[Laenge].BitmapName := Bitmap;
    BitmapList[Laenge].TextureNum := 0;
    BitMapList[Laenge].theBmp := TglBmp.Create;
    if BitMapList[Laenge].theBmp.LoadImage (BitMap) then
    begin
      BitMapList[Laenge].theBmp.SetTextureWrap(GL_CLAMP_TO_EDGE, GL_CLAMP_TO_EDGE);
      BitMapList[Laenge].theBmp.GenTexture (false, false);
      result := BitmapList[Laenge].theBmp.TextureID;
      BitmapList[Laenge].TextureNum := BitmapList[Laenge].theBmp.TextureID;
    end;
  end;
end;

procedure EnableTexture (Texture: GLenum; TextureTiled: boolean);
begin
  glEnable(GL_TEXTURE_2D);
  glBindTexture(GL_TEXTURE_2D, Texture);
  glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_NEAREST);
  glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_NEAREST);
  if TextureTiled then
  begin
    glTexparameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_REPEAT);
    glTexparameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_REPEAT);
  end
  else
  begin
    glTexparameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP);
    glTexparameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP);
  end;
end;

procedure DisableTexture;
begin
  glDisable(GL_TEXTURE_2D);
end;

function TextToGLVector (VTxt: string): TGLVector;
const
  subdelim: char = '/';
var
  posi: integer;
  V1: TGLVector;
begin
  InitVector (V1,0,0,0);
  posi := pos (subdelim, VTxt);
  if posi > 0 then
  begin
    V1.X := StrToFloat (copy (VTxt, 1, posi-1));
    VTxt := copy (VTxt, posi+1, length (VTxt));
    posi := pos (subdelim, VTxt);
  end;
  if posi > 0 then
  begin
    V1.Y := StrToFloat (copy (VTxt, 1, posi-1));
    VTxt := copy (VTxt, posi+1, length (VTxt));
  end;
  if length (VTxt) > 0 then V1.Z := StrToFloat (VTxt);

  result := V1;
end;

function TextToGKVector (VTxt: string): TGKVector;
const
  subdelim: char = '/';
var
  posi: integer;
  V1: TGKVector;
begin
  InitVector (V1,0,0,0);
  posi := pos (subdelim, VTxt);
  if posi > 0 then
  begin
    V1.X := StrToFloat (copy (VTxt, 1, posi-1));
    VTxt := copy (VTxt, posi+1, length (VTxt));
    posi := pos (subdelim, VTxt);
  end;
  if posi > 0 then
  begin
    V1.Y := StrToFloat (copy (VTxt, 1, posi-1));
    VTxt := copy (VTxt, posi+1, length (VTxt));
  end;
  if length (VTxt) > 0 then V1.Z := StrToFloat (VTxt);

  result := V1;
end;

function GKVectorToText (V1: TGKVector): string;
const
  subdelim: char = '/';
var
  VTxt: string;
begin
  VTxt := FloatToStr (V1.X) + subdelim;
  VTxt := VTxt + FloatToStr (V1.Y) + subdelim;
  VTxt := VTxt + FloatToStr (V1.Z);
  result := VTxt;
end;

function GKVectorToText (V1: TGKVector; digits: byte): string;
const
  subdelim: char = '/';
var
  VTxt: string;
begin
  VTxt := Format('%*.*f', [digits+3, digits, V1.X]) + subdelim;
  VTxt := VTxt + Format('%*.*f', [digits+3, digits, V1.Y]) + subdelim;
  VTxt := VTxt + Format('%*.*f', [digits+3, digits, V1.Z]);
  result := VTxt;
end;

function GLVectorToText (V1: TGLVector): string;
const
  subdelim: char = '/';
var
  VTxt: string;
begin
  VTxt := FloatToStr (V1.X) + subdelim;
  VTxt := VTxt + FloatToStr (V1.Y) + subdelim;
  VTxt := VTxt + FloatToStr (V1.Z);
  result := VTxt;
end;

function GLVectorToText (V1: TGLVector; digits: byte): string;
const
  subdelim: char = '/';
var
  VTxt: string;
begin
  VTxt := Format('%*.*f', [digits+3, digits, V1.X]) + subdelim;
  VTxt := VTxt + Format('%*.*f', [digits+3, digits, V1.Y]) + subdelim;
  VTxt := VTxt + Format('%*.*f', [digits+3, digits, V1.Z]);
  result := VTxt;
end;

function MyCone (Start, Ende: TGLVector;
                 RadiusStart, RadiusEnde: TGLfloat;
                 Slices: Integer): boolean;
var
  Slice: Integer;
  Laenge, xdelta, zdelta: TGLfloat;
  V1, V2, V3, V4: TGLvector;
  A, B: Single;
  tmpVec: TGLvector;
begin
  result := true;
  // laenge des kegels berechnen
  // hierbei wird davon ausgegangen, dass der kegel senkrecht steht
  // Laenge := Ende.y - Start.y;
  tmpVec := SubtractVector (Start, Ende);
  Laenge := Magnitude (tmpVec);
  // radiusdifferenz berechnen
  xdelta := Start.x - Ende.x;
  zdelta := Start.z - Ende.z;
  xdelta := -xdelta;
  //zdelta := zdelta;
  glBegin (GL_TRIANGLE_STRIP);
  // der kegel wird entlang der z-achse gezeichnet
  V1.z := 0;
  V2.z := 0;
  V3.z := Laenge;
  V4.z := Laenge;
  for Slice := 1 to Slices do begin
    A := 2 * PI * Slice / Slices;
    B := 2 * PI * (Slice+1) / Slices;
    V1.x := sin(A)*RadiusStart;
    V1.y := cos(A)*RadiusStart;
    V2.x := sin(B)*RadiusStart;
    V2.y := cos(B)*RadiusStart;
    // umsetzung von y nach z-achse
    V3.x := (sin(B)*RadiusEnde)+xdelta;
    V3.y := (cos(B)*RadiusEnde)+zdelta;
    V4.x := (sin(A)*RadiusEnde)+xdelta;
    V4.y := (cos(A)*RadiusEnde)+zdelta;
    //Normale := CalcNormale (V1, V3, V2);
    //glNormal3fv(@Normale);
    if Slice = 1 then
    begin
      glTexCoord2f(1,0); glVertex3fv(@V1);
      glTexCoord2f(1,1); glVertex3fv(@V4);
      glTexCoord2f(1-Slice/Slices,0); glVertex3fv(@V2);
      glTexCoord2f(1-Slice/Slices,1); glVertex3fv(@V3);
    end
    else
    begin
      glTexCoord2f(1-Slice/Slices,0); glVertex3fv(@V2);
      glTexCoord2f(1-Slice/Slices,1); glVertex3fv(@V3);
    end;
    // aktuellen und nächsten punkt des kreises (oben und unten)
    // nehmen und ein rechteck zeichnen. alle rechtecke zusammen sollten
    // einen geschlossenen kegel ergeben.
    //glBegin(GL_QUADS);
    //  glNormal3fv(@Normale);
    //  glTexCoord2f(0,0); glVertex3fv(@V2);
    //  glTexCoord2f(1,0); glVertex3fv(@V1);
    //  glTexCoord2f(1,1); glVertex3fv(@V4);
    //  glTexCoord2f(0,1); glVertex3fv(@V3);
    //glEnd;
  end;
  glEnd;  // (GL_TRIANGLE_STRIP)
end;

{-----------------------------------------------------------------------------}
{----------------------------- für TRUVCamera --------------------------------}
{-----------------------------------------------------------------------------}

function Multiply(M1, M2: TArrMatrix): TArrMatrix;
// multiplies two 4x4 matrices
var
  ret: TArrMatrix;
begin
  glPushMatrix();
  glLoadMatrixf(@M1);
  glMultMatrixf(@M2);
  glGetFloatv(GL_MODELVIEW_MATRIX,@ret);
  glPopMatrix();
  result := ret;
end;

function MakeVector(X,Y,Z:TGLFloat):TArrVector;
begin
  result[0]:=x;
  result[1]:=y;
  result[2]:=z;
end;

function MakeVector(X,Y,Z,W:TGLFloat):TArrVector;
begin
  result[0]:=x;
  result[1]:=y;
  result[2]:=z;
  result[3]:=w;
end;

procedure Normalize(aVector:TArrVector;var RVec:TArrVector);
var
   d:double;
begin
  InitVector (RVec,1,1,1);
  d:=Sqrt(Sqr(aVector[C_X])+Sqr(aVector[C_Y])+Sqr(aVector[C_Z]));
  if d=0 then
  begin
    //raise exception.Create('Zero length vector(Normalize 1)');
    exit;
  end;
  RVec[C_X]:=aVector[C_X]/d;
  RVec[C_Y]:=aVector[C_Y]/d;
  RVec[C_Z]:=aVector[C_Z]/d;
end;

procedure Normalize(aVector:TGLVector; var RVec:TGLVector);
var
   d:double;
begin
  InitVector (RVec,1,1,1);
  d:=Sqrt(Sqr(aVector.X)+Sqr(aVector.Y)+Sqr(aVector.Z));
  if d=0 then
  begin
    //raise exception.Create('Zero length vector(Normalize 2)');
    exit;
  end;
  RVec.X:=aVector.X/d;
  RVec.Y:=aVector.Y/d;
  RVec.Z:=aVector.Z/d;
end;

function GetIdentity(Matrix:TMatrix):TMatrix;
begin
  result[0,0]:=1.0;result[0,1]:=0.0;result[0,2]:=0.0;result[0,3]:=0.0;
  result[1,0]:=0.0;result[1,1]:=1.0;result[1,2]:=0.0;result[1,3]:=0.0;
  result[2,0]:=0.0;result[2,1]:=0.0;result[2,2]:=1.0;result[2,3]:=0.0;
  result[3,0]:=0.0;result[3,1]:=0.0;result[3,2]:=0.0;result[3,3]:=1.0;
end;

function GetIdentity(Matrix:TArrMatrix):TArrMatrix;
begin
  result[0]:=1.0;result[1]:=0.0;result[2]:=0.0;result[3]:=0.0;
  result[4]:=0.0;result[5]:=1.0;result[6]:=0.0;result[7]:=0.0;
  result[8]:=0.0;result[9]:=0.0;result[10]:=1.0;result[11]:=0.0;
  result[12]:=0.0;result[13]:=0.0;result[14]:=0.0;result[15]:=1.0;
end;

function MatrixTranspose(const M:TMatrix):TMatrix;register;
var
   i,j:integer;
begin
     for i:=0 to 3 do
         for j:=0 to 3 do
             result[i,j]:=M[j,i];
end;

function VectorRotateX(v:TArrVector;a:TGLFloat):TArrVector;
var
   temp: TArrVector;
   sine,cosine:TGLFloat;
begin
     a:=a*C_DEGTORAD;
     sine:=Sin(a);
     cosine:=Cos(a);

     temp[C_X] := v[C_x];
     temp[C_Y] := (v[C_Y] * cosine) + (v[C_Z] * -sine);
     temp[C_Z] := (v[C_Y] * sine) + (v[C_Z] * cosine);
     result := temp;
end;

function VectorRotateY(v: TArrVector;a:TGLFloat):TArrVector;
var
   temp: TArrVector;
   sine,cosine:TGLFloat;
begin
     a:=a*C_DEGTORAD;
     sine:=Sin(a);
     cosine:=Cos(a);

     temp[C_x] := (v[C_x] * cosine) + (v[C_z] * sine);
     temp[C_y] := v[C_y];
     temp[C_z] := (v[C_x] * -sine) + (v[C_z] * cosine);
     result := temp;
end;

function VectorRotateZ(v: TArrVector; a: TGLFloat):TArrVector;
var
  temp: TArrVector;
   sine,cosine:TGLFloat;
begin
     a:=a*C_DEGTORAD;
     sine:=Sin(a);
     cosine:=Cos(a);
     temp[C_x] := (v[C_x] * cosine) + (v[C_y] * -sine);
     temp[C_y] := (v[C_x] * sin(a)) + (v[C_y] * cosine);
     temp[C_z] := v[C_z];
     result := temp;
end;

function VectorRotateX(v:TGLVector;a:TGLFloat):TGLVector;
var
   temp: TGLVector;
   sine,cosine:TGLFloat;
begin
     a:=a*C_DEGTORAD;
     sine:=Sin(a);
     cosine:=Cos(a);

     temp.X := v.x;
     temp.Y := (v.Y * cosine) + (v.Z * -sine);
     temp.Z := (v.Y * sine) + (v.Z * cosine);
     result := temp;
end;

function VectorRotateY(v: TGLVector;a:TGLFloat):TGLVector;
var
   temp: TGLVector;
   sine,cosine:TGLFloat;
begin
     a:=a*C_DEGTORAD;
     sine:=Sin(a);
     cosine:=Cos(a);

     temp.x := (v.x * cosine) + (v.z * sine);
     temp.y := v.y;
     temp.z := (v.X * -sine) + (v.z * cosine);
     result := temp;
end;

function VectorRotateZ(v: TGLVector; a: TGLFloat):TGLVector;
var
  temp: TGLVector;
   sine,cosine:TGLFloat;
begin
     a:=a*C_DEGTORAD;
     sine:=Sin(a);
     cosine:=Cos(a);
     temp.x := (v.x * cosine) + (v.y * -sine);
     temp.y := (v.x * sin(a)) + (v.y * cosine);
     temp.z := v.z;
     result := temp;
end;

{-----------------------------------------------------------------------------}
{-------------------------------- allgemein ----------------------------------}
{-----------------------------------------------------------------------------}

function InvertMatrix (src: TArrMatrix; var inverse: TArrMatrix): boolean;
var
  t: TGLdouble;
  i, j, k, swap: integer;
  tmp: TMatrix;
begin
  result := false;
  inverse := GetIdentity(inverse);

  for i := 0 to 3 do
  begin
    for j := 0 to 3 do
    begin
      tmp[i][j] := src[i*4+j];
    end;
  end;

  for i := 0 to 3 do
  begin
    // look for largest element in column.
    swap := i;
    for j := i+1 to 3 do
    begin
      if abs(tmp[j][i]) > abs(tmp[i][i]) then
      begin
        swap := j;
      end;
    end;

    if not (swap = i) then
    begin
      // swap rows.
      for k := 0 to 3 do
      begin
        t := tmp[i][k];
        tmp[i][k] := tmp[swap][k];
        tmp[swap][k] := t;

        t := inverse[i*4+k];
        inverse[i*4+k] := inverse[swap*4+k];
        inverse[swap*4+k] := t;
      end;
    end;

    if tmp[i][i] = 0 then
    begin
    { no non-zero pivot.  the matrix is singular, which
      shouldn't happen.  This means the user gave us a bad
      matrix. }
      exit;
    end;

    t := tmp[i][i];
    for k := 0 to 3 do
    begin
      tmp[i][k] := tmp[i][k]/t;
      inverse[i*4+k] := inverse[i*4+k]/t;
    end;

    for j := 0 to 3 do
    begin
      if not (j = i) then
      begin
        t := tmp[j][i];
        for k := 0 to 3 do
        begin
          tmp[j][k] := tmp[j][k]-tmp[i][k]*t;
          inverse[j*4+k] := inverse[j*4+k]-inverse[i*4+k]*t;
        end;
      end;
    end;
  end;
  result := true;
end;

function Multiply (Color: TGLcolor; m: TGLdouble): TGLcolor;
var
  ret: TGLcolor;
begin
  ret.red := Color.red * m;
  ret.green := Color.green * m;
  ret.blue := Color.blue * m;
  result := ret;
end;

function Divide (V1: TGLvector; d: TGLdouble): TGLvector;
var
  ret: TGLvector;
begin
  ret.x := V1.x / d;
  ret.y := V1.y / d;
  ret.z := V1.z / d;
  result := ret;
end;

function ForceForegroundWindow(hwnd: THandle): Boolean;
{
  Manchmal funktioniert die SetForeGroundWindow Funktion
  nicht so, wie sie sollte; besonders unter Windows 98/2000,
  wenn ein anderes Fenster den Fokus hat.
  ForceForegroundWindow ist eine "verbesserte" Version von
  der SetForeGroundWindow API-Funktion, um ein Fenster in
  den Vordergrund zu bringen.
}
const
  SPI_GETFOREGROUNDLOCKTIMEOUT = $2000;
  SPI_SETFOREGROUNDLOCKTIMEOUT = $2001;
var
  ForegroundThreadID: DWORD;
  ThisThreadID: DWORD;
  timeout: DWORD;
begin
  if IsIconic(hwnd) then ShowWindow(hwnd, SW_RESTORE);

  if GetForegroundWindow = hwnd then Result := True
  else
  begin
    // Windows 98/2000 doesn't want to foreground a window when some other
    // window has keyboard focus

    if ((Win32Platform = VER_PLATFORM_WIN32_NT) and (Win32MajorVersion > 4)) or
      ((Win32Platform = VER_PLATFORM_WIN32_WINDOWS) and
      ((Win32MajorVersion > 4) or ((Win32MajorVersion = 4) and
      (Win32MinorVersion > 0)))) then
    begin
      // Code from Karl E. Peterson, www.mvps.org/vb/sample.htm
      // Converted to Delphi by Ray Lischner
      // Published in The Delphi Magazine 55, page 16

      Result := False;
      ForegroundThreadID := GetWindowThreadProcessID(GetForegroundWindow, nil);
      ThisThreadID := GetWindowThreadPRocessId(hwnd, nil);
      if AttachThreadInput(ThisThreadID, ForegroundThreadID, True) then
      begin
        BringWindowToTop(hwnd); // IE 5.5 related hack
        SetForegroundWindow(hwnd);
        AttachThreadInput(ThisThreadID, ForegroundThreadID, False);
        Result := (GetForegroundWindow = hwnd);
      end;
      if not Result then
      begin
        // Code by Daniel P. Stasinski
        SystemParametersInfo(SPI_GETFOREGROUNDLOCKTIMEOUT, 0, @timeout, 0);
        SystemParametersInfo(SPI_SETFOREGROUNDLOCKTIMEOUT, 0, TObject(0),
          SPIF_SENDCHANGE);
        BringWindowToTop(hwnd); // IE 5.5 related hack
        SetForegroundWindow(hWnd);
        SystemParametersInfo(SPI_SETFOREGROUNDLOCKTIMEOUT, 0, TObject(timeout), SPIF_SENDCHANGE);
      end;
    end
    else
    begin
      BringWindowToTop(hwnd); // IE 5.5 related hack
      SetForegroundWindow(hwnd);
    end;

    Result := (GetForegroundWindow = hwnd);
  end;
end; { ForceForegroundWindow }

procedure InitGLEnv (dc: HDC; rc: HGLRC; hndl: THandle);
resourcestring
  Res_ChooseFailed = 'ChoosePixelFormat failed with ';
var
  pfd: TPixelFormatDescriptor;
  PixelFormat: TGLUint;
  pFlags: TPFDFlags;
  flags: word absolute pFlags;
  StencilBits,
  ColorBits,
  DepthBits: integer;
begin
  pflags := [];
  include (pflags, DoubleBuffer);
  include (pflags, Stereo);
  include (pflags, Draw_To_Window);
  include (pflags, Draw_To_Bitmap);
  include (pflags, Support_GDI);
  include (pflags, Support_OpenGL);
  include (pflags, Generic_Format);
  include (pflags, Need_Palette);
  include (pflags, Need_System_Palette);
  include (pflags, Swap_Exchange);
  include (pflags, Swap_Copy);
  include (pflags, Swap_Layer_Buffers);
  include (pflags, Generic_Accelerated);

  ColorBits := 24;
  DepthBits := 32;
  StencilBits := 0;

  with TWinControl(hndl) do
  begin
    fillchar(pfd,SizeOf(pfd),0);
    with pfd do
    begin
      nSize           := SizeOf(pfd);
      nVersion        := 1;
      dwFlags         := flags or
                         PFD_DRAW_TO_WINDOW
                         or PFD_SUPPORT_OPENGL
                         or PFD_DOUBLEBUFFER;
      iPixelType      := PFD_TYPE_RGBA;
      cColorBits      := ColorBits;
      cDepthBits      := DepthBits;
      cStencilBits    := StencilBits;
      iLayerType      := PFD_MAIN_PLANE;
      cRedBits        := 0;
      cRedShift       := 0;
      cGreenBits      := 0;
      cBlueBits       := 0;
      cBlueShift      := 0;
      cAlphaBits      := 0;
      cAlphaShift     := 0;
      cAccumBits      := 0;
      cAccumRedBits   := 0;
      cAccumGreenBits := 0;
      cAccumBlueBits  := 0;
      cAccumAlphaBits := 0;
      cAuxBuffers     := 0;
      bReserved       := 0;
      dwLayerMask     := 0;
      dwVisibleMask   := 0;
      dwDamageMask    := 0;
    end; {with}

    PixelFormat := ChoosePixelFormat(dc, @pfd);
    if PixelFormat=0 then
      raise Exception.Create(Res_ChooseFailed+IntToStr(GetLastError));

    //if not SetPixelFormat(FglDC, PixelFormat, @pfd) then
    //  raise Exception.Create('SetPixelFormat failed with '+
    //    IntToStr(GetLastError));
  end;
end;

end.
Abgerufen von „https://wiki.delphigl.com/index.php?title=Kamera_(3)&oldid=16057“