Kamera (3)

Aus DGL Wiki

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...

{******************************************************************}
(*
  Released as part of the camera example program
  Visit us @ http://www.delphigl.com
  Maintained by Florian Sievert (Phobeus)
  Phobeus@DelphiGL.com
-------------------------------------------------------------------
  License
  -------
  Copyright (C) 2007 Andree Heyroth
 
  This license applies to everything on www.delphigl.com, except where
  otherwise noted.
 
  This software is provided 'as-is', without any express or implied warranty.
  In no event will the authors be held liable for any damages arising from
  the use of this software.
 
  Permission is granted to anyone to use this software for any purpose,
  including commercial applications, and to alter it and redistribute it
  freely, subject to the following restrictions:
 
  1. The origin of this software must not be misrepresented; you must not
     claim that you wrote the original software. If you use this software in a
     product, an acknowledgment in the product documentation would be
     appreciated but is not required.
  2. Altered source versions must be plainly marked as such, and must not be
     misrepresented as being the original software.
  3. This notice may not be removed or altered from any source distribution.
 
  Description
  -----------
  Include file which contains common functions to perform OpenGL specific tasks
  like rotating a point around a specific axis or invert matrices or calculate
  a vectors normal or calculate a cross product or ...
 
  Requirements
  ------------
  - SDL 1.2 (http://www.libsdl.org/download-1.2.php or your distribution)
  - Borland Delphi version 5.0 and above
 
  History
  -------
  -
 
  Contact
  -------
  I created this source code in my spare time. If you find a bug or just
  wanna say hello, feel free to write to the contributor:
 
    Andree Heyroth (AndyH)
    email : heyroth@syncro-concept.de
    Visit: http://www.delphigl.com
 
*******************************************************************************)
unit Util;
 
interface
 
uses DglOpenGL, Math, Windows, Graphics, SysUtils, Dialogs{, glBmp};
 
type
  TProjection=(Frustum, Orthographic, Perspective);
 
  TGLPlace=packed record
    X,Y,Z: GLdouble;
  end;
 
  TScale=packed record
    X,Y,Z: GLdouble;
  end;
 
  TGLPosition=packed record
    X,Y,Z,W: GLdouble;
  end;
 
  TPosition = packed record
    X,Y,Z,W: GLdouble;
  end;
 
  TGLVector = packed record
    X,Y,Z: GLdouble;
  end;
  TPGLvector=^TGLvector;
 
  TTextureCoord=record
    X, Y, Z: GLdouble;
  end;
 
  TTextureCoordArray = array of TTextureCoord;
  TGLvectorArray = array of TGLvector;
  TGLdoubleArray = array of GLdouble;
  TGLfloatArray = array of GLfloat;
 
  TGKVector = packed record
    X,Y,Z: GLdouble;
  end;
 
  TAngle = packed record
    X,Y,Z: GLdouble;
  end;
 
  TGLColor=record
    red,green,blue,alpha: GLclampf;
  end;
 
  TRotation = packed record
    angle, x, y, z: GLdouble;
  end;
 
  TTextureInfo = packed record
    BitmapName: string;
    TextureNum: GLUint;
    //theBmp: TGLbmp;
  end;
  TTextureList = array of TTextureInfo;
 
  TMatrix = array [0..3,0..3] of GLdouble;
  TArrMatrix = array [0..15] of GLdouble;
  TFrustum = array [0..5,0..3] of GLdouble;
  TArrVector = array [0..3] of GLdouble;
 
  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: GLdouble): 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: GLdouble): TGLVector;overload;
  function MakeVector(X,Y,Z:GLdouble):TArrVector;overload;
  function MakeVector(X,Y,Z,W:GLdouble):TArrVector;overload;
  function Normalize(aVector:TArrVector):TArrVector;overload;
  function Normalize(aVector:TGLVector):TGLVector;overload;
  function GetIdentity(Matrix:TMatrix):TMatrix;overload;
  function GetIdentity(Matrix:TArrMatrix):TArrMatrix;overload;
  function MatrixTranspose(const M:TMatrix):TMatrix;register;
  function NearestPoint(Axis, Point: TGLVector): TGLVector;
  function VectorRotateX(v:TArrVector;a:GLdouble):TArrVector;overload;
  function VectorRotateY(v:TArrVector;a:GLdouble):TArrVector;overload;
  function VectorRotateZ(v:TArrVector;a:GLdouble):TArrVector;overload;
  function VectorRotateX(v:TGLVector;a:GLdouble):TGLVector;overload;
  function VectorRotateY(v:TGLVector;a:GLdouble):TGLVector;overload;
  function VectorRotateZ(v:TGLVector;a:GLdouble):TGLVector;overload;
  function VectorRotateX(v,c:TGLvector;a:GLdouble):TGLVector;overload;
  function VectorRotateY(v,c:TGLvector;a:GLdouble):TGLVector;overload;
  function VectorRotateZ(v,c:TGLvector;a:GLdouble):TGLVector;overload;
  function VectorRotateX(v1,v2,v3,v4:TGLVector;a:GLdouble):TGLVector;overload;
  function VectorRotateY(v1,v2,v3,v4:TGLVector;a:GLdouble):TGLVector;overload;
  function VectorRotateZ(v1,v2,v3,v4:TGLVector;a:GLdouble):TGLVector;overload;
 
  function AxisXRotation (V1, V2: TGLvector): GLdouble;
  function AxisYRotation (V1, V2: TGLvector): GLdouble;
  function AxisZRotation (V1, V2: TGLvector): GLdouble;
 
  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;overload;
  function Magnitude(X, Y: GLdouble): GLdouble;overload;
  function ScalarProduct (V1, V2: TGLVector): GLdouble;
  function MinVector (V1, V2: TGLvector): TGLvector;
  function MaxVector (V1, V2: TGLvector): TGLvector;
  function SubtractVector (Vec1, Vec2: TGLVector): TGLVector;overload;
  function SubtractVector (Vec: TGLVector; X, Y, Z: GLdouble): TGLVector;overload;
  function AddVector (Vec1, Vec2: TGLVector): TGLVector;overload;
  function AddVector (Vec: TGLVector; X, Y, Z: GLdouble): TGLVector;overload;
  function ForceForegroundWindow(hwnd: THandle): Boolean;
  function ValidTexture (tex: GLUint; ErrStr: string): boolean;
  procedure ResetGLErrorFlags;
  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: GLdouble);overload;
  procedure InitVector (var V1: TGKVector; x, y, z: GLdouble);overload;
  procedure InitVector (var V1: TArrVector; x, y, z: GLdouble);overload;
  procedure InitScale (var S1: TScale; x, y, z: GLdouble);
  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, decimals: byte): string;overload;
  function GLVectorToText (V1: TGLVector): string;overload;
  function GLVectorToText (V1: TGLVector; digits, decimals: byte): string;overload;
  function MatrixToText (M: TArrMatrix): string;
  function CheckFormat (number: string; digits, decimals: byte): string;
  function MyCone (Start, Ende: TGLVector;
                   RadiusStart, RadiusEnde: GLdouble;
                   Slices: integer; TileX, TileY: GLdouble): boolean;
  function InvertMatrix (src: TArrMatrix; var inverse: TArrMatrix): boolean;
  function ExePath: string;
 
