1 unit fpv3d_mainform;
2
3 {$mode objfpc}{$H+}
4
5 interface
6
7 uses
8 Classes, SysUtils, FileUtil, OpenGLContext, Forms, Controls, Graphics,
9 Dialogs, EditBtn, StdCtrls, ComCtrls, fpvectorial, gl, glu, FPimage,
10 Math, lasvectorialreader;
11
12 type
13
14 { TformFPV3D }
15
16 TformFPV3D = class(TForm)
17 Button1: TButton;
18 btnConvert3DPointArrayToHeightMap: TButton;
19 btnRotY: TButton;
20 buttonCutFile: TButton;
21 buttonRotZ: TButton;
22 buttonZoomIn: TButton;
23
24 buttonZoomOut: TButton; buttonLoad: TButton;
25 editFileName: TFileNameEdit;
26 glControl: TOpenGLControl;
27 labelStatus: TLabel;
28 progressBar: TProgressBar;
29 procedure btnConvert3DPointArrayToHeightMapClick(Sender: TObject);
30 procedure btnRotYClick(Sender: TObject);
31 procedure Button1Click(Sender: TObject);
32 procedure buttonCutFileClick(Sender: TObject);
33 procedure buttonLoadClick(Sender: TObject);
34 procedure buttonRotZClick(Sender: TObject);
35 procedure buttonZoomInClick(Sender: TObject);
36 procedure buttonZoomOutClick(Sender: TObject);
37 procedure FormCreate(Sender: TObject);
38 procedure FormDestroy(Sender: TObject);
39 procedure glControlPaint(Sender: TObject);
40 procedure HandleVecDocProgress(APercentage: Byte);
41 private
42 { private declarations }
43 procedure Render3DPointsArrayAlternative1();
44 //
GetMapHeightnull45 function GetMapHeight(X, Y: Integer): Byte;
46 procedure SetVertexColor(bRenderPolygons: Boolean; x, y: Integer);
47 procedure RenderHeightMapV1Helper(bRenderPolygons: Boolean);
48 procedure RenderHeightMapV1;
49 public
50 { public declarations }
51 VecDoc: TvVectorialDocument;
52 glAltitude: Integer;
53 glRotateAngleY, glRotateAngleZ: Double;
54 HeightMap: TvRasterImage;
55 end;
56
57 const
58 STEP_SIZE = 16; // Width And Height Of Each Quad (NEW)
59 HEIGHT_RATIO = 1.5; // Ratio That The Y Is Scaled According To The X And Z (NEW)
60
61 var
62 formFPV3D: TformFPV3D;
63
64 implementation
65
66 {$R *.lfm}
67
68 { TformFPV3D }
69
70 procedure TformFPV3D.glControlPaint(Sender: TObject);
71 begin
72 glControl.SwapBuffers;
73
74 //Render3DPointsArrayAlternative1;
75
76 RenderHeightMapV1();
77 end;
78
79 procedure TformFPV3D.HandleVecDocProgress(APercentage: Byte);
80 begin
81 progressBar.Position := APercentage;
82 Application.ProcessMessages;
83 end;
84
85 procedure TformFPV3D.Render3DPointsArrayAlternative1;
86 var
87 VecPage: TvVectorialPage;
88 i: Integer;
89 lPoint1, lPoint2, lPoint3: TvPoint;
90 lEntity: TvEntity;
91 lPos1, lPos2, lPos3: T3DPoint;
92 lColor: TFPColor;
93 begin
94 glClearColor(1.0, 1.0, 1.0, 1.0);
95 glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
96 glEnable(GL_DEPTH_TEST);
97
98 glMatrixMode(GL_PROJECTION);
99 glLoadIdentity();
100 gluPerspective(45.0, double(width) / height, 0.1, 100.0);
101 glMatrixMode(GL_MODELVIEW);
102 glLoadIdentity();
103
104 glTranslatef(0.0, 0.0,-glAltitude);
105
106 if glRotateAngleY <> 0 then
107 glRotatef(glRotateAngleY, 0, 1, 0);
108 if glRotateAngleZ <> 0 then
109 glRotatef(glRotateAngleZ, 0, 0, 1);
110
111 VecPage := VecDoc.GetCurrentPageAsVectorial();
112 if VecPage = nil then Exit;
113 for i := 0 to VecPage.GetEntitiesCount() - 3 do
114 begin
115 lEntity := VecPage.GetEntity(i);
116 if not (lEntity is TvPoint) then Continue;
117 lPoint1 := lEntity as TvPoint;
118
119 lEntity := VecPage.GetEntity(i+1);
120 if not (lEntity is TvPoint) then Continue;
121 lPoint2 := lEntity as TvPoint;
122
123 lEntity := VecPage.GetEntity(i+2);
124 if not (lEntity is TvPoint) then Continue;
125 lPoint3 := lEntity as TvPoint;
126
127 glBegin(GL_TRIANGLES); // Drawing Using Triangles
128 lPos1 := lPoint1.GetNormalizedPos(VecPage, -1, 1);
129 lPos2 := lPoint2.GetNormalizedPos(VecPage, -1, 1);
130 lPos3 := lPoint3.GetNormalizedPos(VecPage, -1, 1);
131 lColor := lPoint1.Pen.Color;
132 glColor3f(lColor.Red / $FFFF, lColor.Green / $FFFF, lColor.Blue / $FFFF);
133 glVertex3f(lPos1.X, lPos1.Y, lPos1.Z);
134 glVertex3f(lPos2.X, lPos2.Y, lPos2.Z);
135 glVertex3f(lPos3.X, lPos3.Y, lPos3.Z);
136 glEnd(); // Finished Drawing
137 end;
138 end;
139
GetMapHeightnull140 function TformFPV3D.GetMapHeight(X, Y: Integer): Byte;
141 var
142 lPos: TPoint;
143 begin
144 lPos.X := Min(X, HeightMap.RasterImage.Width-1);
145 lPos.Y := Min(Y, HeightMap.RasterImage.Height-1);
146 Result := Byte(HeightMap.RasterImage.Colors[lPos.X, lPos.Y].Red div $FF);
147 end;
148
149 {-----------------------------------------------------------------------------}
150 { Sets The Color Value For A Particular Index, Depending On The Height Index }
151 {-----------------------------------------------------------------------------}
152 procedure TformFPV3D.SetVertexColor(bRenderPolygons: Boolean; x, y : Integer);
153 var fColor : glFloat;
154 begin
155 fColor :=-0.2 + GetMapHeight(X, Y) / $FF;
156
157 // Assign This Blue Shade To The Current Vertex
158 if bRenderPolygons then
159 glColor3f((220-104*fColor)/256, (220-110*abs(fColor-0.4))/256, (220-200*abs(fColor-0.6))/256)
160 else
161 glColor3i(0, 0, 0);
162 end;
163
164 procedure TformFPV3D.RenderHeightMapV1Helper(bRenderPolygons: Boolean);
165 var
166 X, Y : Integer;
167 x2, y2, z2 : Integer;
168 begin
169 if HeightMap = nil then Exit;
170 if HeightMap.RasterImage = nil then Exit;
171
172 if (bRenderPolygons) then // What We Want To Render
173 glBegin( GL_QUADS ) // Render Polygons
174 else
175 glBegin( GL_LINES ); // Render Lines Instead
176
177 X :=0;
178 while X < HeightMap.RasterImage.Width-1 do
179 begin
180 Y :=0;
181 while Y < HeightMap.RasterImage.Height-1 do
182 begin
183 // Get The (X, Y, Z) Value For The Bottom Left Vertex
184 x2 := X;
185 y2 := GetMapHeight(X, Y);
186 z2 := Y;
187
188 // Set The Color Value Of The Current Vertex
189 SetVertexColor(bRenderPolygons, x2, z2);
190
191 // Send This Vertex To OpenGL To Be Rendered (Integer Points Are Faster)
192 glVertex3i(x2, y2, z2);
193
194 // Get The (X, Y, Z) Value For The Top Left Vertex
195 x2 := X;
196 y2 := GetMapHeight(X, Y + STEP_SIZE);
197 z2 := Y + STEP_SIZE ;
198
199 // Set The Color Value Of The Current Vertex
200 SetVertexColor(bRenderPolygons, x2, z2);
201
202 // Send This Vertex To OpenGL To Be Rendered
203 glVertex3i(x2, y2, z2);
204
205 // Get The (X, Y, Z) Value For The Top Right Vertex
206 x2 := X + STEP_SIZE;
207 y2 := GetMapHeight(X + STEP_SIZE, Y + STEP_SIZE);
208 z2 := Y + STEP_SIZE ;
209
210 // Set The Color Value Of The Current Vertex
211 SetVertexColor(bRenderPolygons, x2, z2);
212
213 // Send This Vertex To OpenGL To Be Rendered
214 glVertex3i(x2, y2, z2);
215
216 // Get The (X, Y, Z) Value For The Bottom Right Vertex
217 x2 := X + STEP_SIZE;
218 y2 := GetMapHeight(X + STEP_SIZE, Y );
219 z2 := Y;
220
221 // Set The Color Value Of The Current Vertex
222 SetVertexColor(bRenderPolygons, x2, z2);
223
224 // Send This Vertex To OpenGL To Be Rendered
225 glVertex3i(x2, y2, z2);
226
227 Y :=Y + STEP_SIZE
228 end;
229 X := X + STEP_SIZE
230 end;
231 glEnd();
232 glColor4f(1.0, 1.0, 1.0, 1.0); // Reset The Color
233 end;
234
235 procedure TformFPV3D.RenderHeightMapV1();
236 var
237 ScaleValue: Double;
238 begin
239 // Init
240 glClearColor(0.0, 0.0, 0.0, 0.5); // Black Background
241 glShadeModel(GL_SMOOTH); // Enables Smooth Color Shading
242 glClearDepth(1.0); // Depth Buffer Setup
243 glEnable(GL_DEPTH_TEST); // Enable Depth Buffer
244 glDepthFunc(GL_LEQUAL); // The Type Of Depth Test To Do
245 glDisable(GL_TEXTURE_2D); // Disable Texture Mapping
246 glHint(GL_PERSPECTIVE_CORRECTION_HINT, GL_NICEST); //Realy Nice perspective calculations
247
248 // Resize
249 glViewport(0, 0, Width, Height); // Set the viewport for the OpenGL window
250 glMatrixMode(GL_PROJECTION); // Change Matrix Mode to Projection
251 glLoadIdentity(); // Reset View
252 gluPerspective(45.0, glControl.Width/glControl.Height, 1.0, 500.0); // Do the perspective calculations. Last value = max clipping depth
253 glMatrixMode(GL_MODELVIEW); // Return to the modelview matrix
254 glLoadIdentity(); // Reset View
255
256 //bRender :=TRUE;
257 ScaleValue := 0.18 - glAltitude * 0.01;
258
259 // Paint repetition
260
261 glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT); // Clear The Screen And The Depth Buffer
262 glLoadIdentity(); // Reset The View
263 // Position View Up Vector
264 gluLookAt(212, 60, 194, 186, 55, 171, 0, 1, 0); // This Determines Where The Camera's Position And View Is
265 glScalef(scaleValue, scaleValue * HEIGHT_RATIO, scaleValue);
266
267 // Rotation
268 if glRotateAngleY <> 0 then
269 glRotatef(glRotateAngleY, 0, 1, 0);
270 if glRotateAngleZ <> 0 then
271 glRotatef(glRotateAngleZ, 0, 0, 1);
272
273 RenderHeightMapV1Helper(True);
274 RenderHeightMapV1Helper(False);
275 end;
276
277 procedure TformFPV3D.FormCreate(Sender: TObject);
278 begin
279 VecDoc := TvVectorialDocument.Create;
280 glAltitude := 3;
281 end;
282
283 procedure TformFPV3D.buttonLoadClick(Sender: TObject);
284 begin
285 labelStatus.Caption := 'Loading file';
286 VecDoc.OnProgress := @HandleVecDocProgress;
287 VecDoc.ReadFromFile(editFileName.FileName);
288 labelStatus.Caption := 'Done';
289 glControl.Invalidate;
290 end;
291
292 procedure TformFPV3D.buttonRotZClick(Sender: TObject);
293 begin
294 glRotateAngleZ := glRotateAngleZ + 10;
295 glControl.Invalidate;
296 end;
297
298 procedure TformFPV3D.buttonZoomInClick(Sender: TObject);
299 begin
300 Dec(glAltitude);
301 if glAltitude < 1 then glAltitude := 1;
302 glControl.Invalidate;
303 end;
304
305 procedure TformFPV3D.buttonZoomOutClick(Sender: TObject);
306 begin
307 Inc(glAltitude);
308 glControl.Invalidate;
309 end;
310
311 procedure TformFPV3D.Button1Click(Sender: TObject);
312 begin
313 glControl.Invalidate;
314 end;
315
316 procedure TformFPV3D.btnConvert3DPointArrayToHeightMapClick(Sender: TObject);
317 var
318 lRasterImage: TvRasterImage;
319 lPage: TvVectorialPage;
320 lFile: TFileStream;
321 x, y: Integer;
322 lRed: Word;
323 begin
324 lPage := VecDoc.GetPageAsVectorial(0);
325 lRasterImage := TvRasterImage.Create(lPage);
326 HeightMap := lRasterImage;
327 lPage.AddEntity(lRasterImage);
328 lRasterImage.InitializeWithConvertionOf3DPointsToHeightMap(lPage, 1024, 1024);
329
330 lFile := TFileStream.Create('Terrain.raw', fmCreate);
331 try
332 for x := 0 to 1023 do
333 for y := 0 to 1023 do
334 begin
335 lRed := lRasterImage.RasterImage.Colors[x, y].Red;
336 lFile.WriteByte(Byte(lRed div $FF));
337 end;
338 finally
339 lFile.Free;
340 end;
341
342 glControl.Invalidate;
343 end;
344
345 procedure TformFPV3D.btnRotYClick(Sender: TObject);
346 begin
347 glRotateAngleY := glRotateAngleY + 10;
348 glControl.Invalidate;
349 end;
350
351 procedure TformFPV3D.buttonCutFileClick(Sender: TObject);
352 var
353 lPage: TvVectorialPage;
354 begin
355 VecDoc.ReadFromFile(editFileName.FileName);
356 //lPage := VecDoc.GetPage(0);
357 //while lPage.DeleteEntity(20000) do ;
358 VecDoc.WriteToFile(editFileName.FileName + 'smaller.las');
359 end;
360
361 procedure TformFPV3D.FormDestroy(Sender: TObject);
362 begin
363 VecDoc.Free;
364 end;
365
366 end.
367
368