MathgeomGLS

1
unit MathImage;
2
(* 
3
   <New topic=MAIN@Mathimage Main>
4
   <B=Mathimage Component, version 6.0(beta)><par><par>
5
   <B=Author: Renate Schaaf><par>
6
   renates@xmission.com<par>
7
   schaaf@math.usu.edu<par> <par>
8
   For info and upgrades see<par>
9
   http://www.xmission.com/~renates/delphi.html<par><par>
10
   <B=Component packages:> Math_MathImage, Math_Overlay<par>
11
   <B=Component source files:> MathImge.pas, Overlay.pas, WorldDrawing.pas<par>
12
   <B=Delphi versions:> 5. 4 should work, for 1-3 see version 5.0.
13
   <par>
14
   <B=License:> The use of the component is free for educational, academic
15
   or noncommercial applications. For more details read the file MathImge.txt which
16
   comes with the component.<par> <par>
17
   <See=Overview><par>
18
   <See=Thanks>
19
*)
20

21
interface
22

23
uses
24
  Winapi.Windows,
25
  Winapi.Messages,
26
  System.SysUtils,
27
  System.UITypes,
28
  System.Classes, 
29
  Vcl.Graphics,
30
  Vcl.Controls, 
31
  Vcl.Forms, 
32
  Vcl.Dialogs,
33
  //
34
  WorldDrawing,
35
  OverlayImage;
36

37
type
38
  (* 
39
  This type is currently set to double. Change it according to
40
  your needs in the WorldDrawing unit.
41
  *)
42
  MathFloat = WorldDrawing.MathFloat;
43
  
44
  PFloatPoint = WorldDrawing.PFloatPoint;
45
  TFloatpoint = WorldDrawing.TFloatpoint;
46

47
  TFloatPointArray = WorldDrawing.TFloatPointArray;
48

49
  PD3FloatPoint = WorldDrawing.PD3FloatPoint;
50
  TD3FloatPoint = WorldDrawing.TD3FloatPoint;
51

52
  Td3FloatPointArray = WorldDrawing.Td3FloatPointArray;
53
  TColorArray = WorldDrawing.TColorArray;
54
  TFloatarray = WorldDrawing.TFloatarray;
55
  TNormalKind = WorldDrawing.TNormalKind;
56

57
  (* 
58
   Cracker class to hook into the low level routines of
59
   TWorldDrawing for speed.
60
  *)
61
  TCrackerDrawing = class(TWorldDrawing)
62
  end;
63

64
 (* 
65
   This exception is raised whenever the world settings of TMathImage
66
   create an EMathError exception, for example if a division by zero occurs, because
67
   the world-width is zero. In this case the old settings
68
   are restored and an EMathImageError is raised.
69
  *)
70

71
{
72
   <See class=TMathImage> is a component which helps displaying mathematical graphics
73
   objects in 2 or 3 dimensions. It used to be derived from TImage (hence the name),
74
   but is now a descendant of TGraphicControl, for better flexibility and better control
75
   of drawing speed. The component implements many TCanvas-drawing routines under similar
76
   names, but you can pass the coordinates as float types (world coordinates). Below is a
77
   selection of drawing routines:
78
   <Par>
79
   <LI=<See method=TMathImage@DrawLineTo> >     <LI=<See method=TMathImage@MoveToPoint> >
80
   <LI=<See method=TMathImage@DrawLine> >       <LI=<See method=TMathImage@DrawPoint> >
81
   <LI=<See method=TMathImage@DrawPolyline> >   <LI=<See method=TMathImage@d3DrawLineTo> >
82
   <LI=<See method=TMathImage@d3MoveToPoint>>   <LI=<See method=TMathImage@d3DrawLine> >
83
   <LI=<See method=TMathImage@d3PolyLine> >     <LI=<See method=TMathImage@d3DrawSurface> >
84
   <LI=<See method=TMathImage@d3DrawLitSurface>><LI=<See method=TMathImage@DrawLevelCurves> >
85
   <LI=<See method=TMathImage@DrawFilledLevelCurves> >
86
   <Par>
87
   To set the world-to-pixel scalings, use the following methodsat run time:
88
   <Par>
89
   <LI=<See method=TMathImage@SetWorld> >   <LI=<See method=TMathImage@d3SetWorld> >
90
   <Par>
91
   The world bounds and more world settings can also be set using the following properties:
92
   <Par>
93
   <LI=<See property=TMathImage@d2WorldX1> >     <LI=<See property=TMathImage@d2WorldXW> >
94
   <LI=<See property=TMathImage@d2WorldY1> >     <LI=<See property=TMathImage@d2WorldYW> >
95
   <LI=<See property=TMathImage@d3WorldX1> >     <LI=<See property=TMathImage@d3WorldXW> >
96
   <LI=<See property=TMathImage@d3WorldY1> >     <LI=<See property=TMathImage@d3WorldYW> >
97
   <LI=<See property=TMathImage@d3WorldZ1> >     <LI=<See property=TMathImage@d3WorldZW> >
98
   <LI=<See property=TMathImage@d3ViewDist>>     <LI=<See property=TMathImage@d3ViewAngle> >
99
   <LI=<See property=TMathImage@d3ZRotation> >   <LI=<See property=TMathImage@d3YRotation> >
100
   <LI=<See property=TMathImage@d3AspectRatio> >
101
   <LI=<See property=TMathImage@d3XScale> >      <LI=<See property=TMathImage@d3YScale> >
102
   <LI=<See property=TMathImage@d3ZScale> >
103
   <Par>
104
   For an explanation of how D-3-graphics is implemented, see <see=D3_Graphics_Explanation>.
105
   TMathimage also has a <see property=TMathimage@Canvas> property, which you can use to
106
   add to the drawing using all (pixel) routines of TCanvas. To translate between world and
107
   pixel coordinates, use the routines
108
   <LI=<See method=TMathImage@WindowX> >    <LI=<See method=TMathImage@WindowY> >
109
   <LI=<See method=TMathImage@WorldX> >     <LI=<See method=TMathImage@WorldY> >
110
   <LI=<See method=TMathImage@d3Window> >
111
   For convenient loading, saving, etc., TMathImage has a <see property=TMAthImage@Bitmap>
112
   property. The bitmap holds the current drawing.
113
   (TMathimage.Canvas is actually TMathImage.Bitmap.Canvas).
114
   Use the <see property=TMAthImage@Brush> and <see property=TMathImage@Pen>
115
   properties of TMathImage to set drawing- and fill- colors and -styles.
116
   Use the <see property=TMathImage@Font> property to set the font used for
117
   labelling axes and for TMathImage.Canvas.TextOut.
118
   Use
119
   <LI=<see method=TMathImage@Clear> >          <LI=<see method=TMathImage@ClearClipped> >
120
   to erase drawings.
121
   <B=Helper Objects> <Par>
122
   For drawing polylines in 2-D or 3-D use the following helper classes to store points:
123
   <LI=<see class=TFloatPointList> >           <LI=<see class=Td3FloatPointList> >
124
   <LI=<see class=TFloatPointListList> >       <LI=<see class=Td3FloatPointListList> >
125
   For storing points that define a 3-D surface use the <see class=TSurface> class.
126
   TMathImage can raise exceptions <see class=EMathImageError> and <see class=ESurfaceError>.
127
}
128
  EMathImageError = class(Exception);
129

130
{ ESurfaceError is raised whenever a value is being assigned to a nonexisting  <see class=TSurface> grid point, a color is being
131
   assigned to a nonexisting <see class=TColorSurface> gridpoint, or the corresponding are tried to be accessed.
132
}
133
  ESurfaceError = class(Exception);
134

135
{ Surface Object to be passed to <See Method=TMathImage@D3DrawSurface>. It's a matrix scheme of
136
  3D-Points (<see type=TSurfPoint>) Think of the surface being made up of cells whose
137
  corner (grid) points sit at location (i,j),)(i+1,j),(i,j+1),(i+1,j+1) in the scheme. Use
138
  <See method=TSurface@Make> to fill the scheme with 3D-Points of your surface.
139

140
  <B=Note:> TSurface Objects need to be created and freed as needed.
141
}
142
  TSurface = class(TObject)
143
  private
144
    fError: Boolean;
145
    fxm, fym: Integer;
146
    fDefaultFillColor, fDefaultWireColor: TColor;
147
    fFloatsurface: array of Td3FloatPointArray;
148
    fTriangles: TD3TriangleArray;
149
    fSurfaceCells: array of TD3SurfaceCell;
150
    fPrepared: Boolean;
151
    procedure GetTriangles;
152
  protected
153
    function GetWireColor(i, j: Integer): Pointer; virtual;
154
    function GetFillColor(i, j: Integer): Pointer; virtual;
155
  public
156
{ The Error property has been kept for backwards compatability. Its value is
157
   always false now. Unless you create a surface with xGrid<=0 or yGrid<=0, which would be very unlogical, it will be created OK. Another cause of
158
   error could be an out of memory because of too many grid points. I leave itto Delphi to trap those errors.
159
}  property Error: Boolean read fError;
160

161
{ Xmesh is the number of surface cells in x- (or i-) direction. There are Xmesh+1 grid points in this direction,
162
     numbered from i=0 to i=Xmesh.}
163
    property xMesh: Integer read fxm;
164

165
{ Ymesh is the number of surface cells in y- (or j-) direction. There are Ymesh+1 grid points in this direction,
166
      numbered from j=0 to j=Ymesh.
167
}   property yMesh: Integer read fym;
168

169
(* The Surface has (xgrid+1) by (ygrid+1) grid (matrix) points. grids number from 0 to xgrid etc.. 
170
  A created surface always has to be freed, too. *)   
171
constructor Create(xGrid, yGrid: Integer);
172

173
(* Assigns the point (x,y,z) to grid (i,j). *)
174
  procedure Make(i, j: Integer; x, y, z: MathFloat); virtual;
175

176
{:Returns the 3-D-point (<See Type=TD3FloatPoint>) at grid (i,j.) }
177
   function d3Point(i, j: Integer): TD3FloatPoint;
178

179
   procedure PrepareIllumination;
180

181
{ Frees the memory allocated by the surface object.}
182
    destructor Destroy; override;
183
  end;
184

185
{ TSurface descendent which can also store different colors. }
186
  TColorSurface = class(TSurface)
187
  private
188
    fColors: array of TColorArray;
189
  protected
190
    function GetFillColor(i, j: Integer): Pointer; override;
191
    function GetWireColor(i, j: Integer): Pointer; override;
192
  public
193
    constructor Create(xGrid, yGrid: Integer);
194
    destructor Destroy; override;
195
{ Assign the point (x,y,z) to grid location (i,j), and specify the color for this surface part.}
196
    procedure Make(i, j: Integer; x, y, z: MathFloat; Color: TColor); reintroduce; overload;
197
    function GetColor(i, j: Integer): TColor;
198
  end;
199

200
{ TSurface descendent which can be used for level color coded surface drawing.}
201
  TLevelSurface = class(TSurface)
202
  private
203
    fLevels: array of MathFloat;
204
    fColors: array of TColor;
205
    fNewPoints: array of PD3FloatPoint;
206
  public
207
    destructor Destroy; override;
208
{ Use this to set an array of z-levels at which the color of the surface
209
should change, together with an array of associated colors. Levels must be
210
in ascending order. Between Levels[i] and Levels[i+1] the color will be
211
Colors[i]. Levels higher than the max given level get the max given color, etc.
212
Levels and Colors must have the same length, or else both will be chopped to the
213
shortest. TLevelSurfaces can be passed to TMathImage.d3DrawSurface,
214
TMathImage.d3DrawLitSurface and TMathImage.DrawFilledLevelCurves.
215
}
216
    procedure SetLevels(const Levels: array of MathFloat; const Colors: array of TColor);
217
  end;
218

219
  TSurfaceCollection = class
220
  private
221
    fSurfaces: array of TSurface;
222
    fCount, fLength: Integer;
223
    fCells: array of TD3SurfaceCell;
224
    fTriangs: array of TD3Triangle;
225
    fprepared: boolean;
226
  public
227
    constructor Create;
228
    procedure add(const Surface: TSurface; FillColor, WireColor: TColor);
229
    procedure PrepareIllumination;
230
    property Count: Integer read fCount;
231
  end;
232

233
  THeightMap = class
234
  private
235
    fHeightArray: array of TFloatarray;
236
    fColors: array of TColorArray;
237
    fxm, fym: Integer;
238
  public
239
    constructor Create(xGrid, yGrid: Integer);
240
    property xMesh: Integer read fxm;
241
    property yMesh: Integer read fym;
242
    procedure Make(i, j: Integer; z: MathFloat; Color: TColor);
243
  end;
244

245
{:FloatPointList object to be passed to <See Method=TMathImage@DrawPolyline>.
246
   The intended use is to fill a FloatPointList object sequentially with
247
   pairs of number (float points) (see <See Method=TFloatPointList@Add>), then pass it to DrawPolyline
248
   to connect all points in the list sequentially by lines.
249
  <B=Note:> You have to create and free these lists as needed. }
250
  TFloatPointlist = class(TObject)
251
  private
252
    fCount, fLength: Integer;
253
    fFirstpoint, fCurrentpoint: PFloatPoint;
254
    fFloatArray: TFloatPointArray;
255
  public
256
{:Use to read the first point of the list. The type of FirstPoint is a pointer to <See Type=TFloatPoint>.}
257
    property FirstPoint: PFloatPoint read fFirstpoint;
258

259
{:Use to read the current(i.e. last) point. The type of CurrentPoint is a pointer to <See Type=TFloatPoint>.}
260
    property CurrentPoint: PFloatPoint read fCurrentpoint;
261

262
{:Use to read the number of points currently in the list. Note: not necessarily the same as length(Points)!}
263
    property Count: longint read fCount;
264

265
{:Use to access the points in the list as a dynamic array. Note that length(points)
266
might be larger than the number of meaningful points stored in the list. So always
267
use the count property as iteration delimiters.}
268
    property Points: TFloatPointArray read fFloatArray;
269

270

271
{:Increments the pointer p to point to the next item in the list.
272
Needed for somewhat of a backwards compatability. Instead of previously saying
273
p:=p.next you can now call p:=MyFloatPointList.NextPoint(p). The result is nil for the last point in
274
the list. Only use in connection with Firstpoint. }
275
    function NextPoint(p: PFloatPoint): PFloatPoint;
276
{ Create a list before you use it. Call MyList.free to deallocate its memory after use.}
277
    constructor Create;
278

279
{ Destroy a list after use. Each created list needs to be freed, too.}
280
    destructor Destroy; override;
281

282
{:Add a point (x,y) to the end of the list. }
283
    procedure add(x, y: MathFloat);
284

285
{:Copy AFloatPointList to this instance. AFloatPointList must have been
286
    created and is still around as another instance after assign. }
287
    procedure assign(AFloatPointList: TFloatPointlist); virtual;
288

289
  end;
290

291
  TGraphlist = array of TFloatPointlist;
292

293
{:FloatPointListList object: list of FloatPointLists. Intended to be passed to
294
  <See Method=TMathImage@DrawPolyPolyLine>. PolyPolyLines can have breaks in them.
295
  The points in each list form a Polyline. Use <See method=TFloatPointListList@Add>
296
  to add a new list (break). Use <See method=TFloatPointListList@AddToCurrent> to
297
  add a point at the end of the current (last) list.
298
  <B=Note:> You have to create and free this list class as needed;  }
299

300
  TFloatPointListList = class(TObject)
301
  private
302
    fCount, FTotalCount: longint;
303
    fgraphlist: TGraphlist;