const
  C_X = 0;
  C_Y = 1;
  C_Z = 2;
  C_W = 3;
  C_EPS:GLdouble=0.01;
  C_DEGTORAD:GLdouble=3.1412/180;
  C_RADTODEG:GLdouble=180/3.1412;
  C_LAMBDA_INCREMENT:GLdouble=0.01;
  C_PI=3.1415926535;
  C_PI_DIV_180=C_PI/180;
 
implementation
 
uses Forms, {KanalUtil,} OGLinclude, Controls;
 
function MyPower (Base: extended; Exp: integer): extended;
//var
//  i: integer;
begin
//  result := Base;
//  for i := 2 to Exp do
//    result := result * Base;
 
  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 MinVector (V1, V2: TGLvector): TGLvector;
// gibt den Vector mit der geringeren Länge zurück
begin
  result := V1;
  if Magnitude (V1) > Magnitude (V2) then
    result := V2;
end;
 
function MaxVector (V1, V2: TGLvector): TGLvector;
// gibt den Vector mit der größeren Länge zurück
begin
  result := V1;
  if Magnitude (V1) < Magnitude (V2) then
    result := V2;
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: GLdouble): 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: GLdouble): 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 im dreidimensionalen raum 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 Magnitude(X, Y: GLdouble): GLdouble;
var
  Ergebnis: GLdouble;
begin
  // gibt die länge des vektors im zweidimensionalen raum zurück
  Ergebnis := MyPower(X,2)+MyPower(Y,2);
  try
    result := sqrt(Ergebnis);
  except
    result := 0;
  end;
end;
 
function DotProduct (V1, V2: TGLVector): GLdouble;
// errechnet den winkel zwischen zwei vektoren
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
  // zum testen:
  InitVector (result, 0, 0, 0);
  // 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);
 
  result := Normalize (Kreuz);
end;
 
procedure InitVector (var V1: TGLVector; x, y, z: GLdouble);
begin
  V1.x := x;
  V1.y := y;
  V1.z := z;
end;
 
procedure InitVector (var V1: TGKVector; x, y, z: GLdouble);
begin
  V1.x := x;
  V1.y := y;
  V1.z := z;
end;
 
procedure InitVector (var V1: TArrVector; x, y, z: GLdouble);
begin
  V1[C_X] := x;
  V1[C_Y] := y;
  V1[C_Z] := z;
end;
 
