Kamera (3): Unterschied zwischen den Versionen
Aus DGL Wiki
Andyh (Diskussion | Beiträge) |
DGLBot (Diskussion | Beiträge) K (Der Ausdruck ''<pascal>(.*?)</pascal>'' wurde ersetzt mit ''<source lang="pascal">$1</source>''.) |
||
(3 dazwischenliegende Versionen von einem anderen Benutzer werden nicht angezeigt) | |||
Zeile 4: | Zeile 4: | ||
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... | 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... | ||
− | <pascal> | + | <source lang="pascal"> |
− | unit | + | {******************************************************************} |
+ | (* | ||
+ | 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 | interface | ||
− | uses DglOpenGL, Math, Windows, Graphics, SysUtils, Dialogs, glBmp; | + | uses DglOpenGL, Math, Windows, Graphics, SysUtils, Dialogs{, glBmp}; |
type | type | ||
Zeile 15: | Zeile 70: | ||
TGLPlace=packed record | TGLPlace=packed record | ||
− | X,Y,Z: | + | X,Y,Z: GLdouble; |
end; | end; | ||
TScale=packed record | TScale=packed record | ||
− | X,Y,Z: | + | X,Y,Z: GLdouble; |
end; | end; | ||
TGLPosition=packed record | TGLPosition=packed record | ||
− | X,Y,Z,W: | + | X,Y,Z,W: GLdouble; |
end; | end; | ||
Zeile 31: | Zeile 86: | ||
TGLVector = packed record | TGLVector = packed record | ||
− | X,Y,Z: | + | X,Y,Z: GLdouble; |
+ | end; | ||
+ | TPGLvector=^TGLvector; | ||
+ | |||
+ | TTextureCoord=record | ||
+ | X, Y, Z: GLdouble; | ||
end; | end; | ||
− | + | ||
− | TGLfloatArray = array of | + | TTextureCoordArray = array of TTextureCoord; |
+ | TGLvectorArray = array of TGLvector; | ||
+ | TGLdoubleArray = array of GLdouble; | ||
+ | TGLfloatArray = array of GLfloat; | ||
TGKVector = packed record | TGKVector = packed record | ||
− | X,Y,Z: | + | X,Y,Z: GLdouble; |
end; | end; | ||
Zeile 49: | Zeile 112: | ||
TRotation = packed record | TRotation = packed record | ||
− | angle, x, y, z: | + | angle, x, y, z: GLdouble; |
end; | end; | ||
Zeile 55: | Zeile 118: | ||
BitmapName: string; | BitmapName: string; | ||
TextureNum: GLUint; | TextureNum: GLUint; | ||
− | theBmp: TGLbmp; | + | //theBmp: TGLbmp; |
end; | end; | ||
TTextureList = array of TTextureInfo; | TTextureList = array of TTextureInfo; | ||
− | TMatrix = array [0..3,0..3] of | + | TMatrix = array [0..3,0..3] of GLdouble; |
− | TArrMatrix = array [0..15] of | + | TArrMatrix = array [0..15] of GLdouble; |
− | TFrustum = array [0..5,0..3] of | + | TFrustum = array [0..5,0..3] of GLdouble; |
− | TArrVector = array [0..3] of | + | TArrVector = array [0..3] of GLdouble; |
− | function Multiply (Color: TGLcolor; m: | + | 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 (V1, V2: TGLVector): TGLVector;overload; | ||
function Multiply (M1, M2: TArrMatrix): TArrMatrix;overload; | function Multiply (M1, M2: TArrMatrix): TArrMatrix;overload; | ||
function Divide (V1, V2: TGLVector): TGLVector;overload; | function Divide (V1, V2: TGLVector): TGLVector;overload; | ||
− | function Divide (V1: TGLVector; d: | + | function Divide (V1: TGLVector; d: GLdouble): TGLVector;overload; |
− | function MakeVector(X,Y,Z: | + | function MakeVector(X,Y,Z:GLdouble):TArrVector;overload; |
− | function MakeVector(X,Y,Z,W: | + | 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:TMatrix):TMatrix;overload; | ||
function GetIdentity(Matrix:TArrMatrix):TArrMatrix;overload; | function GetIdentity(Matrix:TArrMatrix):TArrMatrix;overload; | ||
function MatrixTranspose(const M:TMatrix):TMatrix;register; | function MatrixTranspose(const M:TMatrix):TMatrix;register; | ||
− | function VectorRotateX(v:TArrVector;a: | + | function NearestPoint(Axis, Point: TGLVector): TGLVector; |
− | function VectorRotateY(v:TArrVector;a: | + | function VectorRotateX(v:TArrVector;a:GLdouble):TArrVector;overload; |
− | function VectorRotateZ(v:TArrVector;a: | + | function VectorRotateY(v:TArrVector;a:GLdouble):TArrVector;overload; |
− | function VectorRotateX(v:TGLVector;a: | + | function VectorRotateZ(v:TArrVector;a:GLdouble):TArrVector;overload; |
− | function VectorRotateY(v:TGLVector;a: | + | function VectorRotateX(v:TGLVector;a:GLdouble):TGLVector;overload; |
− | function VectorRotateZ(v:TGLVector;a: | + | 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 GL2GKVector (V: TGLVector): TGKVector; | ||
Zeile 91: | Zeile 173: | ||
function DotProduct (V1, V2: TGLVector): GLdouble; | function DotProduct (V1, V2: TGLVector): GLdouble; | ||
function LoadTexture(Filename: String; var Texture: GLuint): Boolean; | function LoadTexture(Filename: String; var Texture: GLuint): Boolean; | ||
− | function Magnitude(V1 : TGLVector) : GLdouble; | + | function Magnitude(V1: TGLVector): GLdouble;overload; |
+ | function Magnitude(X, Y: GLdouble): GLdouble;overload; | ||
function ScalarProduct (V1, V2: TGLVector): GLdouble; | 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 (Vec1, Vec2: TGLVector): TGLVector;overload; | ||
− | function SubtractVector (Vec: TGLVector; X, Y, Z: | + | function SubtractVector (Vec: TGLVector; X, Y, Z: GLdouble): TGLVector;overload; |
function AddVector (Vec1, Vec2: TGLVector): TGLVector;overload; | function AddVector (Vec1, Vec2: TGLVector): TGLVector;overload; | ||
− | function AddVector (Vec: TGLVector; X, Y, Z: | + | function AddVector (Vec: TGLVector; X, Y, Z: GLdouble): TGLVector;overload; |
function ForceForegroundWindow(hwnd: THandle): Boolean; | 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 CopyVector (FromVektor: TGLVector; var ToVektor: TGLVector); | ||
− | procedure InitVector (var V1: TGLVector; x, y, z: | + | procedure InitVector (var V1: TGLVector; x, y, z: GLdouble);overload; |
− | procedure InitVector (var V1: TGKVector; x, y, z: | + | procedure InitVector (var V1: TGKVector; x, y, z: GLdouble);overload; |
− | procedure InitVector (var V1: TArrVector; x, y, z: | + | procedure InitVector (var V1: TArrVector; x, y, z: GLdouble);overload; |
− | procedure InitScale (var S1: TScale; x, y, z: | + | procedure InitScale (var S1: TScale; x, y, z: GLdouble); |
procedure LoadBitmap(Filename: String; | procedure LoadBitmap(Filename: String; | ||
out Width: Cardinal; | out Width: Cardinal; | ||
Zeile 108: | Zeile 196: | ||
out pData: Pointer); | out pData: Pointer); | ||
procedure GetRotation (V1, V2: TGLVector; | procedure GetRotation (V1, V2: TGLVector; | ||
− | var Rotation: TRotation | + | var Rotation: TRotation); |
− | + | function MakeTextureFromBitmap (Bitmap: string; | |
− | function MakeTextureFromBitmap (Bitmap: string; var BitmapList: TTextureList): GLenum; | + | var BitmapList: TTextureList): GLenum; |
procedure EnableTexture (Texture: GLenum; TextureTiled: boolean); | procedure EnableTexture (Texture: GLenum; TextureTiled: boolean); | ||
procedure DisableTexture; | procedure DisableTexture; | ||
Zeile 116: | Zeile 204: | ||
function TextToGKVector (VTxt: string): TGKVector; | function TextToGKVector (VTxt: string): TGKVector; | ||
function GKVectorToText (V1: TGKVector): string;overload; | function GKVectorToText (V1: TGKVector): string;overload; | ||
− | function GKVectorToText (V1: TGKVector; digits: byte): string;overload; | + | function GKVectorToText (V1: TGKVector; digits, decimals: byte): string;overload; |
function GLVectorToText (V1: TGLVector): string;overload; | function GLVectorToText (V1: TGLVector): string;overload; | ||
− | function GLVectorToText (V1: TGLVector; digits: byte): 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; | function MyCone (Start, Ende: TGLVector; | ||
− | RadiusStart, RadiusEnde: | + | RadiusStart, RadiusEnde: GLdouble; |
− | Slices: | + | Slices: integer; TileX, TileY: GLdouble): boolean; |
function InvertMatrix (src: TArrMatrix; var inverse: TArrMatrix): boolean; | function InvertMatrix (src: TArrMatrix; var inverse: TArrMatrix): boolean; | ||
+ | function ExePath: string; | ||
const | const | ||
Zeile 129: | Zeile 220: | ||
C_Z = 2; | C_Z = 2; | ||
C_W = 3; | C_W = 3; | ||
− | C_EPS: | + | C_EPS:GLdouble=0.01; |
− | C_DEGTORAD: | + | C_DEGTORAD:GLdouble=3.1412/180; |
− | C_RADTODEG: | + | C_RADTODEG:GLdouble=180/3.1412; |
− | C_LAMBDA_INCREMENT: | + | C_LAMBDA_INCREMENT:GLdouble=0.01; |
− | + | C_PI=3.1415926535; | |
+ | C_PI_DIV_180=C_PI/180; | ||
implementation | implementation | ||
− | uses Forms, KanalUtil; | + | uses Forms, {KanalUtil,} OGLinclude, Controls; |
function MyPower (Base: extended; Exp: integer): extended; | function MyPower (Base: extended; Exp: integer): extended; | ||
− | // | + | //var |
+ | // i: integer; | ||
begin | begin | ||
+ | // result := Base; | ||
+ | // for i := 2 to Exp do | ||
+ | // result := result * Base; | ||
+ | |||
result := Base * Base; | result := Base * Base; | ||
end; | end; | ||
Zeile 150: | Zeile 247: | ||
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; | ||
+ | |||
+ | 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; | end; | ||
Zeile 163: | Zeile 340: | ||
end; | end; | ||
− | function SubtractVector (Vec: TGLVector; X, Y, Z: | + | function SubtractVector (Vec: TGLVector; X, Y, Z: GLdouble): TGLVector; |
// subtrahiert X, Y, Z von vec.x, vec.y, vec.z und gibt das | // subtrahiert X, Y, Z von vec.x, vec.y, vec.z und gibt das | ||
// ergebnis zurück | // ergebnis zurück | ||
Zeile 184: | Zeile 361: | ||
end; | end; | ||
− | function AddVector (Vec: TGLVector; X, Y, Z: | + | function AddVector (Vec: TGLVector; X, Y, Z: GLdouble): TGLVector; |
// addiert X, Y, Z auf vec.x, vec.y, vec.z und gibt das | // addiert X, Y, Z auf vec.x, vec.y, vec.z und gibt das | ||
// ergebnis zurück | // ergebnis zurück | ||
Zeile 194: | Zeile 371: | ||
end; | end; | ||
− | function Magnitude(V1 : TGLVector) : GLdouble; | + | function Magnitude(V1: TGLVector): GLdouble; |
var | var | ||
Ergebnis: GLdouble; | Ergebnis: GLdouble; | ||
begin | begin | ||
− | // gibt die länge des vektors zurück | + | // gibt die länge des vektors im dreidimensionalen raum zurück |
Ergebnis := MyPower(V1.X,2)+MyPower(V1.Y,2)+MyPower(V1.Z,2); | 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 | try | ||
result := sqrt(Ergebnis); | result := sqrt(Ergebnis); | ||
Zeile 208: | Zeile 398: | ||
function DotProduct (V1, V2: TGLVector): GLdouble; | function DotProduct (V1, V2: TGLVector): GLdouble; | ||
+ | // errechnet den winkel zwischen zwei vektoren | ||
var | var | ||
len1, len2: GLdouble; | len1, len2: GLdouble; | ||
Zeile 239: | Zeile 430: | ||
V1V2, V1V3: TGLvector; | V1V2, V1V3: TGLvector; | ||
begin | begin | ||
+ | // zum testen: | ||
+ | InitVector (result, 0, 0, 0); | ||
// gibt die normale von 3 vektoren zurück (die senkrechte auf die | // gibt die normale von 3 vektoren zurück (die senkrechte auf die | ||
// durch die drei vektoren gebildete ebene) | // durch die drei vektoren gebildete ebene) | ||
Zeile 246: | Zeile 439: | ||
Kreuz := CrossProduct (V1V2, V1V3); | Kreuz := CrossProduct (V1V2, V1V3); | ||
− | Normalize (Kreuz | + | result := Normalize (Kreuz); |
end; | end; | ||
− | procedure InitVector (var V1: TGLVector; x, y, z: | + | procedure InitVector (var V1: TGLVector; x, y, z: GLdouble); |
begin | begin | ||
V1.x := x; | V1.x := x; | ||
Zeile 256: | Zeile 449: | ||
end; | end; | ||
− | procedure InitVector (var V1: TGKVector; x, y, z: | + | procedure InitVector (var V1: TGKVector; x, y, z: GLdouble); |
begin | begin | ||
V1.x := x; | V1.x := x; | ||
Zeile 263: | Zeile 456: | ||
end; | end; | ||
− | procedure InitVector (var V1: TArrVector; x, y, z: | + | procedure InitVector (var V1: TArrVector; x, y, z: GLdouble); |
begin | begin | ||
V1[C_X] := x; | V1[C_X] := x; | ||
Zeile 270: | Zeile 463: | ||
end; | end; | ||
− | procedure InitScale (var S1: TScale; x, y, z: | + | procedure InitScale (var S1: TScale; x, y, z: GLdouble); |
begin | begin | ||
S1.x := x; | S1.x := x; | ||
Zeile 308: | Zeile 501: | ||
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 518: | ||
begin | begin | ||
Result := False; | Result := False; | ||
− | MessageBox(0, PChar( | + | MessageBox(0, PChar(Res_LoadUnable + filename), |
+ | pchar (Res_LoadingTex), MB_OK); | ||
exit; | exit; | ||
end; | end; | ||
− | glGenTextures(1, @ | + | glGenTextures(1, @NewTexture); |
− | glBindTexture(GL_TEXTURE_2D, | + | 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 531: | ||
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 539: | ||
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 559: | ||
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( | + | MessageBox(0, PChar(Res_OpenErr+Filename), PChar(Res_BmpUnit), MB_OK); |
Exit; | Exit; | ||
end; | end; | ||
Zeile 367: | Zeile 572: | ||
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( | + | MessageBox(0, PChar(Res_ReadErr), PChar(Res_BmpUnit), MB_OK); |
CloseHandle(BitmapFile); | CloseHandle(BitmapFile); | ||
Exit; | Exit; | ||
Zeile 382: | Zeile 587: | ||
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( | + | MessageBox(0, PChar(Res_BitmapDataErr), PChar(Res_BmpUnit), MB_OK); |
CloseHandle(BitmapFile); | CloseHandle(BitmapFile); | ||
Exit; | Exit; | ||
Zeile 431: | Zeile 636: | ||
procedure GetRotation (V1, V2: TGLVector; | procedure GetRotation (V1, V2: TGLVector; | ||
− | var Rotation: TRotation | + | var Rotation: TRotation); |
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
− | |||
var | var | ||
tmpCyl, tmpZiel, nullVec: TGLVector; | tmpCyl, tmpZiel, nullVec: TGLVector; | ||
− | ResultLen: TGLVector; | + | normale, ResultLen: TGLVector; |
− | VectorLength: | + | VectorLength: GLdouble; |
begin | begin | ||
// temporäre vektoren initialisieren | // temporäre vektoren initialisieren | ||
Zeile 475: | Zeile 669: | ||
end; | end; | ||
− | function MakeTextureFromBitmap (Bitmap: string; var BitmapList: TTextureList): GLenum; | + | function MakeTextureFromBitmap (Bitmap: string; |
+ | var BitmapList: TTextureList): GLenum; | ||
// die funktion lädt die in Bitmap übergebene Grafik und gibt die Textturnummer | // 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 | // 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; | ||
− | |||
begin | begin | ||
result := 0; | result := 0; | ||
if length (trim (Bitmap)) = 0 then | if length (trim (Bitmap)) = 0 then | ||
exit; | exit; | ||
− | + | ||
− | + | BitMap := uppercase (BitMap); // wegen dem folgenden vergleich | |
+ | |||
// suchen, ob die textur schon geladen wurde | // suchen, ob die textur schon geladen wurde | ||
Laenge := length (BitmapList); | Laenge := length (BitmapList); | ||
if Laenge > 0 then | if Laenge > 0 then | ||
− | for i := | + | for i := low (BitMapList) to high (BitMapList) do |
begin | begin | ||
if (BitmapList[i].BitmapName = Bitmap) and | if (BitmapList[i].BitmapName = Bitmap) and | ||
− | ( | + | //(glIsTexture (BitmapList[i].TextureNum)) then |
+ | (BitmapList[i].TextureNum > 0) 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 503: | Zeile 712: | ||
BitmapList[Laenge].BitmapName := Bitmap; | BitmapList[Laenge].BitmapName := Bitmap; | ||
BitmapList[Laenge].TextureNum := 0; | BitmapList[Laenge].TextureNum := 0; | ||
+ | { | ||
BitMapList[Laenge].theBmp := TglBmp.Create; | BitMapList[Laenge].theBmp := TglBmp.Create; | ||
if BitMapList[Laenge].theBmp.LoadImage (BitMap) then | if BitMapList[Laenge].theBmp.LoadImage (BitMap) then | ||
Zeile 509: | Zeile 719: | ||
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 := | + | BitmapList[Laenge].TextureNum := BitmapList[Laenge].theBmp.TextureID; |
end; | end; | ||
+ | } | ||
end; | end; | ||
end; | end; | ||
Zeile 599: | Zeile 810: | ||
end; | end; | ||
− | function GKVectorToText (V1: TGKVector; digits: byte): string; | + | function GKVectorToText (V1: TGKVector; digits, decimals: byte): string; |
const | const | ||
subdelim: char = '/'; | subdelim: char = '/'; | ||
var | var | ||
− | VTxt: string; | + | VTxt, frmt, sX, sY, sZ: string; |
begin | begin | ||
− | VTxt := Format('%*.*f', [digits | + | { |
− | VTxt := VTxt + Format('%*.*f', [digits | + | VTxt := Format('%*.*f', [digits, decimals, V1.X]) + subdelim; |
− | VTxt := VTxt + Format('%*.*f', [digits+ | + | 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; | result := VTxt; | ||
end; | end; | ||
Zeile 623: | Zeile 855: | ||
end; | end; | ||
− | function GLVectorToText (V1: TGLVector; digits: byte): string; | + | 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 | const | ||
subdelim: char = '/'; | subdelim: char = '/'; | ||
var | var | ||
VTxt: string; | VTxt: string; | ||
+ | i: integer; | ||
begin | begin | ||
− | VTxt := | + | VTxt := ''; |
− | VTxt := VTxt + Format('% | + | 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; | result := VTxt; | ||
end; | end; | ||
function MyCone (Start, Ende: TGLVector; | function MyCone (Start, Ende: TGLVector; | ||
− | RadiusStart, RadiusEnde: | + | RadiusStart, RadiusEnde: GLdouble; |
− | Slices: | + | Slices: integer; TileX, TileY: GLdouble): boolean; |
var | var | ||
Slice: Integer; | Slice: Integer; | ||
− | Laenge, xdelta, zdelta: | + | Laenge, xdelta, zdelta: GLdouble; |
V1, V2, V3, V4: TGLvector; | V1, V2, V3, V4: TGLvector; | ||
− | A, B: | + | A, B: double; |
− | tmpVec: TGLvector; | + | //tmpVec: TGLvector; |
begin | begin | ||
result := true; | result := true; | ||
+ | |||
// laenge des kegels berechnen | // laenge des kegels berechnen | ||
// hierbei wird davon ausgegangen, dass der kegel senkrecht steht | // hierbei wird davon ausgegangen, dass der kegel senkrecht steht | ||
− | + | Laenge := Ende.y - Start.y; | |
− | tmpVec := SubtractVector (Start, Ende); | + | |
− | Laenge := Magnitude (tmpVec); | + | // die folgende längenberechnung stimmt nicht mit der senkrechten |
− | // radiusdifferenz berechnen | + | // 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; | xdelta := Start.x - Ende.x; | ||
zdelta := Start.z - Ende.z; | zdelta := Start.z - Ende.z; | ||
xdelta := -xdelta; | xdelta := -xdelta; | ||
//zdelta := zdelta; | //zdelta := zdelta; | ||
+ | |||
glBegin (GL_TRIANGLE_STRIP); | glBegin (GL_TRIANGLE_STRIP); | ||
// der kegel wird entlang der z-achse gezeichnet | // der kegel wird entlang der z-achse gezeichnet | ||
Zeile 662: | Zeile 942: | ||
V3.z := Laenge; | V3.z := Laenge; | ||
V4.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 | for Slice := 1 to Slices do begin | ||
A := 2 * PI * Slice / Slices; | A := 2 * PI * Slice / Slices; | ||
Zeile 678: | Zeile 963: | ||
if Slice = 1 then | if Slice = 1 then | ||
begin | begin | ||
− | + | glTexCoord2d(1*TileX,0); glVertex3dv(@V1); | |
− | + | glTexCoord2d(1*TileX,1*TileY); glVertex3dv(@V4); | |
− | + | glTexCoord2d(1*TileX-Slice/Slices*TileX,0); glVertex3dv(@V2); | |
− | + | glTexCoord2d(1*TileX-Slice/Slices*TileX,1*TileY); glVertex3dv(@V3); | |
end | end | ||
else | else | ||
begin | begin | ||
− | + | glTexCoord2d(1*TileX-Slice/Slices*TileX,0); glVertex3dv(@V2); | |
− | + | glTexCoord2d(1*TileX-Slice/Slices*TileX,1*TileX); glVertex3dv(@V3); | |
end; | end; | ||
+ | // so hatte ich mir das zuerst gedacht: | ||
// aktuellen und nächsten punkt des kreises (oben und unten) | // aktuellen und nächsten punkt des kreises (oben und unten) | ||
// nehmen und ein rechteck zeichnen. alle rechtecke zusammen sollten | // nehmen und ein rechteck zeichnen. alle rechtecke zusammen sollten | ||
// einen geschlossenen kegel ergeben. | // einen geschlossenen kegel ergeben. | ||
//glBegin(GL_QUADS); | //glBegin(GL_QUADS); | ||
− | // | + | // glNormal3dv(@Normale); |
− | // | + | // glTexCoord2d(0,0); glVertex3dv(@V2); |
− | // | + | // glTexCoord2d(1,0); glVertex3dv(@V1); |
− | // | + | // glTexCoord2d(1,1); glVertex3dv(@V4); |
− | // | + | // glTexCoord2d(0,1); glVertex3dv(@V3); |
//glEnd; | //glEnd; | ||
end; | end; | ||
Zeile 712: | Zeile 998: | ||
begin | begin | ||
glPushMatrix(); | glPushMatrix(); | ||
− | + | glLoadMatrixd(@M1); | |
− | + | glMultMatrixd(@M2); | |
− | + | glGetDoublev(GL_MODELVIEW_MATRIX,@ret); | |
glPopMatrix(); | glPopMatrix(); | ||
result := ret; | result := ret; | ||
end; | end; | ||
− | function MakeVector(X,Y,Z: | + | function MakeVector(X,Y,Z:GLdouble):TArrVector; |
begin | begin | ||
result[0]:=x; | result[0]:=x; | ||
Zeile 726: | Zeile 1.012: | ||
end; | end; | ||
− | function MakeVector(X,Y,Z,W: | + | function MakeVector(X,Y,Z,W:GLdouble):TArrVector; |
begin | begin | ||
result[0]:=x; | result[0]:=x; | ||
Zeile 734: | Zeile 1.020: | ||
end; | end; | ||
− | + | function Normalize(aVector:TArrVector):TArrVector;overload; | |
var | var | ||
d:double; | d:double; | ||
begin | begin | ||
− | InitVector ( | + | InitVector (result,1,1,1); |
d:=Sqrt(Sqr(aVector[C_X])+Sqr(aVector[C_Y])+Sqr(aVector[C_Z])); | d:=Sqrt(Sqr(aVector[C_X])+Sqr(aVector[C_Y])+Sqr(aVector[C_Z])); | ||
if d=0 then | if d=0 then | ||
Zeile 745: | Zeile 1.031: | ||
exit; | exit; | ||
end; | end; | ||
− | + | result[C_X]:=aVector[C_X]/d; | |
− | + | result[C_Y]:=aVector[C_Y]/d; | |
− | + | result[C_Z]:=aVector[C_Z]/d; | |
end; | end; | ||
− | + | function Normalize(aVector:TGLVector):TGLVector;overload; | |
var | var | ||
d:double; | d:double; | ||
begin | begin | ||
− | InitVector ( | + | InitVector (result,1,1,1); |
d:=Sqrt(Sqr(aVector.X)+Sqr(aVector.Y)+Sqr(aVector.Z)); | d:=Sqrt(Sqr(aVector.X)+Sqr(aVector.Y)+Sqr(aVector.Z)); | ||
if d=0 then | if d=0 then | ||
Zeile 761: | Zeile 1.047: | ||
exit; | exit; | ||
end; | end; | ||
− | + | result.X:=aVector.X/d; | |
− | + | result.Y:=aVector.Y/d; | |
− | + | result.Z:=aVector.Z/d; | |
end; | end; | ||
Zeile 791: | Zeile 1.077: | ||
end; | end; | ||
− | function VectorRotateX(v:TArrVector;a: | + | function VectorRotateX(v:TArrVector;a:GLdouble):TArrVector; |
var | var | ||
temp: TArrVector; | temp: TArrVector; | ||
− | sine,cosine: | + | sine,cosine:GLdouble; |
begin | begin | ||
a:=a*C_DEGTORAD; | a:=a*C_DEGTORAD; | ||
Zeile 806: | Zeile 1.092: | ||
end; | end; | ||
− | function VectorRotateY(v: TArrVector;a: | + | function VectorRotateY(v: TArrVector;a:GLdouble):TArrVector; |
var | var | ||
− | + | temp: TArrVector; | |
− | + | sine,cosine:GLdouble; | |
begin | 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; | end; | ||
− | function VectorRotateZ(v: TArrVector; a: | + | function VectorRotateZ(v: TArrVector; a: GLdouble):TArrVector; |
var | var | ||
temp: TArrVector; | temp: TArrVector; | ||
− | + | sine,cosine:GLdouble; | |
begin | 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; | end; | ||
− | function VectorRotateX(v:TGLVector;a: | + | function VectorRotateX(v:TGLVector;a:GLdouble):TGLVector; |
var | var | ||
− | + | temp: TGLVector; | |
− | + | sine,cosine:GLdouble; | |
begin | 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; | end; | ||
− | function VectorRotateY(v: TGLVector;a: | + | function VectorRotateY(v: TGLVector;a:GLdouble):TGLVector; |
var | var | ||
− | + | temp: TGLVector; | |
− | + | sine,cosine:GLdouble; | |
begin | 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; | end; | ||
− | function VectorRotateZ(v: TGLVector; a: | + | function VectorRotateZ(v: TGLVector; a: GLdouble):TGLVector; |
var | var | ||
temp: TGLVector; | temp: TGLVector; | ||
− | + | sine,cosine:GLdouble; | |
+ | 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; | ||
+ | |||
+ | function VectorRotateX(v,c: TGLvector;a: GLdouble):TGLVector; | ||
+ | // v: zu drehender punkt | ||
+ | // c: zentrum | ||
+ | // a: winkel | ||
+ | var | ||
+ | temp, temp2: TGLVector; | ||
+ | begin | ||
+ | // das übergebene zentrum in den nullpunkt holen | ||
+ | temp2 := SubtractVector (v, c); | ||
+ | |||
+ | // jetzt so drehen, als ob alles um den nullpunkt angeordnet wäre | ||
+ | temp := VectorRotateX (temp2, a); | ||
+ | |||
+ | // und das ergebnis wieder in den ausgangspunkt zurück verschieben | ||
+ | result := AddVector (temp, c); | ||
+ | end; | ||
+ | |||
+ | function VectorRotateY(v,c: TGLvector;a: GLdouble):TGLVector; | ||
+ | // v: zu drehender punkt | ||
+ | // c: zentrum | ||
+ | // a: winkel | ||
+ | var | ||
+ | temp, temp2: TGLVector; | ||
begin | begin | ||
− | + | // das übergebene zentrum in den nullpunkt holen | |
− | + | temp2 := SubtractVector (v, c); | |
− | + | ||
− | + | // jetzt so drehen, als ob alles um den nullpunkt angeordnet wäre | |
− | + | temp := VectorRotateY (temp2, a); | |
− | + | ||
− | + | // und das ergebnis wieder in den ausgangspunkt zurück verschieben | |
+ | result := AddVector (temp, c); | ||
+ | end; | ||
+ | |||
+ | function VectorRotateZ(v,c: TGLvector; a: GLdouble):TGLVector; | ||
+ | // v: zu drehender punkt | ||
+ | // c: zentrum | ||
+ | // a: winkel | ||
+ | var | ||
+ | temp, temp2: TGLVector; | ||
+ | begin | ||
+ | // das übergebene zentrum in den nullpunkt holen | ||
+ | temp2 := SubtractVector (v, c); | ||
+ | |||
+ | // jetzt so drehen, als ob alles um den nullpunkt angeordnet wäre | ||
+ | temp := VectorRotateZ (temp2, a); | ||
+ | |||
+ | // und das ergebnis wieder in den ausgangspunkt zurück verschieben | ||
+ | result := AddVector (temp, c); | ||
+ | end; | ||
+ | |||
+ | function VectorRotateX(v1,v2,v3,v4:TGLVector;a:GLdouble):TGLVector; | ||
+ | // v1: zu drehender punkt | ||
+ | // v2, v3, v4: vektoren die zusammen mit v1 eine fläche beschreiben, | ||
+ | // durch welche die drehachse läuft. | ||
+ | // a: drehwinkel | ||
+ | var | ||
+ | PlaneVec, PlaneCenter: TGLvector; | ||
+ | begin | ||
+ | // zuerst das zentrum der vektoren herausfinden | ||
+ | PlaneCenter.X := (v1.X+v2.X+v3.X+v4.X) / 4; | ||
+ | PlaneCenter.Y := (v1.Y+v2.Y+v3.Y+v4.Y) / 4; | ||
+ | PlaneCenter.Z := (v1.Z+v2.Z+v3.Z+v4.Z) / 4; | ||
+ | |||
+ | // den zu drehenden vector in den nullpunkt holen | ||
+ | PlaneVec := SubtractVector (v1, PlaneCenter); | ||
+ | |||
+ | // jetzt um die gewünschte achse drehen | ||
+ | PlaneVec := VectorRotateX (PlaneVec, a); | ||
+ | |||
+ | // die drehung auf den eigentlichen vector aufaddieren | ||
+ | // und zurückgeben | ||
+ | result := AddVector (PlaneVec, PlaneCenter); | ||
+ | |||
+ | result := VectorRotateX (v1, PlaneCenter, a); | ||
+ | end; | ||
+ | |||
+ | function VectorRotateY(v1,v2,v3,v4:TGLvector;a:GLdouble):TGLVector; | ||
+ | // v: zu drehender punkt | ||
+ | // v2, v3, v4: vektoren die zusammen mit v1 eine fläche beschreiben, | ||
+ | // durch welche die drehachse läuft. | ||
+ | // a: drehwinkel | ||
+ | var | ||
+ | PlaneVec, PlaneCenter: TGLvector; | ||
+ | begin | ||
+ | // zuerst das zentrum der vektoren herausfinden | ||
+ | PlaneCenter.X := (v1.X+v2.X+v3.X+v4.X) / 4; | ||
+ | PlaneCenter.Y := (v1.Y+v2.Y+v3.Y+v4.Y) / 4; | ||
+ | PlaneCenter.Z := (v1.Z+v2.Z+v3.Z+v4.Z) / 4; | ||
+ | |||
+ | // den zu drehenden vector in den nullpunkt holen | ||
+ | PlaneVec := SubtractVector (v1, PlaneCenter); | ||
+ | |||
+ | // jetzt um die gewünschte achse drehen | ||
+ | PlaneVec := VectorRotateY (PlaneVec, a); | ||
+ | |||
+ | // die drehung auf den eigentlichen vector aufaddieren | ||
+ | // und zurückgeben | ||
+ | result := AddVector (PlaneVec, PlaneCenter); | ||
+ | |||
+ | result := VectorRotateY (v1, PlaneCenter, a); | ||
+ | end; | ||
+ | |||
+ | function VectorRotateZ(v1,v2,v3,v4:TGLvector;a:GLdouble):TGLVector; | ||
+ | // v: zu drehender punkt | ||
+ | // v2, v3, v4: vektoren die zusammen mit v1 eine fläche beschreiben, | ||
+ | // durch welche die drehachse läuft. | ||
+ | // a: drehwinkel | ||
+ | var | ||
+ | PlaneVec, PlaneCenter: TGLvector; | ||
+ | begin | ||
+ | // zuerst das zentrum der vektoren herausfinden | ||
+ | PlaneCenter.X := (v1.X+v2.X+v3.X+v4.X) / 4; | ||
+ | PlaneCenter.Y := (v1.Y+v2.Y+v3.Y+v4.Y) / 4; | ||
+ | PlaneCenter.Z := (v1.Z+v2.Z+v3.Z+v4.Z) / 4; | ||
+ | |||
+ | // den zu drehenden vector in den nullpunkt holen | ||
+ | PlaneVec := SubtractVector (v1, PlaneCenter); | ||
+ | |||
+ | // jetzt um die gewünschte achse drehen | ||
+ | PlaneVec := VectorRotateZ (PlaneVec, a); | ||
+ | |||
+ | // die drehung auf den eigentlichen vector aufaddieren | ||
+ | // und zurückgeben | ||
+ | result := AddVector (PlaneVec, PlaneCenter); | ||
+ | |||
+ | result := VectorRotateZ (v1, PlaneCenter, a); | ||
+ | end; | ||
+ | |||
+ | { Finds the point on the axis, closest to the | ||
+ | source vector } | ||
+ | function NearestPoint(Axis, Point: TGLVector): TGLVector; | ||
+ | var | ||
+ | temp: double; | ||
+ | begin | ||
+ | temp := DotProduct(Axis, Point) / DotProduct(Axis, Axis); | ||
+ | Axis.X := Axis.X * temp; | ||
+ | Axis.Y := Axis.Y * temp; | ||
+ | Axis.Z := Axis.Z * temp; | ||
+ | Result := Axis; | ||
end; | end; | ||
Zeile 885: | Zeile 1.315: | ||
function InvertMatrix (src: TArrMatrix; var inverse: TArrMatrix): boolean; | function InvertMatrix (src: TArrMatrix; var inverse: TArrMatrix): boolean; | ||
var | var | ||
− | t: | + | t: GLdouble; |
i, j, k, swap: integer; | i, j, k, swap: integer; | ||
tmp: TMatrix; | tmp: TMatrix; | ||
Zeile 958: | Zeile 1.388: | ||
end; | end; | ||
− | function Multiply (Color: TGLcolor; m: | + | function Multiply (Color: TGLcolor; m: GLdouble): TGLcolor; |
var | var | ||
ret: TGLcolor; | ret: TGLcolor; | ||
Zeile 968: | Zeile 1.398: | ||
end; | end; | ||
− | function Divide (V1: TGLvector; d: | + | function Divide (V1: TGLvector; d: GLdouble): TGLvector; |
var | var | ||
ret: TGLvector; | ret: TGLvector; | ||
Zeile 1.043: | Zeile 1.473: | ||
end; { ForceForegroundWindow } | end; { ForceForegroundWindow } | ||
− | end.</ | + | 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; | ||
+ | |||
+ | function CheckFormat (number: string; digits, decimals: byte): string; | ||
+ | // wandelt ein mögliches dezimalkomma in einen punkt um | ||
+ | // beschneidet den übergebenen zahlenstring auf die gewünschten | ||
+ | // vorkomma- und nachkommastellen | ||
+ | // der übergebene zahlenstring darf keine tausender-kommas | ||
+ | // oder punkte enthalten! | ||
+ | var | ||
+ | sdigits, sdecimals, temp: string; | ||
+ | posi: integer; | ||
+ | begin | ||
+ | if digits+decimals = 0 then | ||
+ | begin | ||
+ | temp := ''; | ||
+ | end | ||
+ | else | ||
+ | begin | ||
+ | sdigits := ''; | ||
+ | sdecimals := ''; | ||
+ | posi := pos (',', number); | ||
+ | if posi = 0 then | ||
+ | posi := pos ('.', number); | ||
+ | if posi > 0 then | ||
+ | sdigits := copy (number, 1, posi-1); | ||
+ | if length (number) > posi then | ||
+ | sdecimals := copy (number, posi+1); | ||
+ | if length (sdigits) > digits then | ||
+ | sdigits := copy (sdigits, length (sdigits)-(digits-1)); | ||
+ | if length (sdecimals) > decimals then | ||
+ | sdecimals := copy (sdecimals, 1, decimals); | ||
+ | temp := sdigits + '.' + sdecimals; | ||
+ | end; | ||
+ | result := temp; | ||
+ | end; | ||
+ | |||
+ | procedure ResetGLErrorFlags; | ||
+ | var | ||
+ | err: GLenum; | ||
+ | begin | ||
+ | repeat | ||
+ | err := glGetError; | ||
+ | until err = GL_NO_ERROR; | ||
+ | end; | ||
+ | |||
+ | function ValidTexture (tex: GLUint; ErrStr: string): boolean; | ||
+ | var | ||
+ | error: GLenum; | ||
+ | begin | ||
+ | result := true; | ||
+ | |||
+ | ResetGLErrorFlags; | ||
+ | if not glIsTexture (tex) then | ||
+ | begin | ||
+ | error := glGetError; | ||
+ | Application.MessageBox(pChar ('Textur wurde nicht erkannt!'+chr(13)+chr(10)+ | ||
+ | ErrStr+chr(13)+chr(10)+ | ||
+ | 'Fehler: '+IntToStr (error)), | ||
+ | 'Fehler', | ||
+ | 0); | ||
+ | result := false; | ||
+ | end; | ||
+ | end; | ||
+ | |||
+ | function AxisXRotation (V1, V2: TGLvector): GLdouble; | ||
+ | begin | ||
+ | V1.Z := 0; | ||
+ | V2.Z := 0; | ||
+ | result := DotProduct (V1, V2); | ||
+ | end; | ||
+ | |||
+ | function AxisYRotation (V1, V2: TGLvector): GLdouble; | ||
+ | begin | ||
+ | V1.Z := 0; | ||
+ | V2.Z := 0; | ||
+ | result := DotProduct (V1, V2); | ||
+ | end; | ||
+ | |||
+ | function AxisZRotation (V1, V2: TGLvector): GLdouble; | ||
+ | begin | ||
+ | V1.Y := 0; | ||
+ | V2.Y := 0; | ||
+ | result := DotProduct (V1, V2); | ||
+ | end; | ||
+ | |||
+ | function ExePath: string; | ||
+ | var | ||
+ | pfad: string; | ||
+ | begin | ||
+ | pfad := ExtractFilePath (Application.Exename); | ||
+ | if copy (pfad, length (pfad), 1) <> '\' then | ||
+ | pfad := pfad + '\'; | ||
+ | result := pfad; | ||
+ | end; | ||
+ | |||
+ | end. | ||
+ | </source> | ||
[[Kategorie:Anleitung]] | [[Kategorie:Anleitung]] |
Aktuelle Version vom 10. März 2009, 19:06 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...
{******************************************************************}
(*
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)+zdelta;
//Normale := CalcNormale (V1, V3, V2);
//glNormal3fv(@Normale);
if Slice = 1 then
begin
glTexCoord2d(1*TileX,0); glVertex3dv(@V1);
glTexCoord2d(1*TileX,1*TileY); glVertex3dv(@V4);
glTexCoord2d(1*TileX-Slice/Slices*TileX,0); glVertex3dv(@V2);
glTexCoord2d(1*TileX-Slice/Slices*TileX,1*TileY); glVertex3dv(@V3);
end
else
begin
glTexCoord2d(1*TileX-Slice/Slices*TileX,0); glVertex3dv(@V2);
glTexCoord2d(1*TileX-Slice/Slices*TileX,1*TileX); glVertex3dv(@V3);
end;
// so hatte ich mir das zuerst gedacht:
// 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);
// glNormal3dv(@Normale);
// glTexCoord2d(0,0); glVertex3dv(@V2);
// glTexCoord2d(1,0); glVertex3dv(@V1);
// glTexCoord2d(1,1); glVertex3dv(@V4);
// glTexCoord2d(0,1); glVertex3dv(@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();
glLoadMatrixd(@M1);
glMultMatrixd(@M2);
glGetDoublev(GL_MODELVIEW_MATRIX,@ret);
glPopMatrix();
result := ret;
end;
function MakeVector(X,Y,Z:GLdouble):TArrVector;
begin
result[0]:=x;
result[1]:=y;
result[2]:=z;
end;
function MakeVector(X,Y,Z,W:GLdouble):TArrVector;
begin
result[0]:=x;
result[1]:=y;
result[2]:=z;
result[3]:=w;
end;
function Normalize(aVector:TArrVector):TArrVector;overload;
var
d:double;
begin
InitVector (result,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;
result[C_X]:=aVector[C_X]/d;
result[C_Y]:=aVector[C_Y]/d;
result[C_Z]:=aVector[C_Z]/d;
end;
function Normalize(aVector:TGLVector):TGLVector;overload;
var
d:double;
begin
InitVector (result,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;
result.X:=aVector.X/d;
result.Y:=aVector.Y/d;
result.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:GLdouble):TArrVector;
var
temp: TArrVector;
sine,cosine:GLdouble;
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:GLdouble):TArrVector;
var
temp: TArrVector;
sine,cosine:GLdouble;
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: GLdouble):TArrVector;
var
temp: TArrVector;
sine,cosine:GLdouble;
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:GLdouble):TGLVector;
var
temp: TGLVector;
sine,cosine:GLdouble;
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:GLdouble):TGLVector;
var
temp: TGLVector;
sine,cosine:GLdouble;
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: GLdouble):TGLVector;
var
temp: TGLVector;
sine,cosine:GLdouble;
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;
function VectorRotateX(v,c: TGLvector;a: GLdouble):TGLVector;
// v: zu drehender punkt
// c: zentrum
// a: winkel
var
temp, temp2: TGLVector;
begin
// das übergebene zentrum in den nullpunkt holen
temp2 := SubtractVector (v, c);
// jetzt so drehen, als ob alles um den nullpunkt angeordnet wäre
temp := VectorRotateX (temp2, a);
// und das ergebnis wieder in den ausgangspunkt zurück verschieben
result := AddVector (temp, c);
end;
function VectorRotateY(v,c: TGLvector;a: GLdouble):TGLVector;
// v: zu drehender punkt
// c: zentrum
// a: winkel
var
temp, temp2: TGLVector;
begin
// das übergebene zentrum in den nullpunkt holen
temp2 := SubtractVector (v, c);
// jetzt so drehen, als ob alles um den nullpunkt angeordnet wäre
temp := VectorRotateY (temp2, a);
// und das ergebnis wieder in den ausgangspunkt zurück verschieben
result := AddVector (temp, c);
end;
function VectorRotateZ(v,c: TGLvector; a: GLdouble):TGLVector;
// v: zu drehender punkt
// c: zentrum
// a: winkel
var
temp, temp2: TGLVector;
begin
// das übergebene zentrum in den nullpunkt holen
temp2 := SubtractVector (v, c);
// jetzt so drehen, als ob alles um den nullpunkt angeordnet wäre
temp := VectorRotateZ (temp2, a);
// und das ergebnis wieder in den ausgangspunkt zurück verschieben
result := AddVector (temp, c);
end;
function VectorRotateX(v1,v2,v3,v4:TGLVector;a:GLdouble):TGLVector;
// v1: zu drehender punkt
// v2, v3, v4: vektoren die zusammen mit v1 eine fläche beschreiben,
// durch welche die drehachse läuft.
// a: drehwinkel
var
PlaneVec, PlaneCenter: TGLvector;
begin
// zuerst das zentrum der vektoren herausfinden
PlaneCenter.X := (v1.X+v2.X+v3.X+v4.X) / 4;
PlaneCenter.Y := (v1.Y+v2.Y+v3.Y+v4.Y) / 4;
PlaneCenter.Z := (v1.Z+v2.Z+v3.Z+v4.Z) / 4;
// den zu drehenden vector in den nullpunkt holen
PlaneVec := SubtractVector (v1, PlaneCenter);
// jetzt um die gewünschte achse drehen
PlaneVec := VectorRotateX (PlaneVec, a);
// die drehung auf den eigentlichen vector aufaddieren
// und zurückgeben
result := AddVector (PlaneVec, PlaneCenter);
result := VectorRotateX (v1, PlaneCenter, a);
end;
function VectorRotateY(v1,v2,v3,v4:TGLvector;a:GLdouble):TGLVector;
// v: zu drehender punkt
// v2, v3, v4: vektoren die zusammen mit v1 eine fläche beschreiben,
// durch welche die drehachse läuft.
// a: drehwinkel
var
PlaneVec, PlaneCenter: TGLvector;
begin
// zuerst das zentrum der vektoren herausfinden
PlaneCenter.X := (v1.X+v2.X+v3.X+v4.X) / 4;
PlaneCenter.Y := (v1.Y+v2.Y+v3.Y+v4.Y) / 4;
PlaneCenter.Z := (v1.Z+v2.Z+v3.Z+v4.Z) / 4;
// den zu drehenden vector in den nullpunkt holen
PlaneVec := SubtractVector (v1, PlaneCenter);
// jetzt um die gewünschte achse drehen
PlaneVec := VectorRotateY (PlaneVec, a);
// die drehung auf den eigentlichen vector aufaddieren
// und zurückgeben
result := AddVector (PlaneVec, PlaneCenter);
result := VectorRotateY (v1, PlaneCenter, a);
end;
function VectorRotateZ(v1,v2,v3,v4:TGLvector;a:GLdouble):TGLVector;
// v: zu drehender punkt
// v2, v3, v4: vektoren die zusammen mit v1 eine fläche beschreiben,
// durch welche die drehachse läuft.
// a: drehwinkel
var
PlaneVec, PlaneCenter: TGLvector;
begin
// zuerst das zentrum der vektoren herausfinden
PlaneCenter.X := (v1.X+v2.X+v3.X+v4.X) / 4;
PlaneCenter.Y := (v1.Y+v2.Y+v3.Y+v4.Y) / 4;
PlaneCenter.Z := (v1.Z+v2.Z+v3.Z+v4.Z) / 4;
// den zu drehenden vector in den nullpunkt holen
PlaneVec := SubtractVector (v1, PlaneCenter);
// jetzt um die gewünschte achse drehen
PlaneVec := VectorRotateZ (PlaneVec, a);
// die drehung auf den eigentlichen vector aufaddieren
// und zurückgeben
result := AddVector (PlaneVec, PlaneCenter);
result := VectorRotateZ (v1, PlaneCenter, a);
end;
{ Finds the point on the axis, closest to the
source vector }
function NearestPoint(Axis, Point: TGLVector): TGLVector;
var
temp: double;
begin
temp := DotProduct(Axis, Point) / DotProduct(Axis, Axis);
Axis.X := Axis.X * temp;
Axis.Y := Axis.Y * temp;
Axis.Z := Axis.Z * temp;
Result := Axis;
end;
{-----------------------------------------------------------------------------}
{-------------------------------- allgemein ----------------------------------}
{-----------------------------------------------------------------------------}
function InvertMatrix (src: TArrMatrix; var inverse: TArrMatrix): boolean;
var
t: GLdouble;
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: GLdouble): 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: GLdouble): 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;
function CheckFormat (number: string; digits, decimals: byte): string;
// wandelt ein mögliches dezimalkomma in einen punkt um
// beschneidet den übergebenen zahlenstring auf die gewünschten
// vorkomma- und nachkommastellen
// der übergebene zahlenstring darf keine tausender-kommas
// oder punkte enthalten!
var
sdigits, sdecimals, temp: string;
posi: integer;
begin
if digits+decimals = 0 then
begin
temp := '';
end
else
begin
sdigits := '';
sdecimals := '';
posi := pos (',', number);
if posi = 0 then
posi := pos ('.', number);
if posi > 0 then
sdigits := copy (number, 1, posi-1);
if length (number) > posi then
sdecimals := copy (number, posi+1);
if length (sdigits) > digits then
sdigits := copy (sdigits, length (sdigits)-(digits-1));
if length (sdecimals) > decimals then
sdecimals := copy (sdecimals, 1, decimals);
temp := sdigits + '.' + sdecimals;
end;
result := temp;
end;
procedure ResetGLErrorFlags;
var
err: GLenum;
begin
repeat
err := glGetError;
until err = GL_NO_ERROR;
end;
function ValidTexture (tex: GLUint; ErrStr: string): boolean;
var
error: GLenum;
begin
result := true;
ResetGLErrorFlags;
if not glIsTexture (tex) then
begin
error := glGetError;
Application.MessageBox(pChar ('Textur wurde nicht erkannt!'+chr(13)+chr(10)+
ErrStr+chr(13)+chr(10)+
'Fehler: '+IntToStr (error)),
'Fehler',
0);
result := false;
end;
end;
function AxisXRotation (V1, V2: TGLvector): GLdouble;
begin
V1.Z := 0;
V2.Z := 0;
result := DotProduct (V1, V2);
end;
function AxisYRotation (V1, V2: TGLvector): GLdouble;
begin
V1.Z := 0;
V2.Z := 0;
result := DotProduct (V1, V2);
end;
function AxisZRotation (V1, V2: TGLvector): GLdouble;
begin
V1.Y := 0;
V2.Y := 0;
result := DotProduct (V1, V2);
end;
function ExePath: string;
var
pfad: string;
begin
pfad := ExtractFilePath (Application.Exename);
if copy (pfad, length (pfad), 1) <> '\' then
pfad := pfad + '\';
result := pfad;
end;
end.