304
    fFirstlist, fCurrentlist: TFloatPointlist;
305
  public
306
{:Returns the first point list}
307
    property FirstList: TFloatPointlist read fFirstlist;
308
{:Returns the current (i.e. last) list. }
309
    property CurrentList: TFloatPointlist read fCurrentlist;
310

311
{ You can use the Lists property to access the points in the listlist as
312
a dynamic array of TFloatPointArray ("double" dynamic array). }
313
    property Lists: TGraphlist read fgraphlist;
314
{:Returns the number of <B=lists>. }
315
    property Count: longint read fCount;
316
{:Returns the total number of points in all lists. }
317
    property TotalCount: longint read FTotalCount;
318
{ Create the list before you use it. Sublists are created
319
    automatically when you call <see property=TFloatPointListList@Add>.
320
    You need to call ..listlist.free when done. }
321
    constructor Create;
322
{ Deallocates memory for the listlist object. Called by free.
323
    Memory for all sub lists is automatically freed.}
324
    destructor Destroy; override;
325
{:Start a new point list. }
326
    procedure add;
327
{:Add the point (x,y) to the current (last) list.}
328
    procedure AddToCurrent(x, y: MathFloat);
329

330
  end;
331

332
{:D3FloatPointList object to be passed to <See Method=TMathImage@D3Polyline>.
333
   The intended use is to fill a D3FloatPointList object sequentially with
334
   triplets of numbers (D3-float points) (see <See Method=TD3FloatPointList@Add>), then pass it to D3DrawPolyline
335
   to   connect all points in the list sequentially by lines.
336

337
  <B=Note:> You have to create and free these lists as needed.}
338
  TD3FloatPointList = class(TObject)
339
  private
340
    fCount, fLength: Integer;
341
    fFirstpoint, fCurrentpoint: PD3FloatPoint;
342
    fFloatArray: Td3FloatPointArray;
343
    fLineSegmentArray: Td3LineSegmentArray;
344
    fPrepared: Boolean;
345
    fNormalKind: TNormalKind;
346
    procedure SetNormalKind(Value: TNormalKind);
347
  public
348

349
{:Use to read the first point of the list. The type of FirstPoint is a
350
    pointer to <See Type=TD3FloatPoint>. }
351
    property FirstPoint: PD3FloatPoint read fFirstpoint;
352

353
    {:Use to read the current(i.e. last) point. The type of CurrentPoint is a
354
    pointer to <See Type=TD3FloatPoint>.}
355
    property CurrentPoint: PD3FloatPoint read fCurrentpoint;
356
{:The count of points currently in the list. Note: not necessarily the same as
357
length(Points)! }
358
    property Count: longint read fCount;
359

360
{  Use the Points property to access the list of 3d points as a dynamic array. Its length might
361
be longer than the number of meaningful points, so always use the count property of
362
the list to delimit iterations.}
363
    property Points: Td3FloatPointArray read fFloatArray;
364

365
    property NormalKind: TNormalKind read fNormalKind write SetNormalKind;
366
    constructor Create;
367
    destructor Destroy; override;
368
{:Add a point (x,y) to the end of the list. }
369
    procedure add(x, y, z: MathFloat);
370
{:Copy AFloatPointList to this instance. If AFloatPointList isn't nil,
371
 it is still around as another instance after assign. }
372

373
{:Increments the pointer p to point to the next item in the list.
374
Needed for somewhat of a backwards compatability. Instead of previously saying
375
p:=p.next you can now call p:=Myd3FloatPointList.NextPoint(p). The result is nil for the last point in
376
the list. Only use in connection with Firstpoint. You've got to know what
377
you are doing here. }
378
    function NextPoint(p: PD3FloatPoint): PD3FloatPoint;
379
    procedure assign(AFloatPointList: TD3FloatPointList); virtual;
380
    procedure PrepareIllumination;
381
  end;
382

383
  TD3GraphList = array of TD3FloatPointList;
384

385