procedure InitScale (var S1: TScale; x, y, z: GLdouble);
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: GLdouble;
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 (BitMap);  // wegen dem folgenden vergleich
 
  // suchen, ob die textur schon geladen wurde
  Laenge := length (BitmapList);
  if Laenge > 0 then
    for i := low (BitMapList) to high (BitMapList) do
    begin
      if (BitmapList[i].BitmapName = Bitmap) and
         //(glIsTexture (BitmapList[i].TextureNum)) then
         (BitmapList[i].TextureNum > 0) 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, decimals: byte): string;
const
  subdelim: char = '/';
var
  VTxt, frmt, sX, sY, sZ: string;
begin
  {
  VTxt := Format('%*.*f', [digits, decimals, V1.X]) + subdelim;
  VTxt := VTxt + Format('%*.*f', [digits, decimals, V1.Y]) + subdelim;
  VTxt := VTxt + Format('%*.*f', [digits, decimals, V1.Z]);
  }
  frmt := '%'+IntToStr(digits)+'.'+IntToStr(decimals)+'f';
 
  sX   := Format(frmt, [V1.X]);
  sY   := Format(frmt, [V1.Y]);
  sZ   := Format(frmt, [V1.Z]);
  //sX   := FloatToStrF(V1.X, fffixed, digits, decimals);
  //sY   := FloatToStrF(V1.Y, fffixed, digits, decimals);
  //sZ   := FloatToStrF(V1.Z, fffixed, digits, decimals);
 
  sX   := trim (sX);
  sY   := trim (sY);
  sZ   := trim (sZ);
 
  sX := CheckFormat (sX, digits, decimals);
  sY := CheckFormat (sY, digits, decimals);
  sZ := CheckFormat (sZ, digits, decimals);
 
  VTxt := sX + subdelim + sY + subdelim + sZ;
 
  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, decimals: byte): string;
const
  subdelim: char = '/';
var
  VTxt, frmt, sX, sY, sZ: string;
begin
  {
  VTxt := Format('%*.*f', [digits, decimals, V1.X]) + subdelim;
  VTxt := VTxt + Format('%*.*f', [digits, decimals, V1.Y]) + subdelim;
  VTxt := VTxt + Format('%*.*f', [digits, decimals, V1.Z]);
  }
  frmt := '%'+IntToStr(digits)+'.'+IntToStr(decimals)+'f';
 
  sX   := Format(frmt, [V1.X]);
  sY   := Format(frmt, [V1.Y]);
  sZ   := Format(frmt, [V1.Z]);
  //sX   := FloatToStrF(V1.X, fffixed, digits, decimals);
  //sY   := FloatToStrF(V1.Y, fffixed, digits, decimals);
  //sZ   := FloatToStrF(V1.Z, fffixed, digits, decimals);
 
 
  sX   := trim (sX);
  sY   := trim (sY);
  sZ   := trim (sZ);
 
  sX := CheckFormat (sX, digits, decimals);
  sY := CheckFormat (sY, digits, decimals);
  sZ := CheckFormat (sZ, digits, decimals);
 
  VTxt := sX + subdelim + sY + subdelim + sZ;
 
  result := VTxt;
end;
 
function MatrixToText (M: TArrMatrix): string;
const
  subdelim: char = '/';
var
  VTxt: string;
  i: integer;
begin
  VTxt := '';
  for i := low (M) to high(M) do
  begin
    VTxt := VTxt + Format('%14.6f', [M[i]]);
    if i < high (M) then
      VTxt := VTxt + subdelim;
  end;
 
  result := VTxt;
end;
 
function MyCone (Start, Ende: TGLVector;
                 RadiusStart, RadiusEnde: GLdouble;
                 Slices: integer; TileX, TileY: GLdouble): boolean;
var
  Slice: Integer;
  Laenge, xdelta, zdelta: GLdouble;
  V1, V2, V3, V4: TGLvector;
  A, B: double;
  //tmpVec: TGLvector;
begin
  result := true;
 
  // laenge des kegels berechnen
  // hierbei wird davon ausgegangen, dass der kegel senkrecht steht
  Laenge := Ende.y - Start.y;
 
  // die folgende längenberechnung stimmt nicht mit der senkrechten
  // verbindungslinie der beiden konusebenen überein, wenn die radien
  // sich unterscheiden, da sich dann ein schiefer vektor ergibt. der
  // ist natürlich länger als die senkrechte.
  //tmpVec := SubtractVector (Start, Ende);
  //Laenge := Magnitude (tmpVec);
 
  // radiusdifferenz der oberen und unteren ebene des konus 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;
  // immer ein dreieck an das andere: mit zwei punkten des oberen
  // radius und einem des unteren bzw. einem des oberen und zwei des
  // unteren ein dreieck zeichnen. mit dem nächsten neu errechneten punkt
  // und den zwei vorhergehenden haben wir immer das nächste dreieck.
  // so viele dreiecke wie pizzastücke (slices) gewünscht.
  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)+z