开通博客赚积分
发布资源赚积分
分类

源码开发语言/平台
当前位置：首页 > 源码/资料 > Delphi控件源码 > 查看源码
MM3D.pas
资源名称：qqdelphiprog.rar　[点击查看]
上传用户：hylc_2004
上传日期：2014-01-23
资源大小：46800k
文件大小：30k
源码类别：

Delphi控件源码

开发平台：

Delphi

MM3D.pas：源码内容
  1. {========================================================================}
  2. {=                (c) 1995-98 SwiftSoft Ronald Dittrich                 =}
  3. {========================================================================}
  4. {=                          All Rights Reserved                         =}
  5. {========================================================================}
  6. {=  D 01099 Dresden             = Fax.: +49 (0)351-8037944              =}
  7. {=  Loewenstr.7a                = info@swiftsoft.de                     =}
  8. {========================================================================}
  9. {=  Actual versions on http://www.swiftsoft.de/mmtools.html             =}
  10. {========================================================================}
  11. {=  This code is for reference purposes only and may not be copied or   =}
  12. {=  distributed in any format electronic or otherwise except one copy   =}
  13. {=  for backup purposes.                                                =}
  14. {=                                                                      =}
  15. {=  No Delphi Component Kit or Component individually or in a collection=}
  16. {=  subclassed or otherwise from the code in this unit, or associated   =}
  17. {=  .pas, .dfm, .dcu, .asm or .obj files may be sold or distributed     =}
  18. {=  without express permission from SwiftSoft.                          =}
  19. {=                                                                      =}
  20. {=  For more licence informations please refer to the associated        =}
  21. {=  HelpFile.                                                           =}
  22. {========================================================================}
  23. {=  $Date: 31.07.98 - 23:35:59 $                                        =}
  24. {========================================================================}
  25. unit MM3D;
  27. {$I COMPILER.INC}
  29. {.$DEFINE _DEBUG}
  31. interface
  33. uses
  34.     Classes,
  35.     SysUtils,
  36.     Windows,
  37.     Graphics,
  38.     MMObj;
  40. type
  41.     FLOAT3D         = Extended;
  42.     {$IFDEF CBUILDER3} {$EXTERNALSYM LONG} {$ENDIF}
  43.     LONG            = LongInt;
  44.     {$IFDEF CBUILDER3} {$EXTERNALSYM PVOID} {$ENDIF}
  45.     PVOID           = Pointer;
  47.     PMM3DColor      = ^TMM3DColor;
  48.     TMM3DColor      = DWORD;
  49.     PMM3DValue      = ^TMM3DValue;
  50.     TMM3DValue      = FLOAT3D;
  52.     PMM3DVector     = ^TMM3DVector;
  53.     TMM3DVector     = record
  54.         case Byte of
  55.             0: (x, y, z: TMM3DValue);
  56.             1: (dvX, dvY, dvZ: TMM3DValue);
  57.             2: (Values: array [0..2] of TMM3DValue);
  58.     end;
  60.     PMM3DVector4D   = ^TMM3DVector4D;
  61.     TMM3DVector4D   = record
  62.         x, y, z, w  : TMM3DValue;
  63.     end;
  65.     PMM3DQuaternion = ^TMM3DQuaternion;
  66.     TMM3DQuaternion = record
  67.         s           : TMM3DValue;
  68.         v           : TMM3DVector;
  69.     end;
  71.     PMM3DMatrix4D   = ^TMM3DMatrix4D;
  72.     TMM3DMatrix4D   = array[0..3,0..3] of TMM3DValue;
  74.     TMM3DProjectionType = (ptPerspective,ptOrthographic);
  76. type
  77.     {-- TMM3DMatrix --------------------------------------------------------------}
  78.     TMMMatrix3D     = class(TMMObject)
  79.     private
  80.         FMatrix     : TMM3DMatrix4D;
  82.         procedure   SetMatrix(const Value: TMM3DMatrix4D);
  83.         procedure   WriteMatrix(Writer: TWriter);
  84.         procedure   ReadMatrix(Reader: TReader);
  85.         function    GetCell(Row, Col: Integer): TMM3DValue;
  86.         procedure   SetCell(Row, Col: Integer; Value: TMM3DValue);
  87.     protected
  88.         procedure   DefineProperties(Filer: TFiler); override;
  89.     public
  90.         function    VectorTransform(const V: TMM3DVector): TMM3DVector4D;
  91.         function    InverseVectorTransform(const V: TMM3DVector): TMM3DVector4D;
  92.         procedure   Assign(Source: TPersistent); override;
  94.         {$IFDEF CBUILDER3} {$EXTERNALSYM TMMMatrix3D.AsMatrix} {$ENDIF}
  95.         property    AsMatrix                : TMM3DMatrix4D read FMatrix write SetMatrix;
  96.         property    Cell[Row,Col: Integer]  : TMM3DValue read GetCell write SetCell; default;
  97.     end;
  99.     {-- TMM3DVector --------------------------------------------------------------}
  100.     TMMVector3D     = class(TMMObject)
  101.     private
  102.         FVector     : TMM3DVector;
  104.         procedure   SetComp(Index: Integer; Value: TMM3DValue);
  105.         function    GetComp(Index: Integer): TMM3DValue;
  106.         procedure   SetAsVector(const Value: TMM3DVector);
  107.     public
  108.         procedure   Assign(Source: TPersistent); override;
  110.         property    AsVector : TMM3DVector read FVector write SetAsVector;
  111.     published
  112.         property    X: TMM3DValue index 0 read GetComp write SetComp;
  113.         property    Y: TMM3DValue index 1 read GetComp write SetComp;
  114.         property    Z: TMM3DValue index 2 read GetComp write SetComp;
  115.     end;
  117. {$IFDEF CBUILDER3} {$EXTERNALSYM MM3DCreateColorRGB} {$ENDIF}
  118. function    MM3DCreateColorRGB(red, green, blue: TMM3DValue): TMM3DColor;
  119. {$IFDEF CBUILDER3} {$EXTERNALSYM MM3DCreateColorRGBA} {$ENDIF}
  120. function    MM3DCreateColorRGBA(red, green, blue, alpha: TMM3DValue): TMM3DColor;
  121. {$IFDEF CBUILDER3} {$EXTERNALSYM MM3DColorGetRed} {$ENDIF}
  122. function    MM3DColorGetRed(color: TMM3DColor): TMM3DValue;
  123. {$IFDEF CBUILDER3} {$EXTERNALSYM MM3DColorGetGreen} {$ENDIF}
  124. function    MM3DColorGetGreen(color: TMM3DColor): TMM3DValue;
  125. {$IFDEF CBUILDER3} {$EXTERNALSYM MM3DColorGetBlue} {$ENDIF}
  126. function    MM3DColorGetBlue(color: TMM3DColor): TMM3DValue;
  127. {$IFDEF CBUILDER3} {$EXTERNALSYM MM3DColorGetAlpha} {$ENDIF}
  128. function    MM3DColorGetAlpha(color: TMM3DColor): TMM3DValue;
  129. {$IFDEF CBUILDER3} {$EXTERNALSYM MM3DBuildRGBColor} {$ENDIF}
  130. function    MM3DBuildRGBColor(color: TMM3DColor): TColor;
  131. {$IFDEF CBUILDER3} {$EXTERNALSYM MM3DVectorAdd} {$ENDIF}
  132. function    MM3DVectorAdd(const s1, s2: TMM3DVector): TMM3DVector;
  133. {$IFDEF CBUILDER3} {$EXTERNALSYM MM3DVectorSubtract} {$ENDIF}
  134. function    MM3DVectorSubtract(const s1, s2: TMM3DVector): TMM3DVector;
  135. {$IFDEF CBUILDER3} {$EXTERNALSYM MM3DVectorReflect} {$ENDIF}
  136. function    MM3DVectorReflect(const ray, normal: TMM3DVector): TMM3DVector;
  137. {$IFDEF CBUILDER3} {$EXTERNALSYM MM3DVectorCrossProduct} {$ENDIF}
  138. function    MM3DVectorCrossProduct(const s1, s2: TMM3DVector): TMM3DVector;
  139. {$IFDEF CBUILDER3} {$EXTERNALSYM MM3DVectorDotProduct} {$ENDIF}
  140. function    MM3DVectorDotProduct(const s1, s2: TMM3DVector): TMM3DValue;
  141. {$IFDEF CBUILDER3} {$EXTERNALSYM MM3DVectorNormalize} {$ENDIF}
  142. function    MM3DVectorNormalize(const v: TMM3DVector): TMM3DVector;
  143. {$IFDEF CBUILDER3} {$EXTERNALSYM MM3DVectorNormalise} {$ENDIF}
  144. function    MM3DVectorNormalise(const v: TMM3DVector): TMM3DVector;
  145. {$IFDEF CBUILDER3} {$EXTERNALSYM MM3DVectorModulus} {$ENDIF}
  146. function    MM3DVectorModulus(const v: TMM3DVector): TMM3DValue;
  147. {$IFDEF CBUILDER3} {$EXTERNALSYM MM3DVectorRotate} {$ENDIF}
  148. function    MM3DVectorRotate(const v, axis: TMM3DVector; theta: TMM3DValue): TMM3DVector;
  149. {$IFDEF CBUILDER3} {$EXTERNALSYM MM3DVectorScale} {$ENDIF}
  150. function    MM3DVectorScale(const s: TMM3DVector; factor: TMM3DValue): TMM3DVector;
  151. {$IFDEF CBUILDER3} {$EXTERNALSYM MM3DVectorRandom} {$ENDIF}
  152. function    MM3DVectorRandom: TMM3DVector;
  153. {$IFDEF CBUILDER3} {$EXTERNALSYM MM3DQuaternionFromRotation} {$ENDIF}
  154. function    MM3DQuaternionFromRotation(const v: TMM3DVector; theta: TMM3DValue): TMM3DQuaternion;
  155. //function    MM3DQuaternionMultiply(const a, b: TMM3DQuaternion): TMM3DQuaternion;
  156. //function    MM3DQuaternionSlerp(const a, b: TMM3DQuaternion; alpha: TMM3DValue): TMM3DQuaternion;
  158. {$IFDEF CBUILDER3} {$EXTERNALSYM MM3DMatrixFromQuaternion} {$ENDIF}
  159. function    MM3DMatrixFromQuaternion(const q: TMM3DQuaternion): TMM3DMatrix4D;
  161. { NOTE: Not all functions listed below work properly }
  163. {$IFDEF CBUILDER3} {$EXTERNALSYM MM3DVector} {$ENDIF}
  164. function    MM3DVector(x, y, z: TMM3DValue): TMM3DVector;
  165. {$IFDEF CBUILDER3} {$EXTERNALSYM MM3DVectorRotateQ} {$ENDIF}
  166. function    MM3DVectorRotateQ(const v: TMM3DVector; const q: TMM3DQuaternion): TMM3DVector;
  167. {$IFDEF CBUILDER3} {$EXTERNALSYM MM3DVectorTransform} {$ENDIF}
  168. function    MM3DVectorTransform(const v: TMM3DVector; const Mat: TMM3DMatrix4D): TMM3DVector4D;
  169. {$IFDEF CBUILDER3} {$EXTERNALSYM MM3DVector3D} {$ENDIF}
  170. function    MM3DVector3D(const v: TMM3DVector4D): TMM3DVector;
  171. {$IFDEF CBUILDER3} {$EXTERNALSYM MM3DCreateViewportMatrix} {$ENDIF}
  172. function    MM3DCreateViewportMatrix(Front: TMM3DValue; Proj: TMM3DProjectionType): TMM3DMatrix4D;
  173. {$IFDEF CBUILDER3} {$EXTERNALSYM MM3DMatrixMul} {$ENDIF}
  174. function    MM3DMatrixMul(const M1, M2: TMM3DMatrix4D): TMM3DMatrix4D;
  175. {$IFDEF CBUILDER3} {$EXTERNALSYM MM3DMatrixFromTranslation} {$ENDIF}
  176. function    MM3DMatrixFromTranslation(const T: TMM3DVector): TMM3DMatrix4D;
  177. {$IFDEF CBUILDER3} {$EXTERNALSYM MM3DMatrixFromScaling} {$ENDIF}
  178. function    MM3DMatrixFromScaling(const T: TMM3DVector): TMM3DMatrix4D;
  179. {$IFDEF CBUILDER3} {$EXTERNALSYM MM3DMatrixFromRotation} {$ENDIF}
  180. function    MM3DMatrixFromRotation(const Axis: TMM3DVector; Angle: TMM3DValue): TMM3DMatrix4D;
  181. {$IFDEF CBUILDER3} {$EXTERNALSYM MM3DMatrixFromRotationTo} {$ENDIF}
  182. function    MM3DMatrixFromRotationTo(const Dest: TMM3DVector): TMM3DMatrix4D;
  183. {$IFDEF CBUILDER3} {$EXTERNALSYM MM3DCreateCameraMatrix} {$ENDIF}
  184. function    MM3DCreateCameraMatrix(const Origin, Front, Top: TMM3DVector): TMM3DMatrix4D;
  185. {$IFDEF CBUILDER3} {$EXTERNALSYM MM3DVectorInvert} {$ENDIF}
  186. function    MM3DVectorInvert(const V: TMM3DVector): TMM3DVector;
  187. {$IFDEF CBUILDER3} {$EXTERNALSYM MM3DMatrixInvert} {$ENDIF}
  188. function    MM3DMatrixInvert(const M: TMM3DMatrix4D): TMM3DMatrix4D;
  189. {$IFDEF CBUILDER3} {$EXTERNALSYM MM3DMatrixDeterminant} {$ENDIF}
  190. function    MM3DMatrixDeterminant(const M: TMM3DMatrix4D): TMM3DValue;
  191. {$IFDEF CBUILDER3} {$EXTERNALSYM MM3DMatrixCofactor} {$ENDIF}
  192. function    MM3DMatrixCofactor(const M: TMM3DMatrix4D; i, j: Integer): TMM3DValue;
  193. {$IFDEF CBUILDER3} {$EXTERNALSYM MM3DVectorDegToRad} {$ENDIF}
  194. function    MM3DVectorDegToRad(const R: TMM3DVector): TMM3DVector;
  195. {$IFDEF CBUILDER3} {$EXTERNALSYM MM3DVectorRadToDeg} {$ENDIF}
  196. function    MM3DVectorRadToDeg(const R: TMM3DVector): TMM3DVector;
  197. {$IFDEF CBUILDER3} {$EXTERNALSYM MM3DDegToRad} {$ENDIF}
  198. function    MM3DDegToRad(D: TMM3DValue): TMM3DValue;
  199. {$IFDEF CBUILDER3} {$EXTERNALSYM MM3DRadToDeg} {$ENDIF}
  200. function    MM3DRadToDeg(R: TMM3DValue): TMM3DValue;
  201. {$IFDEF CBUILDER3} {$EXTERNALSYM MM3DMatrixFromCameraOrientation} {$ENDIF}
  202. function    MM3DMatrixFromCameraOrientation(const Front, Top: TMM3DVector): TMM3DMatrix4D;
  203. {$IFDEF CBUILDER3} {$EXTERNALSYM MM3DVectorEqual} {$ENDIF}
  204. function    MM3DVectorEqual(const V1, V2: TMM3DVector): Boolean;
  206. type
  207.     {-- EMM3DError ---------------------------------------------------------------}
  208.     EMM3DError  = class(Exception)
  209.     end;
  211. const
  212.     XUnit       : TMM3DVector   = (x:1;y:0;z:0);
  213.     YUnit       : TMM3DVector   = (x:0;y:1;z:0);
  214.     ZUnit       : TMM3DVector   = (x:0;y:0;z:1);
  215.     ZeroVector  : TMM3DVector   = (x:0;y:0;z:0);
  216.     Identity    : TMM3DMatrix4D = (
  217.                                     (1, 0, 0, 0),
  218.                                     (0, 1, 0, 0),
  219.                                     (0, 0, 1, 0),
  220.                                     (0, 0, 0, 1)
  221.                                   );
  223. var
  224.     White       : TMM3DColor;
  225.     Red         : TMM3DColor;
  226.     Blue        : TMM3DColor;
  227.     Green       : TMM3DColor;
  228.     LightRed    : TMM3DColor;
  229.     LightBlue   : TMM3DColor;
  230.     LightGreen  : TMM3DColor;
  231.     Yellow      : TMM3DColor;
  232.     Black       : TMM3DColor;
  234. implementation
  236. uses
  237.     MMMath,
  238.     MMUtils
  239. {$IFDEF _DEBUG}
  240.     ,MMDebug
  241. {$ENDIF}
  242.     ;
  244. {-----------------------------------------------------------------------------}
  245. function    MM3DCreateColorRGB(red, green, blue: TMM3DValue): TMM3DColor;
  246. begin
  247.     Result  := $ff000000 or (Trunc(red * 255) shl 16) or (Trunc(green * 255) shl 8) or Trunc(blue * 255);
  248. end;
  250. {-----------------------------------------------------------------------------}
  251. function    MM3DCreateColorRGBA(red, green, blue, alpha: TMM3DValue): TMM3DColor;
  252. begin
  253.     Result  := (Trunc(alpha * 255) shl 24) or (Trunc(red * 255) shl 16) or (Trunc(green * 255) shl 8) or Trunc(blue * 255);
  254. end;
  256. {-----------------------------------------------------------------------------}
  257. function    MM3DColorGetRed(color: TMM3DColor): TMM3DValue;
  258. begin
  259.     Result  := ((color shr 16) and $ff)/255;
  260. end;
  262. {-----------------------------------------------------------------------------}
  263. function    MM3DColorGetGreen(color: TMM3DColor): TMM3DValue;
  264. begin
  265.     Result  := ((color shr 8) and $ff)/255;
  266. end;
  268. {-----------------------------------------------------------------------------}
  269. function    MM3DColorGetBlue(color: TMM3DColor): TMM3DValue;
  270. begin
  271.     Result  := (color and $ff)/255;
  272. end;
  274. {-----------------------------------------------------------------------------}
  275. function    MM3DColorGetAlpha(color: TMM3DColor): TMM3DValue;
  276. begin
  277.     Result  := (color shr 24)/255;
  278. end;
  280. {-----------------------------------------------------------------------------}
  281. function    MM3DBuildRGBColor(color: TMM3DColor): TColor;
  282. type
  283.     TBytes = record
  284.         case Byte of
  285.             0: (C: TMM3DColor);
  286.             1: (B, G, R, A: Byte);
  287.     end;
  288. begin
  289.     with TBytes(color) do
  290.         Result := RGB(R,G,B);
  291. end;
  293. {-----------------------------------------------------------------------------}
  294. function    MM3DVectorAdd(const s1, s2: TMM3DVector): TMM3DVector;
  295. begin
  296.     with Result do
  297.     begin
  298.         x := s1.x + s2.x;
  299.         y := s1.y + s2.y;
  300.         z := s1.z + s2.z;
  301.     end;
  302. end;
  304. {-----------------------------------------------------------------------------}
  305. function    MM3DVectorSubtract(const s1, s2: TMM3DVector): TMM3DVector;
  306. begin
  307.     with Result do
  308.     begin
  309.         x := s1.x - s2.x;
  310.         y := s1.y - s2.y;
  311.         z := s1.z - s2.z;
  312.     end;
  313. end;
  315. {-----------------------------------------------------------------------------}
  316. function    MM3DVectorReflect(const ray, normal: TMM3DVector): TMM3DVector;
  317. begin
  318.     Result := MM3DVectorRotate(ray,normal,Pi);
  319. end;
  321. {-----------------------------------------------------------------------------}
  322. function    MM3DVectorCrossProduct(const s1, s2: TMM3DVector): TMM3DVector;
  323. begin
  324.     with Result do
  325.     begin
  326.        X := (s1.Y*s2.Z)-(s1.Z*s2.Y);
  327.        Y := (s1.Z*s2.X)-(s1.X*s2.Z);
  328.        Z := (s1.X*s2.Y)-(s1.Y*s2.X);
  329.     end;
  330. end;
  332. {-----------------------------------------------------------------------------}
  333. function    MM3DVectorDotProduct(const s1, s2: TMM3DVector): TMM3DValue;
  334. begin
  335.     Result  := (s1.X * s2.X) + (s1.Y * s2.Y) + (s1.Z * s2.Z);
  336. end;
  338. {-----------------------------------------------------------------------------}
  339. function    MM3DVectorNormalize(const v: TMM3DVector): TMM3DVector;
  340. var
  341.     M: TMM3DValue;
  342. begin
  343.     M := MM3DVectorModulus(v);
  344.     if M = 0 then
  345.         { TODO: Should be resource id }
  346.         raise EMM3DError.Create('Zero-length vector passed to normalize');
  348.     with Result do
  349.     begin
  350.         X := v.X/M;
  351.         Y := v.Y/M;
  352.         Z := v.Z/M;
  353.     end;
  354. end;
  356. {-----------------------------------------------------------------------------}
  357. function    MM3DVectorNormalise(const v: TMM3DVector): TMM3DVector;
  358. begin
  359.     Result  := MM3DVectorNormalize(v);
  360. end;
  362. {-----------------------------------------------------------------------------}
  363. function    MM3DVectorModulus(const v: TMM3DVector): TMM3DValue;
  364. begin
  365.     Result := Sqrt(Sqr(v.x)+Sqr(v.y)+Sqr(v.z));
  366. end;
  368. {-----------------------------------------------------------------------------}
  369. function    MM3DVectorRotate(const v, axis: TMM3DVector; theta: TMM3DValue): TMM3DVector;
  370. var
  371.     M: TMM3DMatrix4D;
  372. begin
  373.     M       := MM3DMatrixFromRotation(axis,theta);
  374.     Result  := MM3DVector3D(MM3DVectorTransform(v,M));
  375. end;
  377. {-----------------------------------------------------------------------------}
  378. function    MM3DVectorScale(const s: TMM3DVector; factor: TMM3DValue): TMM3DVector;
  379. begin
  380.     with Result do
  381.     begin
  382.         X := s.X*factor;
  383.         Y := s.Y*factor;
  384.         Z := s.Z*factor;
  385.     end;
  386. end;
  388. {-----------------------------------------------------------------------------}
  389. function    MM3DVectorRandom: TMM3DVector;
  390. begin
  391.     with Result do
  392.     begin
  393.         X := Random(MaxInt)-(MaxInt div 2);
  394.         Y := Random(MaxInt)-(MaxInt div 2);
  395.         Z := Random(MaxInt)-(MaxInt div 2);
  396.     end;
  397.     Result := MM3DVectorNormalize(Result);
  398. end;
  400. {-----------------------------------------------------------------------------}
  401. function    MM3DQuaternionFromRotation(const v: TMM3DVector; theta: TMM3DValue): TMM3DQuaternion;
  402. var
  403.     ht: TMM3DValue;
  404.     ch, sh: TMM3DValue;
  405.     ax: TMM3DVector;
  406. begin
  407.     ax := MM3DVectorNormalize(v);
  409.     ht := theta/2;
  410.     ch := cos(ht);
  411.     sh := sin(ht);
  413.     Result.v.x := ax.x*sh;
  414.     Result.v.y := ax.y*sh;
  415.     Result.v.z := ax.z*sh;
  416.     Result.s   := ch;
  417. end;
  419. {-----------------------------------------------------------------------------}
  420. function    MM3DMatrixFromQuaternion(const q: TMM3DQuaternion): TMM3DMatrix4D;
  421. var
  422.     xs, ys, zs, wx, wy, wz, xx, xy, xz, yy, yz, zz: TMM3DValue;
  423. begin
  424.     xs := 2*q.v.x;
  425.     ys := 2*q.v.y;
  426.     zs := 2*q.v.z;
  428.     wx := q.s*xs;
  429.     wy := q.s*ys;
  430.     wz := q.s*zs;
  432.     xx := q.v.x*xs;
  433.     xy := q.v.x*ys;
  434.     xz := q.v.x*zs;
  436.     yy := q.v.y*ys;
  437.     yz := q.v.y*zs;
  438.     zz := q.v.z*zs;
  440.     Result      := Identity;
  442.     Result[0,0] := 1 - (yy + zz);
  443.     Result[0,1] := xy - wz;
  444.     Result[0,2] := xz + wy;
  446.     Result[1,0] := xy + wz;
  447.     Result[1,1] := 1 - (xx + zz);
  448.     Result[1,2] := yz - wx;
  450.     Result[2,0] := xz - wy;
  451.     Result[2,1] := yz + wx;
  452.     Result[2,2] := 1 - (xx + yy);
  453. end;
  455. {-----------------------------------------------------------------------------}
  456. function    MM3DVector(x, y, z: TMM3DValue): TMM3DVector;
  457. begin
  458.     Result.x := x;
  459.     Result.y := y;
  460.     Result.z := z;
  461. end;
  463. {-----------------------------------------------------------------------------}
  464. function    MM3DVectorRotateQ(const v: TMM3DVector; const q: TMM3DQuaternion): TMM3DVector;
  465. begin
  466.     Result  := MM3DVector3D(MM3DVectorTransform(v,MM3DMatrixFromQuaternion(q)));
  467. end;
  469. {-----------------------------------------------------------------------------}
  470. function    MM3DVectorTransform(const v: TMM3DVector; const Mat: TMM3DMatrix4D): TMM3DVector4D;
  471. begin
  472.     with v do
  473.     begin
  474.         Result.x   := x * mat[0,0] + y * mat[0,1] + z * mat[0,2] + 1 * mat[0,3];
  475.         Result.y   := x * mat[1,0] + y * mat[1,1] + z * mat[1,2] + 1 * mat[1,3];
  476.         Result.z   := x * mat[2,0] + y * mat[2,1] + z * mat[2,2] + 1 * mat[2,3];
  477.         Result.w   := x * mat[3,0] + y * mat[3,1] + z * mat[3,2] + 1 * mat[3,3];
  478.     end;
  479. end;
  481. {-----------------------------------------------------------------------------}
  482. function    MM3DCreateViewportMatrix(Front: TMM3DValue; Proj: TMM3DProjectionType): TMM3DMatrix4D;
  483. begin
  484.     FillChar(Result,SizeOf(Result),0);
  485.     if Proj = ptPerspective then
  486.     begin
  487.         Result[0,0] := Front;
  488.         Result[1,1] := Front;
  489.         Result[2,2] := 1;
  490.         Result[3,2] := 1;
  491.     end
  492.     else
  493.     begin
  494.         Result[0,0] := 1;
  495.         Result[1,1] := 1;
  496.         Result[2,3] := Front;
  497.         Result[3,3] := 1;
  498.     end;
  499. end;
  501. {-----------------------------------------------------------------------------}
  502. function    MM3DVector3D(const v: TMM3DVector4D): TMM3DVector;
  503. begin
  504.     with v do
  505.     begin
  506.         Result.X := X/W;
  507.         Result.Y := Y/W;
  508.         Result.Z := Z/W;
  509.     end;
  510. end;
  512. {-----------------------------------------------------------------------------}
  513. function    MM3DMatrixMul(const M1, M2: TMM3DMatrix4D): TMM3DMatrix4D;
  514. var
  515.     i, j: Integer;
  516. begin
  517.     for i := 0 to 3 do
  518.         for j := 0 to 3 do
  519.             Result[j,i] := M1[0,i] * M2[j,0] + M1[1,i] * M2[j,1] + M1[2,i] * M2[j,2] + M1[3,i] * M2[j,3];
  520. end;
  522. {-----------------------------------------------------------------------------}
  523. function    MM3DMatrixFromTranslation(const T: TMM3DVector): TMM3DMatrix4D;
  524. begin
  525.     FillChar(Result,SizeOf(Result),0);
  526.     Result[0,3] := T.x;
  527.     Result[1,3] := T.y;
  528.     Result[2,3] := T.z;
  529.     Result[0,0] := 1;
  530.     Result[1,1] := 1;
  531.     Result[2,2] := 1;
  532.     Result[3,3] := 1;
  533. end;
  535. {-----------------------------------------------------------------------------}
  536. function    MM3DMatrixFromScaling(const T: TMM3DVector): TMM3DMatrix4D;
  537. begin
  538.     FillChar(Result,SizeOf(Result),0);
  539.     Result[0,0] := T.x;
  540.     Result[1,1] := T.y;
  541.     Result[2,2] := T.z;
  542.     Result[3,3] := 1;
  543. end;
  545. {-----------------------------------------------------------------------------}
  546. function    MM3DMatrixFromRotation(const Axis: TMM3DVector; Angle: TMM3DValue): TMM3DMatrix4D;
  547. var
  548.     Q: TMM3DQuaternion;
  549. begin
  550.     if Angle = 0 then
  551.         Result := Identity
  552.     else
  553.     begin
  554.         Q := MM3DQuaternionFromRotation(Axis,Angle);
  555.         Result := MM3DMatrixFromQuaternion(Q);
  556.     end;
  557. end;
  559. {-----------------------------------------------------------------------------}
  560. function    MM3DMatrixFromRotationTo(const Dest: TMM3DVector): TMM3DMatrix4D;
  561. type
  562.     PVect = ^TVect;
  563.     TVect = array[0..2] of TMM3DValue;
  564. var
  565.     N, T, W, U, V: TMM3DVector;
  567.     function    GetMinorAxis(const V: TMM3DVector): Integer;
  568.     begin
  569.         Result := 0;
  570.         if V.X > V.Y then
  571.             Result := 1;
  572.         if V.Z < PVect(@V)[Result] then
  573.             Result := 2;
  574.     end;
  575. begin
  576.     N := MM3DVectorNormalize(Dest);
  577. T := N;
  578.     W := N;
  579.     PVect(@T)[GetMinorAxis(W)] := 1.0;
  580.     U := MM3DVectorNormalize(MM3DVectorCrossProduct(T,W));
  581.     V := MM3DVectorCrossProduct(W,U);
  583.     Result := Identity;
  585.     Result[0,0] := U.X;
  586.     Result[0,1] := U.Y;
  587.     Result[0,2] := U.Z;
  589.     Result[1,0] := V.X;
  590.     Result[1,1] := V.Y;
  591.     Result[1,2] := V.Z;
  593.     Result[2,0] := W.X;
  594.     Result[2,1] := W.Y;
  595.     Result[2,2] := W.Z;
  596. end;
  598. {-----------------------------------------------------------------------------}
  599. function    MM3DCreateCameraMatrix(const Origin, Front, Top: TMM3DVector): TMM3DMatrix4D;
  600. var
  601.     QM, M   : TMM3DMatrix4D;
  602. begin
  603.     M       := MM3DMatrixFromTranslation(MM3DVectorInvert(Origin));
  604.     QM      := MM3DMatrixInvert(MM3DMatrixFromCameraOrientation(Front,Top));
  605.     M       := MM3DMatrixMul(M,QM);
  606.     Result  := M;
  607. end;
  609. {-----------------------------------------------------------------------------}
  610. function    MM3DVectorInvert(const V: TMM3DVector): TMM3DVector;
  611. begin
  612.     with Result do
  613.     begin
  614.         x := -V.x;
  615.         y := -V.y;
  616.         z := -V.z;
  617.     end;
  618. end;
  620. {-----------------------------------------------------------------------------}
  621. function    MM3DMatrixInvert(const M: TMM3DMatrix4D): TMM3DMatrix4D;
  622. var
  623.     D   : TMM3DValue;
  624.     i, j: Integer;
  625. begin
  626.     D := MM3DMatrixDeterminant(M);
  627.     for i := 0 to 3 do
  628.         for j := 0 to 3 do
  629.             Result[j,i] := MM3DMatrixCofactor(M, i, j)/D;
  630. end;
  632. {-----------------------------------------------------------------------------}
  633. function    MM3DMatrixDeterminant(const M: TMM3DMatrix4D): TMM3DValue;
  634. begin
  635.     Result := M[0,0] * MM3DMatrixCofactor (M, 0, 0) +
  636.               M[0,1] * MM3DMatrixCofactor (M, 0, 1) +
  637.               M[0,2] * MM3DMatrixCofactor (M, 0, 2) +
  638.               M[0,3] * MM3DMatrixCofactor (M, 0, 3);
  639. end;
  641. {-----------------------------------------------------------------------------}
  642. function    MM3DMatrixCofactor(const M: TMM3DMatrix4D; i, j: Integer): TMM3DValue;
  643. var
  644.     i0, i1, i2, j0, j1, j2: Integer;
  645.     Det: TMM3DValue;
  646. begin
  647.     case i of
  648.         0: begin i0 := 1; i1 := 2; i2 := 3; end;
  649. 1: begin i0 := 0; i1 := 2; i2 := 3; end;
  650. 2: begin i0 := 0; i1 := 1; i2 := 3; end;
  651. 3: begin i0 := 0; i1 := 1; i2 := 2; end;
  652.     else
  653.         i0 := 0; i1 := 0; i2 := 0;
  654.     end;
  655. case j of
  656. 0: begin j0 := 1; j1 := 2; j2 := 3; end;
  657. 1: begin j0 := 0; j1 := 2; j2 := 3; end;
  658. 2: begin j0 := 0; j1 := 1; j2 := 3; end;
  659. 3: begin j0 := 0; j1 := 1; j2 := 2; end;
  660.     else
  661.         j0 := 0; j1 := 0; j2 := 0;
  662.     end;
  664.     Det := M[i0,j0] * (M[i1,j1] * M[i2,j2] - M[i1,j2] * M[i2,j1]) -
  665.            M[i0,j1] * (M[i1,j0] * M[i2,j2] - M[i1,j2] * M[i2,j0]) +
  666.            M[i0,j2] * (M[i1,j0] * M[i2,j1] - M[i1,j1] * M[i2,j0]);
  667.     if Odd(i + j) then
  668.         Result := -Det
  669.     else
  670.         Result := Det;
  671. end;
  673. {-----------------------------------------------------------------------------}
  674. function    MM3DVectorDegToRad(const R: TMM3DVector): TMM3DVector;
  675. begin
  676.     with Result do
  677.     begin
  678.         X := R.X/180*Pi;
  679.         Y := R.Y/180*Pi;
  680.         Z := R.Z/180*Pi;
  681.     end;
  682. end;
  684. {-----------------------------------------------------------------------------}
  685. function    MM3DVectorRadToDeg(const R: TMM3DVector): TMM3DVector;
  686. begin
  687.     with Result do
  688.     begin
  689.         X := R.X/Pi*180;
  690.         Y := R.Y/Pi*180;
  691.         Z := R.Z/Pi*180;
  692.     end;
  693. end;
  695. {-----------------------------------------------------------------------------}
  696. function    MM3DDegToRad(D: TMM3DValue): TMM3DValue;
  697. begin
  698.     Result := D/180*Pi;
  699. end;
  701. {-----------------------------------------------------------------------------}
  702. function    MM3DRadToDeg(R: TMM3DValue): TMM3DValue;
  703. begin
  704.     Result := R/Pi*180;
  705. end;
  707. {-----------------------------------------------------------------------------}
  708. function    MM3DMatrixFromCameraOrientation(const Front, Top: TMM3DVector): TMM3DMatrix4D;
  709. var
  710.     Axis: TMM3DVector;
  711.     A   : TMM3DValue;
  712.     F, T: TMM3DVector;
  713.     M   : TMM3DMatrix4D;
  715.     function    Transf(const V: TMM3DVector; const M: TMM3DMatrix4D): TMM3DVector;
  716.     begin
  717.         Result := MM3DVector3D(MM3DVectorTransform(V,M));
  718.     end;
  719. begin
  720.     F       := MM3DVectorNormalize(Front);
  721.     T       := MM3DVectorNormalize(Top);
  723.     // Put Y to its place
  724.     Axis    := MM3DVectorCrossProduct(YUnit,T);
  725.     A       := ArcCos(MM3DVectorDotProduct(YUnit,T));
  727.     if Round(A/Pi*180) > 178 then
  728.     begin
  729.         Axis := ZUnit;
  730.     end;
  732.     Result  := MM3DMatrixFromRotation(Axis,A);
  734.     M       := MM3DMatrixInvert(Result);
  735.     T       := Transf(T,M);
  736.     F       := MM3DVectorNormalize(Transf(F,M));
  738.     // Put Z to its place
  739.     Axis    := MM3DVectorCrossProduct(ZUnit,F);
  740.     A       := ArcCos(MM3DVectorDotProduct(ZUnit,F));
  742.     if Round(A/Pi*180) > 178 then
  743.     begin
  744.         Axis := YUnit;
  745.     end;
  747.     Result  := MM3DMatrixMul(MM3DMatrixFromRotation(Axis,A),Result);
  748. end;
  750. {-----------------------------------------------------------------------------}
  751. function    MM3DVectorEqual(const V1, V2: TMM3DVector): Boolean;
  752. begin
  753.     Result := GlobalCmpMem(V1,V2,SizeOf(V1));
  754. end;
  756. {== TMMVector3D =========================================================}
  757. procedure   TMMVector3D.SetComp(Index: Integer; Value: TMM3DValue);
  758. begin
  759.     case Index of
  760.         0: if FVector.x <> Value then FVector.x := Value else Exit;
  761.         1: if FVector.y <> Value then FVector.y := Value else Exit;
  762.         2: if FVector.z <> Value then FVector.z := Value else Exit;
  763.     end;
  764.     Changed;
  765. end;
  767. {-- TMMVector3D ---------------------------------------------------------}
  768. function    TMMVector3D.GetComp(Index: Integer): TMM3DValue;
  769. begin
  770.     Result := 0;
  771.     case Index of
  772.         0: Result := FVector.x;
  773.         1: Result := FVector.y;
  774.         2: Result := FVector.z;
  775.     end;
  776. end;
  778. {-- TMMVector3D ---------------------------------------------------------}
  779. procedure   TMMVector3D.SetAsVector(const Value: TMM3DVector);
  780. begin
  781.     if not MM3DVectorEqual(FVector,Value) then
  782.     begin
  783.         FVector := Value;
  784.         Changed;
  785.     end;
  786. end;
  788. {-- TMMVector3D ---------------------------------------------------------}
  789. procedure   TMMVector3D.Assign(Source: TPersistent);
  790. begin
  791.     if Source is TMMVector3D then
  792.         AsVector := (Source as TMMVector3D).AsVector
  793.     else
  794.         inherited Assign(Source);
  795. end;
  797. {== TMMMatrix3D ==============================================================}
  798. procedure   TMMMatrix3D.SetMatrix(const Value: TMM3DMatrix4D);
  799. begin
  800.     FMatrix := Value;
  801.     Changed;
  802. end;
  804. {-- TMMMatrix3D --------------------------------------------------------------}
  805. procedure   TMMMatrix3D.WriteMatrix(Writer: TWriter);
  806. var
  807.     i, j: Integer;
  808. begin
  809.     Writer.WriteListBegin;
  810.     for i := 0 to 3 do
  811.         for j := 0 to 3 do
  812.             Writer.WriteFloat(FMatrix[i,j]);
  813.     Writer.WriteListEnd;
  814. end;
  816. {-- TMMMatrix3D --------------------------------------------------------------}
  817. procedure   TMMMatrix3D.ReadMatrix(Reader: TReader);
  818. var
  819.     i, j: Integer;
  820. begin
  821.     Reader.ReadListBegin;
  822.     for i := 0 to 3 do
  823.         for j := 0 to 3 do
  824.             FMatrix[i,j] := Reader.ReadFloat;
  825.     Reader.ReadListEnd;
  826. end;
  828. {-- TMMMatrix3D --------------------------------------------------------------}
  829. function    TMMMatrix3D.GetCell(Row, Col: Integer): TMM3DValue;
  830. begin
  831.     Result := FMatrix[Row,Col];
  832. end;
  834. {-- TMMMatrix3D --------------------------------------------------------------}
  835. procedure   TMMMatrix3D.SetCell(Row, Col: Integer; Value: TMM3DValue);
  836. begin
  837.     FMatrix[Row,Col] := Value;
  838.     Changed;
  839. end;
  841. {-- TMMMatrix3D --------------------------------------------------------------}
  842. procedure   TMMMatrix3D.DefineProperties(Filer: TFiler);
  843. begin
  844.     inherited DefineProperties(Filer);
  845.     Filer.DefineProperty('Data',ReadMatrix,WriteMatrix,True);
  846. end;
  848. {-- TMMMatrix3D --------------------------------------------------------------}
  849. function    TMMMatrix3D.VectorTransform(const V: TMM3DVector): TMM3DVector4D;
  850. begin
  851.     Result := MM3DVectorTransform(V,FMatrix);
  852. end;
  854. {-- TMMMatrix3D --------------------------------------------------------------}
  855. function    TMMMatrix3D.InverseVectorTransform(const V: TMM3DVector): TMM3DVector4D;
  856. var
  857.     M: TMM3DMatrix4D;
  858. begin
  859.     M := MM3DMatrixInvert(FMatrix);
  860.     Result := MM3DVectorTransform(V,M);
  861. end;
  863. {-- TMMMatrix3D --------------------------------------------------------------}
  864. procedure   TMMMatrix3D.Assign(Source: TPersistent);
  865. begin
  866.     if Source is TMMMatrix3D then
  867.         AsMatrix := (Source as TMMMatrix3D).AsMatrix
  868.     else
  869.         inherited Assign(Source);
  870. end;
  872. initialization
  874.     White       := MM3DCreateColorRGB(1,1,1);
  875.     Red         := MM3DCreateColorRGB(0.5,0,0);
  876.     Green       := MM3DCreateColorRGB(0,0.5,0);
  877.     Blue        := MM3DCreateColorRGB(0,0,0.5);
  878.     LightRed    := MM3DCreateColorRGB(1,0,0);
  879.     LightGreen  := MM3DCreateColorRGB(0,1,0);
  880.     LightBlue   := MM3DCreateColorRGB(0,0,1);
  881.     Yellow      := MM3DCreateColorRGB(1,1,0);
  882.     Black       := MM3DCreateColorRGB(0,0,0);
  884. end.