386
{:D3FloatPointListList object: list of D3FloatPointLists. Intended to be passed to
387
  <See Method=TMathImage@D3PolyPolyLine>. PolyPolyLines can have breaks in them.
388
  The points in each list form a Polyline. Use <See method=TD3FloatPointListList@Add>
389
  to add a new list (break). Use <See method=TD3FloatPointListList@AddToCurrent> to
390
  add a point at the end of the current (last) list.
391

392
  <B=Note:> You have to create and free this list class as needed;
393

394
  <B=Note:> The intended usage of the object is to sequentially fill it with the 1st, 2nd etc. list of points to be drawn.
395
    It you want more functionality (addressing a particular itemin the list, moving back & forth) (and slower performance) use a
396
    TList descendent instead, and fill a FloatpointListList with the points
397
    before drawing. Or use <See method=TMathImage@D3Window> on the points and do <See property=TMathImage@Canvas>.polyline's.}
398

399
  TD3FloatPointListList = class(TObject)
400
  private
401
    fCount, FTotalCount: longint;
402
    fgraphlist: TD3GraphList;
403
    fFirstlist, fCurrentlist: TD3FloatPointList;
404
    fNormalKind: TNormalKind;
405
    procedure SetNormalKind(Value: TNormalKind);
406
  public
407
    {:Returns the first point list   }
408
    property FirstList: TD3FloatPointList read fFirstlist;
409

410
    {:Returns the current (i.e. last) list.    }
411
    property CurrentList: TD3FloatPointList read fCurrentlist;
412

413
    {:Returns the number of <B=lists>.     }
414
    property Count: longint read fCount;
415

416
    {:Returns the total number of points in all lists.    }
417
    property TotalCount: longint read FTotalCount;
418

419
    property GraphList: TD3GraphList read fgraphlist;
420

421
    property NormalKind: TNormalKind read fNormalKind write SetNormalKind;
422

423
    constructor Create;
424
    destructor Destroy; override;
425
    {:Start a new point list.     }
426
    procedure add;
427
    {:Add the point (x,y,z) to the current (last) list.     }
428
    procedure AddToCurrent(x, y, z: MathFloat);
429

430
  end;
431

432
  { TMathImage is the main object in the MathImge unit. It is a TGraphicControl
433
   descendant and can as such be installed in the Delphi component palette. For
434
   general info see the <see=main> help topic. The component contains
435
   properties, methods and events for doing graphics in world coordinates. 2-D and
436
   3-D graphics are supported. Browse through the properties, methods and events to
437
   get an idea, or see the <see=overview>. Best way to learn is to look at the included demos.   }
438

439
  TMathImage = class(TOverlayImage)
440
  private
441
    maxth, maxxtw, maxytw: Integer;
442
    fClipRect: TRect;
443
    fVersion: string;
444
    Rotating, Zooming, Moving, FRecordMetafile: Boolean;
445
    FOnRotating, FOnEndRotate, FOnMoving, FOnEndMove,
446
      FOnZooming, FOnEndZoom: TNotifyEvent;
447
    fWorldDrawing: TCrackerDrawing;
448

449
    procedure SetVersion(x: string);
450
    procedure d3ResetWorld;
451
    procedure SetAxis(A: Boolean);
452
    procedure Setx1d2(x: MathFloat);             procedure Setxwd2(x: MathFloat);
453
    procedure Sety1d2(x: MathFloat);             procedure Setywd2(x: MathFloat);
454
    procedure Setx1d3(x: MathFloat);             procedure Sety1d3(x: MathFloat);
455
    procedure Setxwd3(x: MathFloat);             procedure Setywd3(x: MathFloat);
456
    procedure Setz1d3(x: MathFloat);             procedure Setzwd3(x: MathFloat);
457
    procedure Setvd(x: MathFloat);               procedure Setzrd3(x: MathFloat);
458
    procedure Setyrd3(x: MathFloat);             procedure Setalpha(x: MathFloat);
459
    procedure Setard3(x: Boolean);               procedure SetXscale(x: MathFloat);
460
    procedure SetYscale(x: MathFloat);           procedure SetZscale(x: MathFloat);
461
    procedure SetClipRect(Value: TRect);         procedure SetRecordMetafile(x: Boolean);
462
    function Getd2Worldx2: MathFloat;            function Getd2Worldy2: MathFloat;
463
    function Getd3Worldx2: MathFloat;            function Getd3Worldy2: MathFloat;
464
    function Getd3Worldz2: MathFloat;            function GetAxis: Boolean;
465
    function Getx1d2: MathFloat;                 function Getxwd2: MathFloat;
466
    function Gety1d2: MathFloat;                 function Getywd2: MathFloat;
467
    function Getx1d3: MathFloat;                 function Gety1d3: MathFloat;
468
    function Getxwd3: MathFloat;                 function Getywd3: MathFloat;
469
    function Getz1d3: MathFloat;                 function Getzwd3: MathFloat;
470
    function Getvd: MathFloat;                   function Getzrd3: MathFloat;
471
    function Getyrd3: MathFloat;                 function Getalpha: MathFloat;
472
    function Getard3: Boolean;                   function GetXscale: MathFloat;
473
    function GetYscale: MathFloat;               function GetZscale: MathFloat;
474
    { Private declarations, never mind }
475
  protected
476

477
    { Extra stuff to do when bounds of a TMathimage change.    }
478
    procedure SizeChanged; override;
479

480
    { Protected declarations }
481
{---------------------*********************************--------------------------}
482
{                               THE IMPORTANT STUFF                                                 }
483
{---------------------*********************************--------------------------}
484
  public
485

486
    { If true, space is reserved in a 2-D drawing to include axes. You need to call
487
    <see method=TMathImage@DrawAxes> in order to actually draw any. A call to DrawAxes
488
    automatically makes D2Axes true. So use this property if for some reason you want
489
    to draw the axes after the curves.     }
490
    property d2Axes: Boolean read GetAxis write SetAxis;
491

492
    { Upper bounds for D2world rectangle and D3world box.
493
    Those used to be published, but were causing unnecessary exceptions.
494
    They are kept as public and read only for backwards compatability.
495
    For the new published properties see <see property=TMathImage@D2WorldX1>,
496
    <See Property=TMathImage@D2WorldXW>, etc.     }
497
    property d2WorldX2: MathFloat read Getd2Worldx2;
498
    property d2WorldY2: MathFloat read Getd2Worldy2;
499
    property d3Worldx2: MathFloat read Getd3Worldx2;
500
    property d3Worldy2: MathFloat read Getd3Worldy2;
501
    property d3Worldz2: MathFloat read Getd3Worldz2;
502

503
    { Intended to be able to set the current clip rectangle. Not really implemented so far,
504
                    except for clipping the region within axes. }
505
    property ClipRect: TRect read fClipRect write SetClipRect;
506
  
507
    constructor Create(AOwner: TComponent); override;
508
    destructor Destroy; override;
509

510
    { Erases the current drawing and sets the background to the current
511
    <see property=TOverlayImage@brush> color.     }
512
    procedure Clear; //reintroduce; overload;
513

514
    { Erases the area inside of the axes in a 2-D drawing.     }
515
    procedure ClearClipped;
516

517
    {The following are the methods for 2-d graphing}
518

519
    { Set the world range of a 2-D drawing in one step
520
    (to be preferred at runtime). x1,y1 are the lower bounds
521
    of the world rectangle, x2,y2 are the <B=upper bounds>.
522
    If x2<<=x1 or y2<<=y1, an exception is raised.
523
     <par>
524
     Compare to published properties <see property=TMathImage@D2Worldx1>,
525
     <see property=TMathImage@D2Worldxw>, etc., where D2WorldxW is
526
     the <B=x-width> of the world rectangle.
527
     }
528
    procedure SetWorld(x1, y1, x2, y2: MathFloat);
529

530

531
    { Short(?) for <See property=TOverlayImage@pen>.color:=color.
532
    Has been kept for compatability.
533
    }
534
    procedure SetColor(Color: TColor);
535

536
    { Short(?) for result:=<See property=TOverlayImage@pen>.color.
537
    Has been kept for compatability.
538
    }
539
    function GetColor: TColor;
540

541

542
    { In 2-D, translates world coordinate x to pixel-x.
543
    Main use is internally.
544
    }
545
    function Windowx(x: MathFloat): longint;
546

547
    { In 2-D, translates world coordinate y to pixel-y. Main use
548
    is internally.
549
    }
550
    function Windowy(y: MathFloat): longint;
551

552
    procedure WorldToScreen(const x, y: MathFloat; var xs, Ys: Integer);
553

554
    { In 2-D, translates pixel coordinate xs to world-x. Useful for reading the world
555
    coordinates of a clicked point, or a point the mouse is over.
556
    }
557
    function WorldX(xs: longint): MathFloat;
558

559
    { In 2-D, translates pixel coordinate ys to world-y. Useful for reading the world
560
    coordinates of a clicked point, or a point the mouse is over.
561
    }
562
    function WorldY(Ys: longint): MathFloat;
563

564
    { Length of vector (x,y).
565
    }
566
    function Norm(x, y: MathFloat): MathFloat;
567

568
    { Puts a pixel with world coordinates (x,y) on the screen. Color
569
    is the currently selected <see property=TOverlayImage@Pen> color.
570
    }
571
    procedure DrawPoint(x, y: MathFloat);
572

573
    { Moves the graphics cursor to the point with D2-world coordinates (x,y).
574
    }
575
    procedure MoveToPoint(x, y: MathFloat);
576

577
    { Draws a line from (x1,y1) to (x2,y2) in D2-world coordinates.
578
    Both end pixels are drawn, in contrast to a <see method=TMathImage@MovetoPoint>-
579
    <see method=TMAthImage@DrawLineto> combination.
580
    }
581
    procedure DrawLine(x1, y1, x2, y2: MathFloat);
582

583
    { Draws a line from the current graphics cursor position
584
    (see <see method=TMathImage@MovetoPoint>) to
585
   point (x,y) in D2-world coordinates. DrawLineto never draws
586
   the endpixel (Win-default).
587
   }
588
    procedure DrawLineTo(x, y: MathFloat);
589

590
    { Draws an ellipse in the D2-world rectangle between (x1,y1) (lower left)
591
     and (x2,y2) (upper right) and fills it with the current brush.
592
     }
593
    procedure DrawEllipse(x1, y1, x2, y2: MathFloat);
594

595
    procedure DrawCircle(xCenter, yCenter: MathFloat; PixRadius: Integer);
596

597
    { Draws a D2-world rectangle between (x1,y1) (lower left)
598
     and (x2,y2) (upper right) and fills it with the current brush.
599
     }
600
    procedure DrawRectangle(x1, y1, x2, y2: MathFloat);
601

602

603
    { Puts axes at the left and bottom boundary of the drawing. Ticks and
604
     labelling of numeric values are done automatically. xlabel, ylabel is
605
     text that goes to the end of the axes. Zerolines=true draws lines x=0,
606
     y=0. Axescolor,ZerolinesColor are selfexplaining.
607
     }
608
    procedure DrawAxes(xLabel, yLabel: string;
609
      ZeroLines: Boolean;
610
      AxesColor, ZeroLinesColor: TColor; Arrows: Boolean = True);
611

612
    { Draws a vector (a,b) at base point(x,y) (D2-world).
613
    }
614
    procedure DrawVector(x, y, A, b: MathFloat);
615

616
    { Draws a curve by sequentially connecting the points in FloatPointList.
617
    Faster than individual lines. See <See type=TFloatPointList>.
618
    <B=Note:> Win95/98 GDI only accepts up to 16320 points for a polyline.
619
    }
620
    procedure DrawPolyline(FloatPointList: TFloatPointlist);
621

622
    { Draws a curve connecting the points in FloatPointList, closes the
623
    shape and fills it with the current brush. See <See type=TFloatPointList>.
624
    }
625
    procedure DrawPolygon(FloatPointList: TFloatPointlist);
626

627

628
    { Draws all point lists in the ListList as Polylines. Use if you want to draw curves
629
    with "breaks". See <See type=TFloatPointListList>.
630
    <B=Note:> Win95/98 GDI only accepts up to 16320 points for a polygon.
631
    }
632
    procedure DrawPolyPolyline(FloatPointListList: TFloatPointListList);
633

634

635

636
   {D3Graphics procedures:}
637

638
    { Sets all D3-world bounds in one step. *1 are the lower bounds, *2 the <B=upper bounds>.
639
    Lower bounds must be strictly less than upper bounds.
640
    This method is to be preferred at run time over using the published properties <see Property=TMathImage@D3Worldx1>, etc..
641
    Notice the difference: Using the published properties, you need to set the <B=width> of the
642
    world instead of the upper bound.     }
643
    procedure d3SetWorld(x1, y1, z1, x2, y2, z2: MathFloat);
644

645
    { This procedure translates D3-world-(x,y,z) to pixel-(xs,ys), using the current
646
    world bounds, view distance, view angle and view point location. Mostly for internal use.    }
647
    procedure d3Window(x, y, z: MathFloat; var xs, Ys: longint);
648

649
{ Returns 3D-world coordinates x,y,z for screen coordinates xs,ys, assuming that (x,y,z)
650
       lies in the plane through the center of the world pependicular to the viewer's direction.
651
     Can be used in a limited way to "Click on a point" in the 3D-world. See DataPlot demo part.     }
652
    procedure PseudoD3World(xs, Ys: longint; var x, y, z: MathFloat);
653

654
    { Moves the graphics cursor to the point with D3-world coordinates (x,y,z).    }
655
    procedure d3Moveto(x, y, z: MathFloat);
656

657
    { Puts a pixel with D3-world coordinates (x,y,z) on the screen. Color
658
    is the currently selected <see property=TMathImage@Pen> color.   }
659
    procedure d3DrawPoint(x, y, z: MathFloat);
660

661
    { Draws a line from (x1,y1,z1) to (x2,y2,z2) in D3-world coordinates.
662
    Both end pixels are drawn, in contrast to a <see method=TMathImage@D3Moveto>-
663
    <see method=TMAthImage@D3DrawLineto> combination.
664
    }
665
    procedure d3DrawLine(x1, y1, z1, x2, y2, z2: MathFloat);
666

667
    { Draws a line from the current graphics cursor position
668
    (see <see method=TMathImage@d3Moveto>) to
669
   point (x,y,z) in D3-world coordinates. DrawLineto never draws
670
   the endpixel (Win-default).
671
   }
672
    procedure d3DrawLineto(x, y, z: MathFloat);
673

674

675
    { Draws axes at the bondary of the world box
676
    and puts xlabel,ylabel,zlabel on their ends.
677
    xticks,yticks,zticks specify the number of ticks on the axes. Each
678
    can be set to 0.
679
    xpos,ypos,zpos specifies the position of the axis. These parameters
680
    can have the values MinMin(=0), MinMax(=1) or MaxMax(=2).
681
    A position MinMin places the axis at the minimum of both of the
682
    remaining variables. MinMax places it at the minimum/maximum of
683
    the other variables (alphabetical order), etc.
684
    Example: If your D3-World is (-1,-1,-1,1,1,1) then
685
    D3DrawAxes('x','y','z',4,4,4,MinMin,MaxMin,MinMin) draws axes with
686
    (about) 4 ticks. The x-axis is displayed along the line y=z=-1,
687
    the y-axis along x=1,z=-1, and the z-axis along x=y=-1.
688
    }
689
    procedure d3DrawAxes(xLabel, yLabel, zLabel: string;
690
      xTicks, yTicks, zTicks, xPos, yPos, zPos: byte; Arrows: Boolean = True);
691

692
    procedure d3DrawBestAxes(xLabel, yLabel, zLabel: string;
693
      xTicks, yTicks, zTicks: byte; Arrows: Boolean = True);
694

695
   {Draws axes centered at (xmin,ymin,zmin)extending to (xmax,ymax,zmax),  without ticks.}
696
    procedure d3DrawCustomAxes(xmin, ymin, zmin, xmax, ymax, zmax: MathFloat;
697
                                         xLabel, yLabel, zLabel: string);
698

699
  { Draws the box the current D3-world resides in as a wire frame, with the 3 sides facing
700
    the viewer left open. Also see <see property=TMAthImage@d3DrawFullWorldBox>.}
701
    procedure d3DrawWorldbox;
702

703
 { Draws a wire frame box between D3-points(x1,y1,z1) (lower) and(x2,y2,z2) (upper).    }
704
    procedure d3DrawBox(x1, y1, z1, x2, y2, z2: MathFloat);
705

706
 { Draws the full box the 3D-world resides in as a wire frame. see <see property=TMAthImage@d3DrawWorldBox>.    }
707
    procedure d3DrawFullWorldBox;
708

709
 { In 3-D, draws lines x=y=0, x=z=0, y=z=0.    }
710
    procedure d3drawZeroCross;
711

712
{ Draws a 3D-curve by sequentially connecting the points in FloatPointList.
713
           Faster than individual lines. See <See type=TD3FloatPointList>.
714
    <B=Note:> Win95/98 GDI only accepts up to 16320 points for a polyline.   }
715
    procedure d3Polyline(FloatPointList: TD3FloatPointList);
716

717
    procedure d3LitPolyLine(FloatPointList: TD3FloatPointList; diffuse, focussed, RightIntensity: MathFloat;
718
      zrot1, zrot2, yrot1, yrot2: Integer; dist1, dist2: MathFloat; fixed: Boolean);
719

720
{Draws all point lists in the ListList as Polylines. Use if you want to draw curves
721
    with "breaks". See <See type=TD3FloatPointListList>.    }
722
    procedure d3PolyPolyline(FloatPointListList: TD3FloatPointListList);
723

724
    procedure d3LitPolyPolyline(FloatPointListList: TD3FloatPointListList; diffuse, focussed, RightIntensity: MathFloat;
725
      zrot1, zrot2, yrot1, yrot2: Integer; dist1, dist2: MathFloat; fixed: Boolean);
726

727
 { Rotates the viewpoint (not the object) to the left in the specified angle increment at a time. Note: The rotation goes
728
     on until you call <see method=TMathImage@d3StopRotating> in some event handler (like OnMouseUp).
729
     The event <see property=TMathImage@OnRotating> fires at each increment. Use it to
730
     make rotating visible. See the demo project for usage.      }
731
    procedure d3StartRotatingLeft(Increment: MathFloat);
732

733
    { Rotates the viewpoint (not the object) to the right in the specified angle increment at a time. Note: The rotation goes
734
     on until you call <see method=TMathImage@d3StopRotating> in some event handler (like OnMouseUp).
735
     The event <see property=TMathImage@OnRotating> fires at each increment. Use it to
736
     make rotating visible. See the demo project for usage.
737

738
     <B=Caution:> This method calls Application.ProcessMessages. You need to make sure that this
739
     does not lead to unwanted user input while the method executes.     }
740
    procedure d3StartRotatingRight(Increment: MathFloat);
741

742
    { Rotates the viewpoint (not the object) up in the specified angle increment at a time. Note: The rotation goes
743
     on until you call <see method=TMathImage@d3StopRotating> in some event handler (like OnMouseUp).
744
     The event <see property=TMathImage@OnRotating> fires at each increment. Use it to
745
     make rotating visible. See the demo project for usage.
746
     <B=Caution:> This method calls Application.ProcessMessages. You need to make sure that this
747
     does not lead to unwanted user input while the method executes.    }
748
    procedure d3StartRotatingUp(Increment: MathFloat);
749

750
 { Rotates the viewpoint (not the object) down in the specified angle increment at a time. Note: The rotation goes
751
     on until you call <see method=TMathImage@d3StopRotating> in some event handler (like OnMouseUp).
752
     The event <see property=TMathImage@OnRotating> fires at each increment. Use it to
753
     make rotating visible. See the demo project for usage.
754

755
     <B=Caution:> This method calls Application.ProcessMessages. You need to make sure that this
756
     does not lead to unwanted user input while the method executes.      }
757
    procedure d3StartRotatingDown(Increment: MathFloat);
758

759
{ This method must be called to stop any rotation started by the methods
760
    <see method=TMathImage@d3StartRotatingLeft>, <see methode=TMAthImage@d3StartRotatingRight>,
761
    <see method=TMathImage@d3StartRotatingUp> and <see method=TMathimage@d3StartRotatingDown>.
762
    The Event <see property=TMathImage@OnRotateStop> fires, so you can redraw your picture as necessary.
763
    See demo project for usage.      }
764
    procedure d3StopRotating;
765

766
{ Decreases the viewdistance by by increment*<see property=TMathImage@d3ViewDist> at a time.
767
    (Relative decrease makes more sense).
768
     Note: The moving goes  on until you call <see method=TMathImage@d3StopMoving> in some event handler (like OnMouseUp).
769
     The event <see property=TMathImage@OnMoving> fires at each increment. Use it to
770
     make moving visible. See the demo project for usage.
771

772
     <B=Caution:> This method calls Application.ProcessMessages. You need to make sure that this
773
     does not lead to unwanted user input while the method executes.      }
774
    procedure d3StartMovingIn(Increment: MathFloat);
775

776
{ Increases the viewdistance by by increment*<see property=TMathImage@d3ViewDist> at a time.
777
    (Relative increase makes more sense).
778
     Note: The moving goeson until you call <see method=TMathImage@d3StopMoving> in some event handler (like OnMouseUp).
779
     The event <see property=TMathImage@OnMoving> fires at each increment. Use it to
780
     make moving visible. See the demo project for usage.
781

782
     <B=Caution:> This method calls Application.ProcessMessages. You need to make sure that this
783
     does not lead to unwanted user input while the method executes.    }
784
    procedure d3StartMovingOut(Increment: MathFloat);
785

786
{ This method must be called to stop any moving started by the methods
787
    <see method=TMathImage@d3StartMovingIn> or <see methode=TMAthImage@d3StartMovingOut>.
788
    The event <see property=TMathImage@OnMoveStop> fires, so you can redraw your picture as necessary.
789
    See demo project for usage.      }
790
    procedure d3StopMoving;
791

792
{ Decreases the view angle by by increment*<see property=TMathImage@d3ViewAngle> at a time.
793
    (Relative decrease makes more sense).
794
     Note: The zooming goes on until you call <see method=TMathImage@d3StopZooming> in some event handler (like OnMouseUp).
795
     The event <see property=TMathImage@OnZooming> fires at each increment. Use it to
796
     make zooming visible. See the demo project for usage.       }
797
    procedure d3StartZoomingIn(Increment: MathFloat);
798

799
{ Increases the view angle by by increment*<see property=TMathImage@d3ViewAngle> at a time.
800
    (Relative increase makes more sense).
801
     Note: The zooming goes  on until you call <see method=TMathImage@d3StopZooming> in some event handler (like OnMouseUp).
802
     The event <see property=TMathImage@OnZooming> fires at each increment. Use it to
803
     make zooming visible. See the demo project for usage.
804

805
     <B=Caution:> This method calls Application.ProcessMessages. You need to make sure that this
806
     does not lead to unwanted user input while the method executes.      }
807
    procedure d3StartZoomingOut(Increment: MathFloat);
808

809
{ This method must be called to stop any zooming started by the methods
810
    <see method=TMathImage@d3StartZoomingIn> or <see methode=TMAthImage@d3StartZoomingOut>.
811
    The event <see property=TMathImage@OnZoomStop> fires, so you can redraw your picture as necessary.
812
    See demo project for usage.   }
813
    procedure d3StopZooming;
814

815
{SURFACE ROUTINES}
816

817
{ Draw a surface (a 2-dimensional curved object, like a graph or a sphere)
818
    in the 3-D-world. Surface (see <see type=TSurface>)  must have been created and
819
    filled with the world coordinates of the gridpoints.
820
    Fill=false gives a wire frame in the current pen color,
821
    Fill=true displays it filled , invisible parts hidden.
822
    The fill coloring depends on the type of surface you
823
    pass. Just a plain TSurface gets filled with the current
824
    brush color. A TColorSurface displays its cells with the
825
    colors you have spedified. A TLevelSurface does not work any different
826
    from a TSurface here. To see those nicely, use d3DrawLitSurface.
827
    NoUpdate=true/false: Has no effect presently, as the implementation
828
    of this feature was too unsafe.
829
    See demo project for usage. It's easiest to first understand how the
830
    graph is drawn. The knot surface is only there to show off the      possibilities.    }
831
    procedure d3DrawSurface(Surface: TSurface; fill, NoUpdate: Boolean);
832

833
    { Analogous to the <see method=TMathimage@d3DrawSurface> procedure,
834
    but lighting is used to display the
835
    filled surface, and no wireframe is drawn. There are 2 light sources:
836
    Diffuse light, which lights up the whole surface evenly, and focussed
837
    light which is a beam having its source at the viewpoint (thats easiest
838
    and enough to see the surface). Coloring depends on the Surface type
839
    you pass. A plain TSurface gets the basecolor of the current brush color.
840
    A TColorSurface or a TLevelSurface get drawn according to the colors
841
    you have specified for them.
842
    Diffuse, focussed set the strength of the light
843
    sources. A total strength 1 displays the exact brush color on a
844
    maximally lit surface part (one that's perpendicular to the view direction).
845
    }
846
    procedure d3DrawLitSurface
847
      (Surface: TSurface; diffuse, focussed: MathFloat; NoUpdate: Boolean = True);
848

849
    procedure d3DrawSurfaceCollection(Surfaces: TSurfaceCollection;
850
      fill: Boolean);
851

852
    procedure d3DrawLitSurfaceCollection(Surfaces: TSurfaceCollection; ambient, focussed: MathFloat);  
853

854
    { Draw blocks within the grid which have height given by the heightmap
855
    data. Doesn't really work yet.
856
    }
857
    procedure d3DrawHeightCubes(HeightMap: THeightMap);
858

859
    { Draw blocks within the grid which have height given by the heightmap
860
    data. Doesn't really work yet.
861
    }
862
    procedure d3DrawLitHeightCubes(HeightMap: THeightMap; diffuse, focussed: MathFloat);
863

864
    { Draws a cube with lower  edge (x1,y1,z1) und upper edge (x2,y2,z2). It is
865
    necessary that x1<<x2, y1<<y2, z1<<z2. Fill=true fills the sides with the current
866
     brush color. Fill=false is the same as <see method=TMathImage@d3DrawBox>.      }
867
    procedure d3DrawCube(x1, y1, z1, x2, y2, z2: MathFloat; fill: Boolean);
868

869

870

871
    { Draws all level curves (contours) of the given surface <see class=TSurface>
872
    for the z-level passed in level. Note that you can pass a TSurface or any descendent.    }
873
    procedure DrawLevelCurves(Surface: TSurface; Level: MathFloat);
874

875
    { Fills points (x,y) whose z-level is between levels[k] and levels[k+1] with
876
    color colors[k].       }
877
    procedure DrawFilledLevelCurves(LevelSurface: TLevelSurface);
878
  published
879
    property Align;
880
    property Hint;
881
    property ShowHint;
882
    property ParentShowHint;
883
    property PopupMenu;
884
    property Visible;
885
{ Fake property to display the version of the component in the object inspector. }
886
    property Version: string read fVersion write SetVersion;
887

888
 { When set true, this property causes a metafile to be recorded in the background,
889
    on which the same drawing operations are performed as in the visible component. Recording a metafile
890
    slows down drawing a little. Metafiles have advantages over bitmaps in that they scale better, and
891
    give better printouts. To further enhance the quality, metafiles are being written at twice the resolution
892
    of the visible drawing. This option is not available under Delphi 1.     }
893
    property RecordMetafile: Boolean read FRecordMetafile write SetRecordMetafile;
894

895
{ The properties D2WorldX1, D2WorldXW, D2WorldY1, D2WorldYW set the
896
    boundary for the 2-d-drawing world. Analogous to the top, left, width, height properties of a control, you set the left
897
    boundary of the world with D2WorldX1 and the width of the x-range with
898
    D2WorldXW etc...     }
899
    property d2WorldX1: MathFloat read Getx1d2 write Setx1d2;
900
    property d2WorldXW: MathFloat read Getxwd2 write Setxwd2;
901
    property d2WorldY1: MathFloat read Gety1d2 write Sety1d2;
902
    property d2WorldYW: MathFloat read Getywd2 write Setywd2;
903
    { <New topic=D3_Graphics_Explanation@D3 Graphics Explanation>
904
    <B=Explanation of the 3D-graphics process:>
905

906
     When graphed,the world box is scaled so its longest edge has length 2, and
907
     the other edges have lengthes according to the true aspect ratio of
908
     the bounds you specify. If you set the property <see property=TMathImage@D3AspectRatio>
909
     to false, the edges have all the same length 2. The box is then projected onto the
910
     picture according to the settings of <see property=TMathimage@D3ViewDist>,
911
     <see property=TMathImage@D3ViewAngle>, <see property=TMathImage@D3Zrotation>,
912
     <see property=TMathImage@D3Yrotation> as follows:
913

914
     Everything is projected from the viewer location onto
915
     the plane through the center of the box which is perpendicular to the
916
     viewer direction. The part of the plane which you see, is what the
917
     view angle can sweep out from the view distance. The viewpoint moves on
918
     a spherical grid around the center of the world box, with the north and
919
     south poles of the sphere along the z-axis. The viewer always looks
920
     at the center of the box, and can't tilt her head.., enough for my math applications.     }
921
{ D3WorldX1, D3WorldY1, D3WorldZ1 and D3WorldXW, D3WorldYW, D3WorldZW set
922
     the boundaries for the 3-d-drawing world. ...X1 etc. is the
923
    lower bound, ...XW etc. is the range <B=width>. It's analogous to setting
924
    the left, top, width, height properties of a control.
925
    See <See=D3_Graphics_Explanation>     }
926
    property d3WorldX1: MathFloat read Getx1d3 write Setx1d3;
927
    property d3WorldXW: MathFloat read Getxwd3 write Setxwd3;
928
    property d3WorldY1: MathFloat read Gety1d3 write Sety1d3;
929
    property d3WorldYW: MathFloat read Getywd3 write Setywd3;
930
    property d3WorldZ1: MathFloat read Getz1d3 write Setz1d3;
931
    property d3WorldZW: MathFloat read Getzwd3 write Setzwd3;
932
    { If D3AspectRatio is true, these are scale factors for the D3-world display.  }
933
    property d3Xscale: MathFloat read GetXscale write SetXscale;
934
    property d3Yscale: MathFloat read GetYscale write SetYscale;
935
    property d3Zscale: MathFloat read GetZscale write SetZscale;
936
{ Angle of viewpoint with the x-axis. ("How much it's rotated
937
     about the z-axis", I know it's a bad name, but can't change it now.))    }
938
    property d3Zrotation: MathFloat read Getzrd3 write Setzrd3;
939
{ Angle of viewpoint with the z-axis. ("How much the viewpoint is
940
     rotated about the y-axis". Bad name, sorry.)       }
941
    property d3Yrotation: MathFloat read Getyrd3 write Setyrd3;
942
{ Uniformly scaled distance of the viewpoint to the center of the d3-world.
943
     See <see=D3_Graphics_Explanation>      }
944
    property d3ViewDist: MathFloat read Getvd write Setvd;
945

946
{ Opening angle of the lens of the viewpoint. Large D3ViewAngle combined with
947
     small <see property=TMathImage@D3ViewDist> give a fish eye effect. The opposite gives almost no perspective
948
     effect at all.      }
949
    property d3ViewAngle: MathFloat read Getalpha write Setalpha;
950
{ When true (default) the true aspect ratio of the data axes
951
    is used for the worldbox (modulo scaling factors). Otherwise,
952
    the box is a perfect cube.     }
953
    property d3AspectRatio: Boolean read Getard3 write Setard3;
954
    { Events}
955
    property OnClick;
956
    property OnDblClick;
957
    property OnDragDrop;
958
    property OnDragOver;
959
{$IFDEF Ver120}
960
    property OnEndDock;
961
{$ENDIF}
962
{$IFDEF Ver130}
963
    property OnEndDock;
964
{$ENDIF}
965
    property OnEndDrag;
966
    property OnMouseDown;
967
    property OnMouseMove;
968
    property OnMouseUp;
969
    property OnStartDrag;
970
    { Event which fires at each increment of the angle in
971
     <see method=TMathImage@D3StartRotatingLeft>, etc.. Use
972
     it to update you drawing or part of it, to make rotation visible.
973
     <B=Note:> The event is not called when you just
974
     alter values of <see property=TMathImage@D3ZRotation>, etc.        }
975
    property OnRotating: TNotifyEvent read FOnRotating write FOnRotating;
976
    { Event which fires in <see method=TMAthImage@D3StopRotating>. Use it
977
    to redraw everything after the rotation is complete.     }
978
    property OnRotateStop: TNotifyEvent read FOnEndRotate write FOnEndRotate;
979
    { Event which fires at each increment in <see method=TMathImage@D3StartMovingIn>
980
    and  -Out. Use it to update your drawing, or part of it, to make moving
981
    visible.
982

983
    <B=Note:> The event does not fire
984
    when you justchange <see property=TMathImage@D3Viewdist>.     }
985
    property OnMoving: TNotifyEvent read FOnMoving write FOnMoving;
986
    { Event which fires in <see method=TMAthImage@D3StopMoving>. Use it
987
    to redraw everything after the move in/out is complete.      }
988
    property OnMoveStop: TNotifyEvent read FOnEndMove write FOnEndMove;
989
    { Event which fires at each increment in <see method=TMathImage@D3StartZoomingIn>
990
    and  -Out. Use it to update your drawing, or part of it, to make zooming
991
    visible.
992
    <B=Note:> The event does not fire
993
    when you justchange <see property=TMathImage@D3ViewAngle>.        }
994
    property OnZooming: TNotifyEvent read FOnZooming write FOnZooming;
995
    { Event which fires in <see method=TMAthImage@D3StopZooming>. Use it
996
    to redraw everything after the zoom in/out is complete.      }
997
     { <New topic=Thanks@Thanks>
998
     <B=Thanks:><par><par>
999
     Team-B at the Compuserve Delphi Forum, and later at the Borland News Groups,
1000
     for donating part of their free time to giving incredibly accurate and knowledgable help
1001
     to all of us Delphi users. I am particularly indepted for critical pointers to (in no particular order)
1002
     Steve Schafer, Kurt Bartholomess, Ralph Friedman, Peter Below, Rick Rogers.
1003
     <par>
1004
     Also thanks for innumerable tips from other fellow users. Very special thanks go to Earl F. Glynn,
1005
     Sergey Prilutski, Robert Rossmair, KH. Brenner and Rene Tschaggeler for graphics specific pointers.
1006
     <par>
1007
     To Atanas Stoyanov for making his MemProof program available for free. It helped to find memory leaks in the component.
1008
     <par>
1009
     For GpProfile (Primoz Gabrijelcic/Open Source) This profiler helped
1010
     to speed up things.
1011
     <par>
1012
     To Robert Lee for floating point specific speed improvement.
1013
     <par>
1014
     To Piero Valagussa for his free help creator, which translated the commented component interface into
1015
     a component help file.
1016
     <par>
1017
     To Egbert van Nes for his great free source formatter DelForExp. Having been very source code sloppy,
1018
     it improved things a lot, I think.
1019
     <par>
1020
     last but most important
1021
     <par>
1022
     To all <B=Component Users> who pointed out flaws and asked for new features.
1023
     }
1024
    property OnZoomStop: TNotifyEvent read FOnEndZoom write FOnEndZoom;
1025
    {analogous}
1026
  end;
1027

1028
const
1029
  {:constants for D3-axes-positions     }
1030
  MinMin = 0; MinMax = 1; MaxMin = 2; MaxMax = 3;
1031

1032

1033
procedure Register;
1034

1035
//============================================
1036
implementation
1037
//============================================
1038

1039

1040
procedure Register;
1041
begin
1042
  RegisterComponents('MathStuff', [TMathImage]);
1043
end;
1044

1045

1046
{TSurface}
1047

1048

1049
procedure TSurface.GetTriangles;
1050
var i, j, Current: Integer;
1051
begin
1052
  SetLength(fTriangles, 2 * fxm * fym);
1053
  Current := 0;
1054
  for i := 0 to fxm - 1 do
1055
    for j := 0 to fym - 1 do
1056
    begin
1057
      if not (odd(i) or odd(j)) or (odd(i) and odd(j)) then
1058
      begin
1059
        with fTriangles[Current] do
1060
        begin
1061
          p := @fFloatsurface[i][j];
1062
          q := @fFloatsurface[i + 1][j];
1063
          r := @fFloatsurface[i][j + 1];
1064
          FillColor := GetFillColor(i, j);
1065
          WireColor := GetWireColor(i, j);
1066
        end;
1067
        inc(Current);
1068
        with fTriangles[Current] do
1069
        begin
1070
          p := @fFloatsurface[i + 1][j + 1];
1071
          q := @fFloatsurface[i + 1][j];
1072
          r := @fFloatsurface[i][j + 1];
1073
          FillColor := GetFillColor(i, j);
1074
          WireColor := GetWireColor(i, j);
1075
        end;
1076
        inc(Current);
1077
      end
1078
      else
1079
      begin
1080
        with fTriangles[Current] do
1081
        begin
1082
          p := @fFloatsurface[i][j];
1083
          q := @fFloatsurface[i][j + 1];
1084
          r := @fFloatsurface[i + 1][j + 1];
1085
          FillColor := GetFillColor(i, j);
1086
          WireColor := GetWireColor(i, j);
1087
        end;
1088
        inc(Current);
1089
        with fTriangles[Current] do
1090
        begin
1091
          p := @fFloatsurface[i + 1][j];
1092
          q := @fFloatsurface[i + 1][j + 1];
1093
          r := @fFloatsurface[i][j];
1094
          FillColor := GetFillColor(i, j);
1095
          WireColor := GetWireColor(i, j);
1096
        end;
1097
        inc(Current);
1098
      end;
1099
    end;
1100
end;
1101

1102

1103
constructor TSurface.Create(xGrid, yGrid: Integer);
1104
var
1105
  i, j, Current: Integer;
1106
begin
1107
  inherited Create;
1108
  fxm := xGrid; fym := yGrid;
1109
  SetLength(fFloatsurface, xGrid + 1);
1110
  for i := 0 to xGrid do
1111
    SetLength(fFloatsurface[i], yGrid + 1);
1112
  GetTriangles;
1113
  fPrepared := False;
1114
  SetLength(fSurfaceCells, xGrid * yGrid);
1115
  Current := 0;
1116
  for i := 0 to xGrid - 1 do
1117
    for j := 0 to yGrid - 1 do
1118
    begin
1119
      fSurfaceCells[Current].p := @fFloatsurface[i][j];
1120
      fSurfaceCells[Current].q := @fFloatsurface[i + 1][j];
1121
      fSurfaceCells[Current].r := @fFloatsurface[i + 1][j + 1];
1122
      fSurfaceCells[Current].s := @fFloatsurface[i][j + 1];
1123
      fSurfaceCells[Current].FillColor := @fDefaultFillColor;
1124
      fSurfaceCells[Current].WireColor := @fDefaultWireColor;
1125
      inc(Current);
1126
    end;
1127
end;
1128

1129
procedure TSurface.Make(i, j: Integer; x, y, z: MathFloat);
1130
begin
1131
  if (i >= 0) and (i <= fxm) and (j >= 0) and (j <= fym)
1132
    then
1133
  begin
1134
    D3FloatPoint(x, y, z, fFloatsurface[i][j]);
1135
  end else
1136
    raise ESurfaceError.Create('Surface gridpoint does not exist');
1137
  fPrepared := False;
1138
end;
1139

1140
function TSurface.d3Point(i, j: Integer): TD3FloatPoint;
1141
begin
1142
  if (i >= 0) and (i <= fxm) and (j >= 0) and (j <= fym) then
1143
    Result := fFloatsurface[i][j]
1144
  else
1145
  begin
1146
    D3FloatPoint(0, 0, 0, Result);
1147
    raise ESurfaceError.Create('Surface Gridpoint does not exist');
1148
  end;
1149
end;
1150

1151
destructor TSurface.Destroy;
1152
begin
1153
  //if Win32Platform = VER_PLATFORM_WIN32_NT then
1154
    //SetProcessWorkingSetSize(GetCurrentProcess, DWORD(-1), DWORD(-1));
1155
  inherited Destroy;
1156
end;
1157

1158
procedure TSurface.PrepareIllumination;
1159
var i: Integer;
1160
begin
1161
  for i := 0 to High(fTriangles) do
1162
    with fTriangles[i] do
1163
      CrossProduct(p.x - r.x, p.y - r.y, p.z - r.z, q.x - r.x, q.y - r.y, q.z - r.z, n.x, n.y, n.z);
1164
  fPrepared := True;
1165
end;
1166

1167
function TSurface.GetFillColor(i, j: Integer): Pointer;
1168
begin
1169
  Result := @fDefaultFillColor;
1170
end;
1171

1172
function TSurface.GetWireColor(i, j: Integer): Pointer;
1173
begin
1174
  Result := @fDefaultWireColor;
1175
end;
1176

1177
{TFloatPointList}
1178

1179
constructor TFloatPointlist.Create;
1180
begin
1181
  inherited Create;
1182
  SetLength(fFloatArray, 500);
1183
  fLength := 500;
1184
  fFirstpoint := nil;
1185
  fCount := 0;
1186
  fCurrentpoint := nil;
1187
end;
1188

1189
procedure TFloatPointlist.add(x, y: MathFloat);
1190
var p: TFloatpoint;
1191
begin
1192
  inc(fCount);
1193
  if fCount > fLength then
1194
  begin
1195
    inc(fLength, 500);
1196
    SetLength(fFloatArray, fLength);
1197
  end;
1198
  p.x := x; p.y := y;
1199
  fFloatArray[fCount - 1] := p;
1200
  if fFirstpoint = nil then
1201
    fFirstpoint := @fFloatArray[fCount - 1];
1202
  fCurrentpoint := @fFloatArray[fCount - 1];
1203
end;
1204

1205
procedure TFloatPointlist.assign;
1206
var
1207
  i: Integer;
1208
begin
1209
  if AFloatPointList.Count > 0 then
1210
  begin
1211
    fFirstpoint := nil;
1212
    fCount := 0;
1213
    SetLength(fFloatArray, 500);
1214
    for i := 0 to AFloatPointList.fCount - 1 do
1215
      with AFloatPointList.fFloatArray[i] do
1216
        add(x, y);
1217
  end;
1218
end;
1219

1220

1221
destructor TFloatPointlist.Destroy;
1222
begin
1223
  SetLength(fFloatArray, 0);
1224
  fFirstpoint := nil;
1225
  fCurrentpoint := nil;
1226
  fCount := 0; fLength := 0;
1227
  //not really necessary. But the following helps a bit  under Win2K:
1228
  if Win32Platform = VER_PLATFORM_WIN32_NT then
1229
    SetProcessWorkingSetSize(GetCurrentProcess, DWORD(-1), DWORD(-1));
1230
  inherited Destroy;
1231
end;
1232

1233

1234
function TFloatPointlist.NextPoint(p: PFloatPoint): PFloatPoint;
1235
begin
1236
  if p = CurrentPoint then
1237
    Result := nil
1238
  else
1239
  begin
1240
    Result := p;
1241
    inc(Result);
1242
  end;
1243
end;
1244

1245
{TFloatPointListList}
1246

1247
constructor TFloatPointListList.Create;
1248
begin
1249
  inherited Create;
1250
  fFirstlist := nil;
1251
  fCount := 0;
1252
  FTotalCount := 0;
1253
  fCurrentlist := nil;
1254
end;
1255

1256
procedure TFloatPointListList.add;
1257
var
1258
  p: TFloatPointlist;
1259
begin
1260
  p := TFloatPointlist.Create;
1261
  inc(fCount);
1262
  SetLength(fgraphlist, fCount);
1263
  fgraphlist[fCount - 1] := p;
1264
  if fFirstlist = nil then
1265
  begin
1266
    fFirstlist := p;
1267
    fCurrentlist := p;
1268
  end
1269
  else
1270
  begin
1271
    fCurrentlist := p;
1272
  end;
1273
end;
1274

1275
procedure TFloatPointListList.AddToCurrent(x, y: MathFloat);
1276
begin
1277
  fCurrentlist.add(x, y);
1278
  inc(FTotalCount);
1279
end;
1280

1281
destructor TFloatPointListList.Destroy;
1282
var
1283
  i: Integer;
1284
begin
1285
  for i := 0 to fCount - 1 do
1286
    fgraphlist[i].Free;
1287
  fCount := 0;
1288
  FTotalCount := 0;
1289
  fFirstlist := nil;
1290
  fCurrentlist := nil;
1291
  inherited Destroy;
1292
end;
1293

1294
{TD3FloatPointList}
1295

1296
constructor TD3FloatPointList.Create;
1297
begin
1298
  inherited Create;
1299
  SetLength(fFloatArray, 500);
1300
  fLength := 500;
1301
  fFirstpoint := nil;
1302
  fCount := 0;
1303
  fCurrentpoint := nil;
1304
  fNormalKind := nkPrincipal;
1305
end;
1306

1307
procedure TD3FloatPointList.add(x, y, z: MathFloat);
1308
var p: TD3FloatPoint;
1309
begin
1310
  inc(fCount);
1311
  if fCount > fLength then
1312
  begin
1313
    inc(fLength, 500);
1314
    SetLength(fFloatArray, fLength);
1315
  end;
1316
  p.x := x; p.y := y; p.z := z;
1317
  fFloatArray[fCount - 1] := p;
1318
  if fFirstpoint = nil then
1319
    fFirstpoint := @fFloatArray[fCount - 1];
1320
  fCurrentpoint := @fFloatArray[fCount - 1];
1321
  fPrepared := False;
1322
end;
1323

1324
procedure TD3FloatPointList.assign;
1325
var
1326
  i: Integer;
1327
begin
1328
  if AFloatPointList.Count > 0 then
1329
  begin
1330
    fFirstpoint := nil;
1331
    fCount := 0;
1332
    SetLength(fFloatArray, 500);
1333
    for i := 0 to AFloatPointList.fCount - 1 do
1334
      with AFloatPointList.fFloatArray[i] do
1335
        add(x, y, z);
1336
  end;
1337
end;
1338

1339
destructor TD3FloatPointList.Destroy;
1340
begin
1341
  SetLength(fFloatArray, 0);
1342
  fFirstpoint := nil;
1343
  fCurrentpoint := nil;
1344
  fCount := 0;
1345
  if Win32Platform = VER_PLATFORM_WIN32_NT then
1346
    SetProcessWorkingSetSize(GetCurrentProcess, DWORD(-1), DWORD(-1));
1347
  inherited Destroy;
1348
end;
1349

1350
function TD3FloatPointList.NextPoint(p: PD3FloatPoint): PD3FloatPoint;
1351
begin
1352
  if p = CurrentPoint then   Result := nil
1353
  else
1354
  begin
1355
    Result := p;
1356
    inc(Result);
1357
  end;
1358
end;
1359

1360
procedure TD3FloatPointList.PrepareIllumination;
1361
begin
1362
  GetLineSegments(fFloatArray, fCount, fNormalKind, fLineSegmentArray);
1363
  fPrepared := True;
1364
end;
1365

1366
procedure TD3FloatPointList.SetNormalKind(Value: TNormalKind);
1367
begin
1368
  if fNormalKind <> Value then
1369
  begin
1370
    fNormalKind := Value;
1371
    fPrepared := False;
1372
  end;
1373
end;
1374

1375
{TD3FloatPointListList}
1376

1377
constructor TD3FloatPointListList.Create;
1378
begin
1379
  inherited Create;
1380
  fFirstlist := nil;
1381
  fCount := 0;
1382
  FTotalCount := 0;
1383
  fCurrentlist := nil;
1384
end;
1385

1386
procedure TD3FloatPointListList.add;
1387
var
1388
  p: TD3FloatPointList;
1389
begin
1390
  p := TD3FloatPointList.Create;
1391
  inc(fCount);
1392
  SetLength(fgraphlist, fCount);
1393
  fgraphlist[fCount - 1] := p;
1394
  if fFirstlist = nil then
1395
  begin
1396
    fFirstlist := p;
1397
    fCurrentlist := p;
1398
  end
1399
  else
1400
  begin
1401
    fCurrentlist := p;
1402
  end;
1403
end;
1404

1405
procedure TD3FloatPointListList.AddToCurrent(x, y, z: MathFloat);
1406
begin
1407
  fCurrentlist.add(x, y, z);
1408
  inc(FTotalCount);
1409
end;
1410

1411
destructor TD3FloatPointListList.Destroy;
1412
var
1413
  i: Integer;
1414
begin
1415
  for i := 0 to fCount - 1 do
1416
    fgraphlist[i].Free;
1417
  fCount := 0;
1418
  FTotalCount := 0;
1419
  fFirstlist := nil;
1420
  fCurrentlist := nil;
1421
  inherited Destroy;
1422
end;
1423

1424

1425

1426

1427
procedure TD3FloatPointListList.SetNormalKind(Value: TNormalKind);
1428
var i: Integer;
1429
begin
1430
  fNormalKind := Value;
1431
  for i := 0 to High(fgraphlist) do
1432
    fgraphlist[i].NormalKind := fNormalKind;
1433
end;
1434

1435
{TMathImage}
1436

1437

1438
procedure TMathImage.SetVersion;
1439
begin
1440
end;
1441

1442
procedure TMathImage.SetRecordMetafile;
1443
begin
1444
  FRecordMetafile := x;
1445
  if not x then
1446
    EraseMetafile;
1447
end;
1448

1449

1450

1451
procedure TMathImage.Setx1d2;
1452
begin
1453
  SetWorld(x, Gety1d2, x + Getxwd2, Gety1d2 + Getywd2);
1454
end;
1455

1456
procedure TMathImage.Setxwd2;
1457
begin
1458
  if x > 0 then
1459
    SetWorld(Getx1d2, Gety1d2, Getx1d2 + x, Gety1d2 + Getywd2)
1460
  else
1461
    raise EMathImageError.Create('x-worldwidth must be positive');
1462
end;
1463

1464
procedure TMathImage.Sety1d2;
1465
begin
1466
  SetWorld(Getx1d2, x, Getx1d2 + Getxwd2, x + Getywd2);
1467
end;
1468

1469
procedure TMathImage.Setywd2;
1470
begin
1471
  if x > 0 then
1472
    SetWorld(Getx1d2, Gety1d2, Getx1d2 + Getxwd2, Gety1d2 + x)
1473
  else raise EMathImageError.Create('y-worldwidth must be positive');
1474
end;
1475

1476
procedure TMathImage.Setx1d3;
1477
begin
1478
  d3SetWorld(x, Gety1d3, Getz1d3, x + Getxwd3, Gety1d3 + Getywd3, Getz1d3 + Getzwd3);
1479
end;
1480

1481
procedure TMathImage.Setxwd3;
1482
begin
1483
  if x > 0 then
1484
    d3SetWorld(Getx1d3, Gety1d3, Getz1d3, Getx1d3 + x, Gety1d3 + Getywd3, Getz1d3 + Getzwd3)
1485
  else raise EMathImageError.Create('x-worldwidth must be positive');
1486
end;
1487

1488
procedure TMathImage.Sety1d3;
1489
begin
1490
  d3SetWorld(Getx1d3, x, Getz1d3, Getx1d3 + Getxwd3, x + Getywd3, Getz1d3 + Getzwd3);
1491
end;
1492

1493
procedure TMathImage.Setywd3;
1494
begin
1495
  if x > 0 then
1496
    d3SetWorld(Getx1d3, Gety1d3, Getz1d3, Getx1d3 + Getxwd3, Gety1d3 + x, Getz1d3 + Getzwd3)
1497
  else raise EMathImageError.Create('y-worldwidth must be positive');
1498
end;
1499

1500
procedure TMathImage.Setz1d3;
1501
begin
1502
  d3SetWorld(Getx1d3, Gety1d3, x, Getx1d3 + Getxwd3, Gety1d3 + Getywd3, x + Getzwd3);
1503
end;
1504

1505
procedure TMathImage.Setzwd3;
1506
begin
1507
  if x > 0 then
1508
    d3SetWorld(Getx1d3, Gety1d3, Getz1d3, Getx1d3 + Getxwd3, Gety1d3 + Getywd3, Getz1d3 + x)
1509
  else raise EMathImageError.Create('z-worldwidth must be positive');
1510
end;
1511

1512
procedure TMathImage.Setvd;
1513
begin
1514
  fWorldDrawing.d3SetViewPoint(x, Getalpha, Getyrd3, Getzrd3);
1515
end;
1516

1517
procedure TMathImage.Setalpha;
1518
begin
1519
  fWorldDrawing.d3SetViewPoint(Getvd, x, Getyrd3, Getzrd3);
1520
end;
1521

1522
procedure TMathImage.Setzrd3;
1523
begin
1524
  fWorldDrawing.d3SetViewPoint(Getvd, Getalpha, Getyrd3, x);
1525
end;
1526

1527
procedure TMathImage.Setyrd3;
1528
begin
1529
  fWorldDrawing.d3SetViewPoint(Getvd, Getalpha, x, Getzrd3);
1530
end;
1531

1532
procedure TMathImage.Setard3;
1533
begin
1534
  fWorldDrawing.d3SetWorld(Getx1d3, Gety1d3, Getz1d3, Getx1d3 + Getxwd3, Gety1d3 + Getywd3, Getz1d3 + Getzwd3, x);
1535
end;
1536

1537
procedure TMathImage.SetXscale;
1538
begin
1539
  fWorldDrawing.d3SetScales(x, GetYscale, GetZscale);
1540
end;
1541

1542
procedure TMathImage.SetYscale;
1543
begin
1544
  fWorldDrawing.d3SetScales(GetXscale, x, GetZscale);
1545
end;
1546

1547
procedure TMathImage.SetZscale;
1548
begin
1549
  fWorldDrawing.d3SetScales(GetXscale, GetYscale, x);
1550
end;
1551

1552

1553
procedure TMathImage.SetClipRect(Value: TRect);
1554
begin
1555
  fClipRect := Value;
1556
  NewClipRegion(Value);
1557
end;
1558

1559
function TMathImage.Getd2Worldx2;
1560
begin
1561
  Result := Getx1d2 + Getxwd2;
1562
end;
1563

1564
function TMathImage.Getd2Worldy2;
1565
begin
1566
  Result := Gety1d2 + Getywd2;
1567
end;
1568

1569
function TMathImage.Getd3Worldx2;
1570
begin
1571
  Result := Getx1d3 + Getxwd3;
1572
end;
1573

1574
function TMathImage.Getd3Worldy2;
1575
begin
1576
  Result := Gety1d3 + Getywd3;
1577
end;
1578

1579
function TMathImage.Getd3Worldz2;
1580
begin
1581
  Result := Getz1d3 + Getzwd3;
1582
end;
1583

1584

1585

1586

1587
constructor TMathImage.Create(AOwner: TComponent);
1588
begin
1589
  inherited Create(AOwner);
1590
  ControlStyle := ControlStyle + [csOpaque];
1591
  fWorldDrawing := TCrackerDrawing.Create;
1592
  maxxtw := 20; maxytw := 20; maxth := 20;
1593
  if AOwner <> nil then
1594
    if (csDesigning in ComponentState) and not (csReading in AOwner.ComponentState) then
1595
    begin
1596
      fWorldDrawing.SetWorld(Canvas, -1, -1, 1, 1);
1597
      fWorldDrawing.Setd2Axes(Canvas, False);
1598
      fWorldDrawing.d3SetWorld(-1, -1, -1, 1, 1, 1, True);
1599
      fWorldDrawing.d3SetViewPoint(6.4, 6, 45, 45);
1600
      fWorldDrawing.d3SetScales(1, 1, 1);
1601
    end;
1602
  //Ray Lischner's trick to circumvent the default=0 gotcha for float properties.
1603
  fVersion := '6.0(beta 5) May 2000';
1604
  FRecordMetafile := False;
1605
  if AOwner <> nil then
1606
    if (csDesigning in ComponentState) and not (csReading in AOwner.ComponentState) then
1607
    begin
1608
      Width := 30;
1609
      Height := 30;
1610
    end;
1611
end;
1612

1613
destructor TMathImage.Destroy;
1614
begin
1615
  fWorldDrawing.Free;
1616
  inherited Destroy;
1617
end;
1618

1619
procedure TMathImage.SizeChanged;
1620
begin
1621
  inherited;
1622
  if Width <> 0 then if Height <> 0 then
1623
    begin
1624
      fWorldDrawing.SetScreen(Width, Height);
1625
      SetAxis(GetAxis);
1626
      d3ResetWorld;
1627
      invalidate;
1628
    end;
1629
end;
1630

1631

1632

1633
procedure TMathImage.SetAxis;
1634
begin
1635
  fWorldDrawing.Setd2Axes(Canvas, A);
1636
  ClipRect := fWorldDrawing.AxesClipRect;
1637
end;
1638

1639

1640

1641
procedure TMathImage.SetWorld;
1642
var
1643
  sx1, Sx2, sy1, Sy2: MathFloat;
1644

1645
begin
1646
  sx1 := Getx1d2; Sx2 := Getd2Worldx2; sy1 := Gety1d2; Sy2 := Getd2Worldy2;
1647
  try
1648
    fWorldDrawing.SetWorld(Canvas, x1, y1, x2, y2);
1649
  except
1650
    on e: EMathError do
1651
    begin
1652
      fWorldDrawing.SetWorld(Canvas, sx1, sy1, Sx2, Sy2);
1653
      raise EMathImageError.Create('Invalid D2-world bounds');
1654
    end;
1655
  end;
1656
end;
1657

1658

1659
procedure TMathImage.SetColor;
1660
begin
1661
  Pen.Color := Color;
1662
end;
1663

1664
function TMathImage.GetColor;
1665
begin
1666
  Result := Pen.Color;
1667
end;
1668

1669
function TMathImage.Windowx;
1670
begin
1671
  Result := fWorldDrawing.Windowx(x);
1672
end;
1673

1674
function TMathImage.Windowy;
1675
begin
1676
  Result := fWorldDrawing.Windowy(y);
1677
end;
1678

1679
function TMathImage.Norm;
1680
begin
1681
  Result := sqrt(sqr(x) + sqr(y));
1682
end;
1683

1684
function TMathImage.WorldX;
1685
begin
1686
  Result := fWorldDrawing.WorldX(xs);
1687
end;
1688

1689
function TMathImage.WorldY;
1690
begin
1691
  Result := fWorldDrawing.WorldY(Ys);
1692
end;
1693

1694
procedure TMathImage.Clear;
1695

1696
  function NotClipped: Boolean;
1697
  begin
1698
    with ClipRect do
1699
    begin
1700
      Result := (Left = 0) and (Top = 0) and (Right = Width) and (Bottom =
1701
        Height);
1702
    end;
1703
  end;
1704
var
1705
  save: TRect;
1706
begin
1707
  if NotClipped then ClearClipped
1708
  else
1709
  begin
1710
    save := ClipRect;
1711
    ClipRect := ClientRect;
1712
    inherited Clear(Canvas, Brush.Color);
1713
    if FRecordMetafile then
1714
      inherited Clear(MetafileCanvas, Brush.Color);
1715
    //repaint;
1716
    ClipRect := save;
1717
  end;
1718
end;
1719

1720
procedure TMathImage.ClearClipped;
1721
begin
1722
  inherited Clear(Canvas, Brush.Color);
1723
  if FRecordMetafile then
1724
    inherited Clear(MetafileCanvas, Brush.Color);
1725
end;
1726

1727
procedure TMathImage.DrawPoint;
1728
begin
1729
  Canvas.Pixels[Windowx(x), Windowy(y)] := Canvas.Pen.Color;
1730
  if FRecordMetafile then
1731
  begin
1732
    MetafileCanvas.Pixels[Windowx(x), Windowy(y)] := Canvas.Pen.Color;
1733
  end;
1734
end;
1735

1736
procedure TMathImage.MoveToPoint;
1737
begin
1738
  fWorldDrawing.MoveToPoint(Canvas, x, y);
1739
  if FRecordMetafile then
1740
    fWorldDrawing.MoveToPoint(MetafileCanvas, x, y);
1741
end;
1742

1743
procedure TMathImage.DrawLine;
1744
begin
1745
  LockUpdate;
1746
  fWorldDrawing.DrawLine(Canvas, x1, y1, x2, y2);
1747
  if FRecordMetafile then
1748
    fWorldDrawing.DrawLine(MetafileCanvas, x1, y1, x2, y2);
1749
  UnlockUpdate;
1750
end;
1751

1752

1753
procedure TMathImage.DrawLineTo(x, y: MathFloat);
1754
begin
1755
  fWorldDrawing.DrawLineTo(Canvas, x, y);
1756
  if FRecordMetafile then
1757
    fWorldDrawing.DrawLineTo(MetafileCanvas, x, y);
1758
end;
1759

1760
procedure TMathImage.DrawEllipse(x1, y1, x2, y2: MathFloat);
1761
begin
1762
  fWorldDrawing.DrawEllipse(Canvas, x1, y1, x2, y2);
1763
  if FRecordMetafile then
1764
    fWorldDrawing.DrawEllipse(MetafileCanvas, x1, y1, x2, y2);
1765
end;
1766

1767
procedure TMathImage.DrawRectangle;
1768
begin
1769
  fWorldDrawing.DrawRectangle(Canvas, x1, y1, x2, y2);
1770
  if FRecordMetafile then
1771
    fWorldDrawing.DrawRectangle(MetafileCanvas, x1, y1, x2, y2);
1772
end;
1773

1774
procedure TMathImage.DrawAxes;
1775
var
1776
  SaveRect: TRect;
1777
begin
1778
  LockUpdate;
1779
  try
1780
    SetAxis(True);
1781
    SaveRect := ClipRect;
1782
    ClipRect := ClientRect;
1783
    fWorldDrawing.DrawAxes(Canvas, xLabel, yLabel, AxesColor, Arrows);
1784
    if FRecordMetafile then
1785
      fWorldDrawing.DrawAxes(MetafileCanvas, xLabel, yLabel, AxesColor, Arrows);
1786
    ClipRect := SaveRect;
1787
    if ZeroLines then
1788
    begin
1789
      fWorldDrawing.DrawZeroLines(Canvas, ZeroLinesColor);
1790
      if FRecordMetafile then
1791
        fWorldDrawing.DrawZeroLines(MetafileCanvas, ZeroLinesColor);
1792
    end;
1793
  finally
1794
    UnlockUpdate;
1795
  end;
1796
end;
1797

1798
procedure TMathImage.DrawVector;
1799
begin
1800
  LockUpdate;
1801
  try
1802
    fWorldDrawing.DrawVector(Canvas, x, y, A, b);
1803
    if FRecordMetafile then
1804
      fWorldDrawing.DrawVector(MetafileCanvas, x, y, A, b);
1805
  finally
1806
    UnlockUpdate;
1807
  end;
1808
end;
1809

1810
procedure TMathImage.DrawPolyline(FloatPointList: TFloatPointlist);
1811

1812
begin
1813
  fWorldDrawing.DrawPolyline(Canvas, FloatPointList.fFloatArray, FloatPointList.fCount);
1814
  if FRecordMetafile then
1815
end;
1816

1817
procedure TMathImage.DrawPolygon(FloatPointList: TFloatPointlist);
1818
begin
1819
  fWorldDrawing.DrawPolygon(Canvas, FloatPointList.fFloatArray, FloatPointList.Count);
1820
  if FRecordMetafile then
1821
    fWorldDrawing.DrawPolygon(MetafileCanvas, FloatPointList.fFloatArray, FloatPointList.Count);
1822
end;
1823

1824
procedure TMathImage.DrawPolyPolyline(FloatPointListList: TFloatPointListList);
1825
var
1826
  i: longint;
1827
begin
1828
  LockUpdate;
1829
  try
1830
    if assigned(FloatPointListList) then
1831
      if FloatPointListList.Count > 0 then
1832
        with FloatPointListList do
1833
        begin
1834
          for i := 0 to Count - 1 do
1835
            DrawPolyline(fgraphlist[i]);
1836
        end;
1837
  finally
1838
    UnlockUpdate;
1839
  end;
1840
end;
1841

1842

1843

1844
procedure TMathImage.d3SetWorld;
1845
var
1846
  sx1, sxw, sy1, syw, sz1, szw: MathFloat;
1847
begin
1848
  sx1 := Getx1d3; sxw := Getxwd3; sy1 := Gety1d3;
1849
  syw := Getywd3; sz1 := Getz1d3; szw := Getzwd3;
1850
  try
1851
    fWorldDrawing.d3SetWorld(x1, y1, z1, x2, y2, z2, Getard3);
1852
  except
1853
    on e: EMathError do
1854
    begin
1855
      d3SetWorld(sx1, sy1, sz1, sx1 + sxw, sy1 + syw, sz1 + szw);
1856
      raise EMathImageError.Create('Invalid D3-world bounds');
1857
    end;
1858
  end;
1859
end;
1860

1861
procedure TMathImage.d3ResetWorld;
1862
begin
1863
  fWorldDrawing.d3ResetWorld;
1864
end;
1865

1866

1867
procedure TMathImage.d3Window(x, y, z: MathFloat; var xs, Ys: longint);
1868

1869
begin
1870
  fWorldDrawing.d3Window(x, y, z, xs, Ys);
1871
end;
1872

1873

1874
procedure TMathImage.PseudoD3World;
1875

1876
begin
1877
  fWorldDrawing.PseudoD3World(xs, Ys, x, y, z);
1878
end;
1879

1880

1881
procedure TMathImage.d3Moveto(x, y, z: MathFloat);
1882
begin
1883
  fWorldDrawing.d3Moveto(Canvas, x, y, z);
1884
  if FRecordMetafile then
1885
    fWorldDrawing.d3Moveto(MetafileCanvas, x, y, z);
1886
end;
1887

1888
procedure TMathImage.d3DrawPoint(x, y, z: MathFloat);
1889
begin
1890
  fWorldDrawing.d3DrawPoint(Canvas, x, y, z);
1891
  if FRecordMetafile then
1892
    fWorldDrawing.d3DrawPoint(MetafileCanvas, x, y, z);
1893
end;
1894

1895
procedure TMathImage.d3DrawLine(x1, y1, z1, x2, y2, z2: MathFloat);
1896
begin
1897
  LockUpdate;
1898
  try
1899
    fWorldDrawing.d3DrawLine(Canvas, x1, y1, z1, x2, y2, z2);
1900
    if FRecordMetafile then
1901
      fWorldDrawing.d3DrawLine(MetafileCanvas, x1, y1, z1, x2, y2, z2);
1902
  finally
1903
    UnlockUpdate;
1904
  end;
1905
end;
1906

1907
procedure TMathImage.d3DrawLineto(x, y, z: MathFloat);
1908
begin
1909
  fWorldDrawing.d3DrawLineto(Canvas, x, y, z);
1910
  if FRecordMetafile then
1911
    fWorldDrawing.d3DrawLineto(MetafileCanvas, x, y, z);
1912
end;
1913

1914

1915
procedure TMathImage.d3DrawAxes;
1916

1917
begin {******* drawd3axes ******}
1918
  LockUpdate;
1919
  fWorldDrawing.d3DrawAxes(Canvas, xLabel, yLabel,
1920
    zLabel, xTicks, yTicks, zTicks, xPos, yPos, zPos, Arrows);
1921
  if FRecordMetafile then
1922
    fWorldDrawing.d3DrawAxes(MetafileCanvas, xLabel, yLabel,
1923
      zLabel, xTicks, yTicks, zTicks, xPos, yPos, zPos, Arrows);
1924
  UnlockUpdate;
1925
end;
1926

1927
procedure TMathImage.d3DrawBestAxes;
1928

1929
begin {******* drawd3axes ******}
1930
  LockUpdate;
1931
  fWorldDrawing.d3DrawBestAxes(Canvas, xLabel, yLabel,
1932
    zLabel, xTicks, yTicks, zTicks, Arrows);
1933
  if FRecordMetafile then
1934
    fWorldDrawing.d3DrawBestAxes(MetafileCanvas, xLabel, yLabel,
1935
      zLabel, xTicks, yTicks, zTicks, Arrows);
1936
  UnlockUpdate;
1937
end;
1938

1939
procedure TMathImage.d3drawZeroCross;
1940
begin
1941
  LockUpdate;
1942
  fWorldDrawing.d3drawZeroCross(Canvas);
1943
  if FRecordMetafile then
1944
    fWorldDrawing.d3drawZeroCross(MetafileCanvas);
1945
  UnlockUpdate;
1946
end;
1947

1948
procedure TMathImage.d3DrawWorldbox;
1949
begin
1950
  LockUpdate;
1951
  fWorldDrawing.d3DrawWorldbox(Canvas);
1952
  if FRecordMetafile then
1953
    fWorldDrawing.d3DrawWorldbox(MetafileCanvas);
1954
  UnlockUpdate;
1955
end;
1956

1957

1958
procedure TMathImage.d3DrawBox;
1959

1960
begin
1961
  LockUpdate;
1962
  fWorldDrawing.d3DrawBox(Canvas, x1, y1, z1, x2, y2, z2);
1963
  if FRecordMetafile then
1964
    fWorldDrawing.d3DrawBox(MetafileCanvas, x1, y1, z1, x2, y2, z2);
1965
  UnlockUpdate;
1966
end;
1967

1968
procedure TMathImage.d3DrawFullWorldBox;
1969
begin
1970
  d3DrawBox(Getx1d3, Gety1d3, Getz1d3, Getx1d3 + Getxwd3, Gety1d3 + Getywd3, Getz1d3 + Getzwd3);
1971
end;
1972

1973
procedure TMathImage.d3Polyline(FloatPointList: TD3FloatPointList);
1974
begin
1975
  LockUpdate;
1976
  try
1977
    fWorldDrawing.d3Polyline(Canvas, FloatPointList.fFloatArray, FloatPointList.Count);
1978
    if FRecordMetafile then
1979
      fWorldDrawing.d3Polyline(MetafileCanvas, FloatPointList.fFloatArray, FloatPointList.Count);
1980
  finally
1981
    UnlockUpdate;
1982
  end;
1983
end;
1984

1985
procedure TMathImage.d3LitPolyLine(FloatPointList: TD3FloatPointList; diffuse, focussed, RightIntensity: MathFloat;
1986
  zrot1, zrot2, yrot1, yrot2: Integer; dist1, dist2: MathFloat; fixed: Boolean);
1987
begin
1988
  LockUpdate;
1989
  try
1990
    if not FloatPointList.fPrepared then
1991
      FloatPointList.PrepareIllumination;
1992
    fWorldDrawing.GetIlluminatedLinesegments(Pen.Color, diffuse, focussed, RightIntensity, zrot1, zrot2, yrot1, yrot2, dist1, dist2, fixed, FloatPointList.fLineSegmentArray);
1993
    fWorldDrawing.DrawLineSegments(Canvas, FloatPointList.fLineSegmentArray);
1994
    if FRecordMetafile then
1995
      fWorldDrawing.DrawLineSegments(MetafileCanvas, FloatPointList.fLineSegmentArray);
1996
  finally
1997
    UnlockUpdate;
1998
  end;
1999
end;
2000

2001
procedure TMathImage.d3PolyPolyline(FloatPointListList: TD3FloatPointListList);
2002
var
2003
  i: longint;
2004
begin
2005
  LockUpdate;
2006
  if assigned(FloatPointListList) then
2007
    if FloatPointListList.Count > 0 then
2008
      with FloatPointListList do
2009
      begin
2010
        for i := 0 to Count - 1 do
2011
          d3Polyline(fgraphlist[i]);
2012
      end;
2013
  UnlockUpdate;
2014
end;
2015

2016
procedure TMathImage.d3LitPolyPolyline(FloatPointListList: TD3FloatPointListList; diffuse, focussed, RightIntensity: MathFloat;
2017
  zrot1, zrot2, yrot1, yrot2: Integer; dist1, dist2: MathFloat; fixed: Boolean);
2018
var
2019
  i: longint;
2020
begin
2021
  LockUpdate;
2022
  if assigned(FloatPointListList) then
2023
    if FloatPointListList.Count > 0 then
2024
      with FloatPointListList do
2025
      begin
2026
        NormalKind := NormalKind;
2027
        for i := 0 to Count - 1 do
2028
          d3LitPolyLine(fgraphlist[i], diffuse, focussed, RightIntensity, zrot1, zrot2, yrot1, yrot2, dist1, dist2, fixed);
2029
      end;
2030
  UnlockUpdate;
2031
end;
2032

2033

2034

2035

2036

2037
procedure TMathImage.d3StartRotatingLeft(Increment: MathFloat);
2038
var
2039
  inc: MathFloat;
2040
begin
2041
  Rotating := True;
2042
  inc := Increment;
2043
  if ((d3Yrotation > 0) and (trunc(d3Yrotation / 180) mod 2 = 1))
2044
    or ((d3Yrotation <= 0) and (trunc(d3Yrotation / 180) mod 2 = 0))
2045
    then inc := -inc;
2046
  while Rotating do
2047
  begin
2048
    d3Zrotation := d3Zrotation - inc;
2049
    if assigned(FOnRotating) then FOnRotating(self);
2050
    Application.ProcessMessages;
2051
  end;
2052
end;
2053

2054
procedure TMathImage.d3StartRotatingRight(Increment: MathFloat);
2055
var
2056
  inc: MathFloat;
2057
begin
2058
  Rotating := True;
2059
  inc := Increment;
2060
  if ((d3Yrotation > 0) and (trunc(d3Yrotation / 180) mod 2 = 1))
2061
    or ((d3Yrotation <= 0) and (trunc(d3Yrotation / 180) mod 2 = 0))
2062
    then inc := -inc;
2063
  while Rotating do
2064
  begin
2065
    d3Zrotation := d3Zrotation + inc;
2066
    if assigned(FOnRotating) then FOnRotating(self);
2067
    Application.ProcessMessages;
2068
  end;
2069
end;
2070

2071
procedure TMathImage.d3StartRotatingUp(Increment: MathFloat);
2072
begin
2073
  Rotating := True;
2074
  while Rotating do
2075
  begin
2076
    d3Yrotation := d3Yrotation - Increment;
2077
    if assigned(FOnRotating) then FOnRotating(self);
2078
    Application.ProcessMessages;
2079
  end;
2080
end;
2081

2082
procedure TMathImage.d3StartRotatingDown(Increment: MathFloat);
2083
begin
2084
  Rotating := True;
2085
  while Rotating do
2086
  begin
2087
    d3Yrotation := d3Yrotation + Increment;
2088
    if assigned(FOnRotating) then FOnRotating(self);
2089
    Application.ProcessMessages;
2090
  end;
2091
end;
2092

2093
procedure TMathImage.d3StopRotating;
2094
begin
2095
  Rotating := False;
2096
  if assigned(FOnEndRotate) then FOnEndRotate(self);
2097
end;
2098

2099
procedure TMathImage.d3StartMovingIn(Increment: MathFloat);
2100
begin
2101
  Moving := True;
2102
  while Moving do
2103
  begin
2104
    d3ViewDist := d3ViewDist * (1 - Increment);
2105
    if assigned(FOnMoving) then FOnMoving(self);
2106
    Application.ProcessMessages;
2107
  end;
2108
end;
2109

2110
procedure TMathImage.d3StartMovingOut(Increment: MathFloat);
2111
begin
2112
  Moving := True;
2113
  while Moving do
2114
  begin
2115
    d3ViewDist := d3ViewDist * (1 + Increment);
2116
    if assigned(FOnMoving) then FOnMoving(self);
2117
    Application.ProcessMessages;
2118
  end;
2119
end;
2120

2121
procedure TMathImage.d3StopMoving;
2122
begin
2123
  Moving := False;
2124
  if assigned(FOnEndMove) then FOnEndMove(self);
2125
end;
2126

2127
procedure TMathImage.d3StartZoomingIn(Increment: MathFloat);
2128
begin
2129
  Zooming := True;
2130
  while Zooming do
2131
  begin
2132
    d3ViewAngle := d3ViewAngle * (1 - Increment);
2133
    if assigned(FOnZooming) then FOnZooming(self);
2134
    Application.ProcessMessages;
2135
  end;
2136
end;
2137

2138
procedure TMathImage.d3StartZoomingOut(Increment: MathFloat);
2139
begin
2140
  Zooming := True;
2141
  while Zooming do
2142
  begin
2143
    d3ViewAngle := d3ViewAngle * (1 + Increment);
2144
    if assigned(FOnZooming) then FOnZooming(self);
2145
    Application.ProcessMessages;
2146
  end;
2147
end;
2148

2149
procedure TMathImage.d3StopZooming;
2150
begin
2151
  Zooming := False;
2152
  if assigned(FOnEndZoom) then FOnEndZoom(self);
2153
end;
2154

2155
{Surface}
2156

2157

2158
procedure TMathImage.d3DrawSurface(Surface: TSurface; fill, NoUpdate: Boolean);
2159
begin
2160
  LockUpdate;
2161
  with Surface do
2162
  begin
2163
    fDefaultFillColor := Canvas.Brush.Color;
2164
    fDefaultWireColor := Canvas.Pen.Color;
2165
    if not fill then
2166
      fWorldDrawing.d3DrawSurface(Canvas, fFloatsurface, False)
2167
    else
2168
    begin
2169
      fWorldDrawing.d3DrawSurfaceCells(Canvas, fSurfaceCells);
2170
      if FRecordMetafile then
2171
        fWorldDrawing.d3DrawSurfaceCells(MetafileCanvas, fSurfaceCells);
2172
    end;
2173
  end;
2174
  UnlockUpdate;
2175
end;
2176

2177
procedure TMathImage.d3DrawSurfaceCollection(Surfaces: TSurfaceCollection; fill: Boolean);
2178
var i: Integer;
2179
  savecolor: TColor;
2180
begin
2181
  LockUpdate;
2182
  if not fill then
2183
  begin
2184
    savecolor := Pen.Color;
2185
    for i := 0 to Surfaces.Count - 1 do
2186
    begin
2187
      Pen.Color := Surfaces.fSurfaces[i].fDefaultWireColor;
2188
      fWorldDrawing.d3DrawSurface(Canvas, Surfaces.fSurfaces[i].fFloatsurface, False);
2189
    end;
2190
    Pen.Color := savecolor;
2191
  end
2192
  else
2193
  begin
2194
    fWorldDrawing.d3DrawSurfaceCells(Canvas, Surfaces.fCells);
2195
    if FRecordMetafile then
2196
      fWorldDrawing.d3DrawSurfaceCells(MetafileCanvas, Surfaces.fCells);
2197
  end;
2198
  UnlockUpdate;
2199
end;
2200

2201
procedure TMathImage.d3DrawLitSurfaceCollection(Surfaces: TSurfaceCollection; ambient, focussed: MathFloat);
2202
begin
2203
  LockUpdate;
2204
  if not Surfaces.fprepared then
2205
    Surfaces.prepareIllumination;
2206
    fWorldDrawing.d3DrawLitTriangles(Canvas, Surfaces.fTriangs, ambient, focussed);
2207
    if FRecordMetafile then
2208
      fWorldDrawing.d3DrawLitTriangles(MetafileCanvas, Surfaces.fTriangs, ambient, focussed);
2209
  UnlockUpdate;
2210
end;
2211

2212

2213

2214

2215
procedure TMathImage.d3DrawLitSurface(Surface: TSurface; diffuse, focussed:
2216
  MathFloat; NoUpdate: Boolean);
2217

2218
begin
2219
  LockUpdate;
2220
  with Surface do
2221
  begin
2222
    fDefaultFillColor := Brush.Color;
2223
    fDefaultWireColor := Pen.Color;
2224
    if not fPrepared then
2225
      PrepareIllumination;
2226
    fWorldDrawing.d3DrawLitTriangles(Canvas, fTriangles, diffuse, focussed);
2227
    if FRecordMetafile then
2228
      fWorldDrawing.d3DrawLitTriangles(MetafileCanvas, fTriangles, diffuse, focussed);
2229
  end;
2230
  UnlockUpdate;
2231
end;
2232

2233

2234
procedure TMathImage.d3DrawCube;
2235
var
2236
  Cubes: array of TCube;
2237
begin
2238
  if x1 < x2 then
2239
    if y1 < y2 then
2240
      if z1 < z2 then
2241
      begin
2242
        SetLength(Cubes, 1);
2243
        Cubes[0].x1 := x1;
2244
        Cubes[0].y1 := y1;
2245
        Cubes[0].z1 := z1;
2246
        Cubes[0].x2 := x2;
2247
        Cubes[0].y2 := y2;
2248
        Cubes[0].z2 := z2;
2249
        Cubes[0].FillColor := Brush.Color;
2250
        Cubes[0].WireColor := Pen.Color;
2251
        LockUpdate;
2252
        try
2253
          fWorldDrawing.d3DrawCubes(Canvas, Cubes, fill);
2254
          if FRecordMetafile then
2255
            fWorldDrawing.d3DrawCubes(MetafileCanvas, Cubes, fill);
2256
        finally
2257
          UnlockUpdate;
2258
        end;
2259
      end
2260
      else
2261
        raise(EMathImageError.Create('Cube coordinates must be (xlow,ylow,zlow, xup,yup,zup)'));
2262

2263
end;
2264

2265
{procedure TMathImage.d3DrawLitCube;
2266
begin
2267
end;}
2268

2269
procedure TMathImage.DrawFilledLevelCurves(LevelSurface: TLevelSurface);
2270

2271
begin
2272
  LockUpdate;
2273
  with LevelSurface do
2274
    if Length(fLevels) > 0 then
2275
    begin
2276
      fWorldDrawing.DrawProjections(Canvas, fTriangles);
2277
      if FRecordMetafile then
2278
        fWorldDrawing.DrawProjections(MetafileCanvas, fTriangles);
2279
    end;
2280
  UnlockUpdate;
2281
end;
2282

2283

2284
procedure TMathImage.DrawLevelCurves(Surface: TSurface; Level: MathFloat);
2285
begin
2286
  LockUpdate;
2287
  with Surface do
2288
  begin
2289
    fWorldDrawing.DrawLevelLines(Canvas, fTriangles, Level);
2290
    if FRecordMetafile then
2291
      fWorldDrawing.DrawLevelLines(MetafileCanvas, fTriangles, Level);
2292
  end;
2293
  UnlockUpdate;
2294
end;
2295

2296
procedure TMathImage.d3DrawCustomAxes(
2297
  xmin, ymin, zmin, xmax, ymax, zmax: MathFloat;
2298
  xLabel, yLabel, zLabel: string);
2299

2300
begin
2301
  LockUpdate;
2302
  fWorldDrawing.d3DrawCustomAxes(Canvas, xmin, ymin, zmin, xmax, ymax, zmax, xLabel, yLabel, zLabel);
2303
  if FRecordMetafile then
2304
    fWorldDrawing.d3DrawCustomAxes(MetafileCanvas, xmin, ymin, zmin, xmax, ymax, zmax, xLabel, yLabel, zLabel);
2305
  UnlockUpdate;
2306
end;
2307

2308
procedure TMathImage.d3DrawHeightCubes(HeightMap: THeightMap);
2309
begin
2310
  LockUpdate;
2311
  try
2312
    if assigned(HeightMap) then
2313
      with HeightMap do
2314
      begin
2315
        fWorldDrawing.d3DrawHeightCubes(Canvas, fHeightArray, fColors);
2316
        if FRecordMetafile then
2317
          fWorldDrawing.d3DrawHeightCubes(MetafileCanvas, fHeightArray, fColors);
2318
      end;
2319
  finally
2320
    UnlockUpdate;
2321
  end;
2322
end;
2323

2324
procedure TMathImage.d3DrawLitHeightCubes(HeightMap: THeightMap; diffuse, focussed: MathFloat);
2325
begin
2326
  LockUpdate;
2327
  try
2328
    if assigned(HeightMap) then
2329
      with HeightMap do
2330
      begin
2331
        fWorldDrawing.d3DrawLitHeightCubes(Canvas, fHeightArray, fColors, diffuse, focussed);
2332
        if FRecordMetafile then
2333
          fWorldDrawing.d3DrawLitHeightCubes(MetafileCanvas, fHeightArray, fColors, diffuse, focussed);
2334
      end;
2335
  finally
2336
    UnlockUpdate;
2337
  end;
2338
end;
2339

2340
function TMathImage.Getalpha: MathFloat;
2341
begin
2342
  Result := fWorldDrawing.d3alpha;
2343
end;
2344

2345
function TMathImage.Getard3: Boolean;
2346
begin
2347
  Result := fWorldDrawing.d3ar;
2348
end;
2349

2350
function TMathImage.GetAxis: Boolean;
2351
begin
2352
  Result := fWorldDrawing.d2Axes;
2353
end;
2354

2355
function TMathImage.Getvd: MathFloat;
2356
begin
2357
  Result := fWorldDrawing.d3vd;
2358
end;
2359

2360
function TMathImage.Getx1d2: MathFloat;
2361
begin
2362
  Result := fWorldDrawing.d2x1;
2363
end;
2364

2365
function TMathImage.Getx1d3: MathFloat;
2366
begin
2367
  Result := fWorldDrawing.d3x1;
2368
end;
2369

2370
function TMathImage.GetXscale: MathFloat;
2371
begin
2372
  Result := fWorldDrawing.d3Xscale;
2373
end;
2374

2375
function TMathImage.Getxwd2: MathFloat;
2376
begin
2377
  Result := fWorldDrawing.d2xw;
2378
end;
2379

2380
function TMathImage.Getxwd3: MathFloat;
2381
begin
2382
  Result := fWorldDrawing.d3xw;
2383
end;
2384

2385
function TMathImage.Gety1d2: MathFloat;
2386
begin
2387
  Result := fWorldDrawing.d2y1;
2388
end;
2389

2390
function TMathImage.Gety1d3: MathFloat;
2391
begin
2392
  Result := fWorldDrawing.d3y1;
2393
end;
2394

2395
function TMathImage.Getyrd3: MathFloat;
2396
begin
2397
  Result := fWorldDrawing.d3yr;
2398
end;
2399

2400
function TMathImage.GetYscale: MathFloat;
2401
begin
2402
  Result := fWorldDrawing.d3Yscale;
2403
end;
2404

2405
function TMathImage.Getywd2: MathFloat;
2406
begin
2407
  Result := fWorldDrawing.d2yw;
2408
end;
2409

2410
function TMathImage.Getywd3: MathFloat;
2411
begin
2412
  Result := fWorldDrawing.d3yw;
2413
end;
2414

2415
function TMathImage.Getz1d3: MathFloat;
2416
begin
2417
  Result := fWorldDrawing.d3z1;
2418
end;
2419

2420
function TMathImage.Getzrd3: MathFloat;
2421
begin
2422
  Result := fWorldDrawing.d3zr;
2423
end;
2424

2425
function TMathImage.GetZscale: MathFloat;
2426
begin
2427
  Result := fWorldDrawing.d3Zscale;
2428
end;
2429

2430
function TMathImage.Getzwd3: MathFloat;
2431
begin
2432
  Result := fWorldDrawing.d3zw;
2433
end;
2434

2435
procedure TMathImage.DrawCircle(xCenter, yCenter: MathFloat;
2436
  PixRadius: Integer);
2437
begin
2438
  fWorldDrawing.DrawCircle(Canvas, xCenter, yCenter, PixRadius);
2439
  if FRecordMetafile then
2440
    fWorldDrawing.DrawCircle(MetafileCanvas, xCenter, yCenter, PixRadius);
2441
end;
2442

2443

2444

2445
procedure TMathImage.WorldToScreen(const x, y: MathFloat; var xs,
2446
  Ys: Integer);
2447
begin
2448
  fWorldDrawing.WorldToScreen(x, y, xs, Ys);
2449
end;
2450

2451
{ TColorSurface }
2452

2453
constructor TColorSurface.Create(xGrid, yGrid: Integer);
2454
var
2455
  i, j, Current: Integer;
2456
begin
2457
  SetLength(fColors, xGrid + 1);
2458
  for i := 0 to xGrid do
2459
    SetLength(fColors[i], yGrid + 1);
2460
  inherited Create(xGrid, yGrid);
2461
  Current := 0;
2462
  for i := 0 to xGrid - 1 do
2463
    for j := 0 to yGrid - 1 do
2464
    begin
2465
      fSurfaceCells[Current].FillColor := @fColors[i][j];
2466
      inc(Current);
2467
    end;
2468
end;
2469

2470
destructor TColorSurface.Destroy;
2471
var i: Integer;
2472
begin
2473
  for i := 0 to xMesh do
2474
    SetLength(fColors[i], 0);
2475
  SetLength(fColors, 0);
2476
  inherited;
2477
end;
2478

2479
function TColorSurface.GetColor(i, j: Integer): TColor;
2480
begin
2481
  Result := fColors[i][j];
2482
end;
2483

2484
function TColorSurface.GetFillColor(i, j: Integer): Pointer;
2485
begin
2486
  Result := @fColors[i][j];
2487
end;
2488

2489
function TColorSurface.GetWireColor(i, j: Integer): Pointer;
2490
begin
2491
  Result := @fDefaultWireColor;
2492
end;
2493

2494
procedure TColorSurface.Make(i, j: Integer; x, y, z: MathFloat;
2495
  Color: TColor);
2496
begin
2497
  inherited Make(i, j, x, y, z);
2498
  fColors[i][j] := Color;
2499
end;
2500

2501
{ THeightMap }
2502

2503
constructor THeightMap.Create(xGrid, yGrid: Integer);
2504
var i: Integer;
2505
begin
2506
  inherited Create;
2507
  SetLength(fHeightArray, xGrid + 1);
2508
  for i := 0 to xGrid do
2509
    SetLength(fHeightArray[i], yGrid + 1);
2510
  SetLength(fColors, xGrid + 1);
2511
  for i := 0 to xGrid do
2512
    SetLength(fColors[i], yGrid + 1);
2513
  fxm := xGrid;
2514
  fym := yGrid;
2515
end;
2516

2517
procedure THeightMap.Make(i, j: Integer; z: MathFloat; Color: TColor);
2518
begin
2519
  if (i >= 0) and (i <= fxm) and (j >= 0) and (j <= fym) then
2520
  begin
2521
    fHeightArray[i][j] := z;
2522
    fColors[i][j] := Color;
2523
  end
2524
  else
2525
    raise ESurfaceError.Create('Heightmap grid point does not exist');
2526
end;
2527

2528
{ TLevelSurface }
2529

2530
function SplitTriangle(c: MathFloat; tr: TD3Triangle; var tr1, tr2, tr3:
2531
  TD3Triangle; var NewPoint1, NewPoint2: PD3FloatPoint): Boolean;
2532
var
2533
  t1, t2, xp, yp, p, xq, yq, q, xr, yr, r, x1, y1, x2, y2, epsilon: MathFloat;
2534
begin
2535
  Result := False;
2536
  epsilon := 1.0E-15;
2537
  if not (((c - tr.p.z) * (tr.q.z - c) > epsilon) or ((c - tr.p.z) * (tr.r.z - c) > epsilon)) then
2538
    exit; //testing 2 is enough
2539
  xp := tr.p.x; yp := tr.p.y; p := tr.p.z;
2540
  xq := tr.q.x; yq := tr.q.y; q := tr.q.z;
2541
  xr := tr.r.x; yr := tr.r.y; r := tr.r.z;
2542
  if (c - p) * (q - c) > 0 then //sign change p-q
2543
  begin
2544
    t1 := (c - q) / (p - q);
2545
    x1 := t1 * xp + (1 - t1) * xq;
2546
    y1 := t1 * yp + (1 - t1) * yq;
2547
    if (c - p) * (r - c) >= 0 then //sign change p-r
2548
    begin
2549
      if p = r then
2550
        exit;
2551
      t2 := (c - r) / (p - r);
2552
      x2 := t2 * xp + (1 - t2) * xr;
2553
      y2 := t2 * yp + (1 - t2) * yr;
2554
      Result := True;
2555
      tr1.p := tr.p;
2556
      New(NewPoint1);
2557
      NewPoint1.x := x1;
2558
      NewPoint1.y := y1;
2559
      NewPoint1.z := c;
2560
      New(NewPoint2);
2561
      NewPoint2.x := x2;
2562
      NewPoint2.y := y2;
2563
      NewPoint2.z := c;
2564
      tr1.q := NewPoint1;
2565
      tr1.r := NewPoint2;
2566
      tr2.p := tr.q;
2567
      tr2.q := NewPoint1;
2568
      tr2.r := NewPoint2;
2569
      tr3.p := tr.q;
2570
      tr3.q := tr.r;
2571
      tr3.r := NewPoint2;
2572
      tr1.FillColor := nil;
2573
      tr2.FillColor := nil;
2574
      tr3.FillColor := nil;
2575
    end
2576
    else //sign change must be q-r
2577
    begin
2578
      if r = q then
2579
        exit;
2580
      t2 := (c - r) / (q - r);
2581
      x2 := t2 * xq + (1 - t2) * xr;
2582
      y2 := t2 * yq + (1 - t2) * yr;
2583
      Result := True;
2584
      tr1.p := tr.q;
2585
      New(NewPoint1);
2586
      NewPoint1.x := x1;
2587
      NewPoint1.y := y1;
2588
      NewPoint1.z := c;
2589
      New(NewPoint2);
2590
      NewPoint2.x := x2;
2591
      NewPoint2.y := y2;
2592
      NewPoint2.z := c;
2593
      tr1.q := NewPoint1;
2594
      tr1.r := NewPoint2;
2595
      tr2.p := tr.p;
2596
      tr2.q := NewPoint1;
2597
      tr2.r := NewPoint2;
2598
      tr3.p := tr.p;
2599
      tr3.q := tr.r;
2600
      tr3.r := NewPoint2;
2601
      tr1.FillColor := nil;
2602
      tr2.FillColor := nil;
2603
      tr3.FillColor := nil;
2604
    end;
2605
  end
2606
  else
2607
  begin
2608
    if (c - p) * (r - c) > 0 then
2609
      //sign change p-r which implies sign change q-r
2610
    begin
2611
      if p = r then
2612
        exit;
2613
      t1 := (c - r) / (p - r);
2614
      x1 := t1 * xp + (1 - t1) * xr;
2615
      y1 := t1 * yp + (1 - t1) * yr;
2616
      if q = r then
2617
        exit;
2618
      if p = q then
2619
        exit;
2620
      t2 := (c - r) / (q - r);
2621
      x2 := t2 * xq + (1 - t2) * xr;
2622
      y2 := t2 * yq + (1 - t2) * yr;
2623
      Result := True;
2624
      New(NewPoint1);
2625
      NewPoint1.x := x1;
2626
      NewPoint1.y := y1;
2627
      NewPoint1.z := c;
2628
      New(NewPoint2);
2629
      NewPoint2.x := x2;
2630
      NewPoint2.y := y2;
2631
      NewPoint2.z := c;
2632
      tr1.p := tr.q;
2633
      tr1.q := NewPoint1;
2634
      tr1.r := NewPoint2;
2635
      tr2.p := tr.r;
2636
      tr2.q := NewPoint1;
2637
      tr2.r := NewPoint2;
2638
      tr3.p := tr.p;
2639
      tr3.q := tr.q;
2640
      tr3.r := NewPoint1;
2641
      tr1.FillColor := nil;
2642
      tr2.FillColor := nil;
2643
      tr3.FillColor := nil;
2644
    end
2645
    else
2646
    begin
2647
      //now sign change must be q-r, and c=p, so:
2648
      x1 := xp; y1 := yp;
2649
      t2 := (c - r) / (q - r);
2650
      x2 := t2 * xq + (1 - t2) * xr;
2651
      y2 := t2 * yq + (1 - t2) * yr;
2652
      Result := True;
2653
      New(NewPoint1);
2654
      NewPoint1.x := x1;
2655
      NewPoint1.y := y1;
2656
      NewPoint1.z := c;
2657
      New(NewPoint2);
2658
      NewPoint2.x := x2;
2659
      NewPoint2.y := y2;
2660
      NewPoint2.z := c;
2661
      tr1.p := tr.q;
2662
      tr1.q := NewPoint1;
2663
      tr1.r := NewPoint2;
2664
      tr2.p := tr.r;
2665
      tr2.q := NewPoint1;
2666
      tr2.r := NewPoint2;
2667
      tr3.p := tr.p;
2668
      tr3.q := tr.q;
2669
      tr3.r := NewPoint2;
2670
      //still need to come up with 3 triangles, though is splits in 2
2671
      tr1.FillColor := nil;
2672
      tr2.FillColor := nil;
2673
      tr3.FillColor := nil;
2674
    end;
2675
  end;
2676
  CrossProduct(tr1.p.x - tr1.r.x, tr1.p.y - tr1.r.y, tr1.p.z - tr1.r.z, tr1.q.x - tr1.r.x, tr1.q.y - tr1.r.y, tr1.q.z - tr1.r.z, tr1.n.x, tr1.n.y, tr1.n.z);
2677
  CrossProduct(tr2.p.x - tr2.r.x, tr2.p.y - tr2.r.y, tr2.p.z - tr2.r.z, tr2.q.x - tr2.r.x, tr2.q.y - tr2.r.y, tr2.q.z - tr2.r.z, tr2.n.x, tr2.n.y, tr2.n.z);
2678
  CrossProduct(tr3.p.x - tr3.r.x, tr3.p.y - tr3.r.y, tr3.p.z - tr3.r.z, tr3.q.x - tr3.r.x, tr3.q.y - tr3.r.y, tr3.q.z - tr3.r.z, tr3.n.x, tr3.n.y, tr3.n.z);
2679
end;
2680

2681

2682
procedure TLevelSurface.SetLevels(const Levels: array of MathFloat;
2683
  const Colors: array of TColor);
2684
var
2685
  i, j,
2686
    ColCount, SplitCount,
2687
    TriangleCount, NewPointCount,
2688
    TriangleLength, NewPointLength: Integer;
2689
  Level, epsilon: MathFloat;
2690
  Done: Boolean;
2691
  NewPoint1, NewPoint2: PD3FloatPoint;
2692
  tr1, tr2, tr3: TD3Triangle;
2693
begin
2694
  if not fPrepared then
2695
    PrepareIllumination;
2696
  epsilon := 1.0E-12;
2697
  ColCount := High(Colors);
2698
  if ColCount > High(Levels) then
2699
    ColCount := High(Levels);
2700
  SetLength(fLevels, ColCount + 1);
2701
  SetLength(fColors, ColCount + 1);
2702
  for i := 0 to ColCount do
2703
  begin
2704
    fLevels[i] := Levels[i];
2705
    fColors[i] := Colors[i];
2706
  end;
2707
  TriangleCount := Length(fTriangles);
2708
  SetLength(fTriangles, TriangleCount + 200);
2709
  TriangleLength := Length(fTriangles);
2710
  if Length(fNewPoints) > 0 then
2711
  begin
2712
    for i := 0 to High(fNewPoints) do
2713
      dispose(fNewPoints[i]);
2714
  end;
2715
  SetLength(fNewPoints, 200);
2716
  NewPointLength := 200;
2717
  NewPointCount := 0;
2718
  i := 0;
2719
  //This loop should always stop, even though TriangleCount is
2720
  //being incremented. Please tell me if it bombs on you.
2721
  while i < TriangleCount do
2722
  begin
2723
    SplitCount := 0;
2724
    for j := 0 to ColCount do
2725
    begin
2726
      //The new pointer allocations in this routine are not so great
2727
      // of a memory use. but I've got no better idea.
2728
      if SplitTriangle(fLevels[j], fTriangles[i], tr1, tr2, tr3, NewPoint1, NewPoint2) then
2729
      begin
2730
        inc(SplitCount);
2731
        if NewPointCount > NewPointLength - 2 then
2732
        begin
2733
          NewPointLength := NewPointLength + 100;
2734
          SetLength(fNewPoints, NewPointLength);
2735
        end;
2736
        fNewPoints[NewPointCount] := NewPoint1;
2737
        inc(NewPointCount);
2738
        fNewPoints[NewPointCount] := NewPoint2;
2739
        inc(NewPointCount);
2740
        if TriangleCount > TriangleLength - 2 then
2741
        begin
2742
          TriangleLength := TriangleLength + 100;
2743
          SetLength(fTriangles, TriangleLength);
2744
        end;
2745
        fTriangles[i] := tr1;
2746
        fTriangles[TriangleCount] := tr2;
2747
        inc(TriangleCount);
2748
        fTriangles[TriangleCount] := tr3;
2749
        inc(TriangleCount);
2750
      end
2751
      else
2752
        if SplitCount > 0 then break;
2753
    end;
2754
    inc(i);
2755
  end;
2756
  for i := 0 to TriangleCount - 1 do
2757
    with fTriangles[i] do
2758
    begin
2759
      Done := False;
2760
      Level := 0.3333333333333333 * (p.z + q.z + r.z);
2761
      for j := 0 to ColCount - 1 do
2762
      begin
2763
        if fLevels[j] < Level + epsilon then
2764
          if Level < fLevels[j + 1] + epsilon then
2765
          begin
2766
            FillColor := @fColors[j];
2767
            Done := True;
2768
            break;
2769
          end;
2770
      end;
2771
      if not Done then
2772
      begin
2773
        if Level >= fLevels[ColCount] then
2774
          FillColor := @fColors[ColCount]
2775
        else
2776
          if Level <= fLevels[0] then
2777
            FillColor := @fColors[0];
2778
      end;
2779
    end;
2780
  SetLength(fTriangles, TriangleCount);
2781
  SetLength(fNewPoints, NewPointCount);
2782
end;
2783

2784
destructor TLevelSurface.Destroy;
2785
var
2786
  i: Integer;
2787
begin
2788
  if Length(fNewPoints) > 0 then
2789
  begin
2790
    for i := 0 to High(fNewPoints) do
2791
      dispose(fNewPoints[i]);
2792
  end;
2793
  inherited Destroy;
2794
end;
2795

2796
{ TSurfaceCollection }
2797

2798
procedure TSurfaceCollection.add(const Surface: TSurface; FillColor, WireColor: TColor);
2799
var j, l, Current: Integer;
2800
begin
2801
  if fCount = fLength then
2802
  begin
2803
    inc(fLength, 10);
2804
    SetLength(fSurfaces, fLength);
2805
  end;
2806
  fSurfaces[fCount] := Surface;
2807
  Surface.fDefaultFillColor := FillColor;
2808
  Surface.fDefaultWireColor := WireColor;
2809
  inc(fCount);
2810
  Current := Length(fCells);
2811
  with fSurfaces[fCount-1] do
2812
  begin
2813
    l := Current + Length(fSurfaceCells);
2814
    SetLength(fCells, l);
2815
    for j := Current to l - 1 do
2816
      fCells[j] := fSurfaceCells[j - Current];
2817
  end;
2818
  Current := Length(fTriangs);
2819
  with fSurfaces[fCount-1] do
2820
  begin
2821
    l:=Current+Length(fTriangles);
2822
    SetLength(fTriangs,l);
2823
    for j:=Current to l-1 do
2824
      fTriangs[j]:=fTriangles[j-Current];
2825
  end;
2826
  fprepared:=false;
2827
end;
2828

2829
procedure TSurfaceCollection.PrepareIllumination;
2830
var i: Integer;
2831
begin
2832
  for i := 0 to High(fTriangs) do
2833
    with fTriangs[i] do
2834
      CrossProduct(p.x - r.x, p.y - r.y, p.z - r.z, q.x - r.x, q.y - r.y, q.z - r.z, n.x, n.y, n.z);
2835
  fPrepared := True;
2836
end;
2837

2838
constructor TSurfaceCollection.Create;
2839
begin
2840
  fLength := 10;
2841
  fCount := 0;
2842
  SetLength(fSurfaces, fLength);
2843
  SetLength(fCells, 0);
2844
  SetLength(fTriangs,0);
2845
  fprepared:=false;
2846
end;
2847

2848
end.
2849

2850