This chapter evaluates the work done, then goes on to
analyse the extent to which requirements were met. The last section discusses
the methods used.
There was no formal testing plan as such, due to the visual
nature of the project. The best test was the apparent correctness of the
eventual visual output - if the
visualisation looked like a glacier then it was deemed to be successful. Each
module was tested for correctness.
Triangulation
Whilst working on the triangulation, a spreadsheet was
created using 25 points to permit to investigate the behaviour of the nearest
neighbour algorithm. The same 25 points were run through the program and the
results compared with the spreadsheet. At first the values did not match up - a logical
error was identified. This was quickly rectified, by slightly altering the loop
structure responsible.
Although it functioned correctly, this module was not used
in the final system because of the move to using a Height Map rather than a TIN
model. Following this alteration, the
triangulation module was no longer needed.
File Handling
Validation routines strip out incomplete records and text as
files are imported. A logical error was found in the validation code in the
import stage. A loop counter was being increased where records were not added,
resulting in the system recording a larger number of points. This caused some
errors in some of the loop structures that ran out of points to process and
introduced zeros into the calculations. The error only applied to creating
triangles and producing the terrain map used imported data only.
During testing an error was discovered when files were
opened. More specifically, while importing a selected file, an error occurred,
crashing the program, if the Cancel button was pressed. Although the type of
file was subject to validation, there was no validation on the Cancel event
with the result that the program would try and load a file with a blank name.
To fix this an extra validation rule was added to check the filename length was
greater than zero. Additionally, a Common File Open dialog was used both to
import files and to connect to a database. This could result in an error in the
case of a file import after which the user attempts to open a database
connection but cancels before choosing a file, where the system would attempt
to open a database with the same name as the file being imported. To fix this
the filename file was reset as soon as the common dialog box was called.
Database operations
Data is checked for validity before being written to the
database; incomplete records (missing Northing Easting or MASL) are rejected.
The functional requirements of the system were: -
- Read
in data sets
- Transform
Data Sets
- Provide
a visualisation of the GPS data sets.
- Calculations
comparing the two datasets
- Ability
to export data for use with GIS packages
The first three of these requirements were fully met; the
system was able to read in both the 1995 and 1996 data sets. The system was
able to the transform this and produce a visualisation. Unfortunately the
system did not progress to the stage in which computerised comparison of data
sets was possible. There are many
reasons why the remaining requirements were not met. The overrun in the amount
of time taken to produce the import routines and initial visualisation. Plus
the time cost of switching the method used to visualise the object meant a
choice had to be made as to what the focus of the project should be. The
decision to concentrate on the production of the initial visualisation allowed
the major requirements to be completed to a reasonable standard rather than
rushing the entire project.
The Visual Basic Windows Application certainly has a higher
usability than the C++ code would have allowed, mainly due the Visual Basic
creating familiar buttons, and menus plus “tool tip” help on mouse hover over
events. The data validation added means that the program prevents the user from
inputting incorrect information and carrying out impossible operations (such as
attempting to visualise a scene without choosing survey data).
The system is certainly modular enough to easily allow
extensions to the system, the use of database is currently set up for Microsoft
Access however the syntax commands would be the same only the database
connection method would need altering. Using a database mean other modules can
be built and use the shared data.
The quality of the visualised image was technically as high
as the data would allow, however it did not look realistic enough and it was
difficult to see the texture of the survey. This would require more advance
lighting and texturing techniques such as bump mapping. Time did not allow for
these methods to be incorporated however. The speed of image generation was a
non-functional requirement; OpenGL needs to open a graphics subsystem to load
before it renders the artefact, this causes a performance delay. Add to this
the time taken to generate the image by the system and the total time to
display the image is significant. The render time is about one minute (on an
Intel Celeron 400mhz 640MB Ram, Nvidia Geforce II 32MB graphics card) this will
depend on the system the program is running on. Though one minute is a
reasonable long time in computer terms it once rendered the image can be
manipulated in real-time.
Reusability of code was a stated requirement and this has
been achieved to a high degree functions are called by different procedures
using message passing raising the reusability level as high as possible.
The evolutionary method proved to be
a valid method of dealing with the project as it allowed for the system to
change language used and to change the implementation to cope with the
limitations of the data sets that were not apparent at the start. This method
also allowed the various modules to be expanded in a controlled way as the
complexities of the design became apparent.
Object orientated
method of design was used; however for various reasons this proved to be less
effective than the implementation method. While Object modelling was intended
to help software designers more effectively model the real world, the model has
a very steep learning curve and requires the designer to devote a lot of time
analysing how the object structure could best map the real world problem.
Another problem with the object orientated method appeared when the code base
was moved to Visual Basic. Visual Basic 6 is not an object-orientated language;
it is only object based. On the other hand C++ is a compiled language with
faster execution times than Visual Basic, (assuming of course the code is well
written - poorly written code will run slowly). Code can be compiled for a
variety of platforms and operating systems. C++ is object oriented so fits well
with the object orientated design process. This meant that the design did not
map as neatly into Visual Basic code.
The system fulfilled many of the requirements of the
project; a visualisation was produced from imported data. A database of survey
results was generated and could be written to and read from.
While aware that the project had a high level of complexity
at the start, it proved to be much higher than expected. The mathematics and
programmatic structures needed to calculate the image vector and vertices
proving particularly complicated.
The decision to use OpenGL had a number of consequences,
although the image quality OpenGL can produce is very high it proved to be a
very difficult medium to explore and exploit adding a great deal of time onto
the project implementation. The level of realism of the resultant image while
accurately mapping the information from the data sets did not display the
glacier surface with a high level of visible detail. Extra techniques to
enhance the image were possible, adding lighting effect, and bump mapping,
however these would have required a significant amount of extra work, both
adding code to the image generation process and working out the maths required.
Another improvement that could be made to the image is to add Texture mapping
to improve the visualisation of the terrain map.
Overall the use of OpenGL led to many problems and did not
provide the sort of visualisation hoped for. That said the others methods
available would have almost certainly had similar difficult problems and in the
case of linking to a piece of third party software would have reduced the
expandability of the project. OpenGL is a complex language and proved a
difficult path to follow.
Although the switch to the height-map method of
visualisation added a lot of time taken to complete that module that in turn
meant the compare functions and export functions were not completed. However
although the loss of these functions left a gap in the programs functionality
the decision to omit them allowed a more comprehensive attempt at fulfilling
the other requirements and which was a good choice of action as the parts of
the project that were implemented worked well.
This proved to be a complex project with a difficult
solution although the start of the project took the wrong direction, a good
choice of implementation methodology allowed things to be turned around and a
good solution achieved.
Apart from improving the quality of the visualisation the
following problems could have been added.
Volume of Solid
Displayed
An estimate of the volume of the solid displayed could be
made as follows:
Each height (MASL) stored in the grid is associated with the
same area, since dividing the ranges of Easting and Northing into 1024 equal
parts formed the grid. For Example Take the 1995 Survey
Range of Easting = 8460.05;
Cell size (E) = 8460.05 ÷1024 =
8.26
Range of Northing = 7936.193
Cell size (N) = 7936.193÷1024 =
7.75
Area of cell = 8.26 x 7.75 units2
= 64 units2
Subtract the minimum value of MASL from each MASL value in
the grid and form a sum. Then, multiply by the cross-sectional area of a cell.
Even without the latter step, the sum is proportional to the volume of the
figure.
Comparing Two Figures
Comparisons of different data sets could be made as follows:
- Build
a common grid (Easting by Northing) that accommodates both surveys.
- Find
the least and greatest values of MASL shared between both surveys.
- Map
the survey points from the first survey into the grid
- Map
survey points from the second survey into the grid, subtracting the MASL
value of the second survey from the MASL value of the first.
- Plot the
difference.
Another possible
extension to the project would be to convert it C++ this would greatly improve
the executions times and it technically possibly. Much same structure could be
used with very little tweaking, indeed when code originally written in C++ was
converted to Visual Basic much of the structure was the same the main
difference being in the typing of variables. In any conversion the OpenGL code
would be almost exactly the same
Thanks to Roger Braithwaite for all his help, and to Andrew
Conroy for all his programming tips, and advice.
API An application program interface (API -
and sometimes spelled application programming interface) is the specific method
prescribed by a computer operating system or by an application program by which
a programmer writing an application program can make requests of the operating
system or another application.
GIS Geographical Information System, a
computerised system for working with spatial data.
GPS Global Positioning System, a satellite
network which using a receiver, displays position with a high degree of
accuracy.
HCI Human Computer Interaction, the link
between the operator of the system and the system itself.
MASL Metres
Above Sea Level, height recording using sea level as a baseline.
UML Unified Modelling Language, defines the
components that will be used to build a systems and the interfaces that will
connect is components
SQL Structured Query Language, a high level
programming language used with database systems.
TIN Triangular Irregular Network, a series of
interconnection triangles arrange in a way to produce a continuous object or
surface.
Angel, E (2002), ‘OpenGL a primer’ Addison-Wesley USA.
Ashford, J and Odam, J (1998), ‘Getting started with 3D a designers guide
to 3D graphics and illustration’, Peachpit Press USA.
Bielig-Schulz, G
and Schultz, CH (1990) ‘3D Graphics in
Pascal’, Wiley England.
Deitel HM, Deitel, PJ (2002), ‘Java How to program 4th
Edition’, Prentice Hall USA.
Eliens, A (2000), ‘Object-Oriented Software Development 2nd Edition ’,
Pearson Education Ltd, Essex.
Kernighan, BW and Richie, DM (1988), ‘The C programming language 2nd
Edition’, Prentice Hall USA.
Longley PA, et al (2001), ‘Geographic Information Systems and Science’,
Wiley England.
Melofee, J (2003), ‘Neon Helium Productions Open GL Tutorials’, http://nehe.gamedev.net
Mirosoft Corporation, ‘Microsoft’s
DirectX Homepage’, http://www.microsoft.com/windows/directx/default.asp
Microsoft
Corporation, ‘MSDN DirectX Community’,
http://msdn.microsoft.com/community/directx.asp
OpenGL “The OpenGL Website”, http://www.opengl.org/
A great deal of information about OpenGL
programming guides information news of the upcoming OpenGL 2 specification and
links to many other OpenGL sites.
Pressman, R (2000), ‘Software Engineering A Practitioner’s Approach 5th Edition’,
Magraw Hill.
Terrex, “Digital Terrain Modeling”, http://www.terrex.com
Theakstone WH, Jacobsen, FM (1997), ‘Digital Terrain modelling of the surface
and bed topography of the glacier Austre Okstindbreen, Okstindan, Norway’
Geografiska Annaler 79A pp 201-214.
Theakstone, WH et al (1999), ‘Changes of snow cover thickness measured by
conventional mass balance methods and by global positioning system surveying’,
Geografiska Annaler 81A pp 767-776.
Whatis?com, ‘Whatis – Definitions for thousands of the most current IT-related
words.’, http://www.whatis.com/ Definitions for thousands of the most current IT-related words.
Woo, M et al (1999), ‘OpenGL programming guide: the official guide to learning openGL
version 1.2 – 3rd edition’ Addison-Wesley USA.
Zaratian, B (1998), ‘Visual C++ 6.0 programmers guide’, Microsoft Press Redmond USA.
Figure 1 Comparison table of methods 14
Figure 2 Use Case Diagram. 18
Figure 3 Database Design. 19
Figure 4 System Design. 19
Figure 5 Visualisation of the Survey Points 22
Figure 6 Graph Demonstrating the Sparse
Spread of Survey Points 23
Figure 7 Screen Shot - Opening a file for
import 25
Figure 8 Screen shot – A Common Dialog box
used to open a database. 25
Figure 9 Screen Shot - Manage Survey Dialog. 26
Figure 10 Screen Shot - Add New Survey 26
Figure 11 Screen Shot - Adding the imported
values to the survey database. 27
Figure 12 Screen Shot - Choose Data to Visualise. 27
Figure 13 Screen Shot of a Visualisation. 28
Figure 14 Screen Shot of a Visualisation Wire
frame Mode. 29
Figure 15 - Graph of the 1995 Glacial Study
using a 32 by 32 Grid. 30
Figure 16 Graph showing the interpolation
methodology 32
This appendix contains some (but not all) of the code from
the system, I have included the more important routine to give a flavour of the
system.
Globals Module
Public Const gridSize = 1024
'Varibles use to read and error check input
Global ReadFile() As String
Global Northing() As Double
'Array of northing points
Global Easting() As Double
'Array of Easting Points
Global masl() As Double
'Array of meters abouve sea level
'Global sDate() As Long
'Array of dates
Global RecordCounter As Integer
Public conDB As ADODB.Connection 'Connection to database
Public adoRS As ADODB.Recordset
'Database recordset
Global dataOpen As Boolean 'Used to test whether the database is
open
Global id() As Integer
Global survey() As String
Global SCounter As Integer
Global Current_Survey As Integer
Global dataImport As Boolean
Global Terrain(0 To gridSize - 1, 0 To gridSize - 1) As Byte
'intialise varibles
Public Sub main()
Let dataOpen = False
frmImport.Show
End Sub
Public Sub Read_Survey(mod_name As Object)
Dim i As Integer
Set rsSurvey =
conDB.Execute("select * from survey")
SCounter = 0
' loop through the
recordset adding items to the list box
Do While Not
rsSurvey.EOF
SCounter = SCounter +
1
rsSurvey.MoveNext
Loop
ReDim id(1 To SCounter)
ReDim survey(1 To
SCounter, 1 To 3)
rsSurvey.MoveFirst
For i = 1 To SCounter
'count the number
of records in the database
id(i) =
rsSurvey.Fields("surveyID")
survey(i, 1) =
rsSurvey.Fields("surveyName")
If
rsSurvey.Fields("surveydetails") <> "" Then
survey(i, 3) =
rsSurvey.Fields("surveyDetails")
End If
If
rsSurvey.Fields("sdate") <> "" Then
survey(i, 2) =
rsSurvey.Fields("sdate")
End If
mod_name.cboSurveys.AddItem (survey(i, 1))
rsSurvey.MoveNext
Next i
'id and name must be
completed so need need to test them
mod_name.txtSName.Text
= survey(1, 1)
mod_name.txtComment.Text = survey(1, 3)
mod_name.txtDate.Text =
survey(1, 2)
mod_name.cboSurveys.ListIndex = 0 ' default to the first survey
End Sub
Public Function Select_Survey(mod_name As Object) As Integer
mod_name.txtSName.Text
= survey(mod_name.cboSurveys.ListIndex + 1, 1)
mod_name.txtDate.Text =
survey(mod_name.cboSurveys.ListIndex + 1, 2)
mod_name.txtComment.Text = survey(mod_name.cboSurveys.ListIndex + 1, 3)
Select_Survey =
id(mod_name.cboSurveys.ListIndex + 1)
End Function
Mod_terrain
'The number of points in each cell
Dim points(0 To gridSize - 1, 0 To gridSize - 1) As Integer
Dim grid(0 To gridSize - 1, 0 To gridSize - 1) As Double
Public Sub setpoint(east As Double, north As Double, masl As
Double, minEast As Double, maxEast As Double, _
minNorth As Double, maxNorth As Double)
Dim e As Integer
Dim n As Integer
Dim tempE As Double
Dim tempN As Double
Dim range As Double
'Easting first
range = maxEast -
minEast
range = 1.000001 *
range
tempE = (east -
minEast) / range
tempE = gridSize *
tempE
e = Int(tempE)
'now northing
range = maxNorth -
minNorth
range = 1.000001 *
range
tempN = (north -
minNorth) / range
tempN = gridSize *
tempN
n = Int(tempN)
If grid(e, n) > 0
Then
grid(e, n) =
((grid(e, n) * points(e, n)) + masl) / (points(e, n) + 1)
Else
grid(e, n) = masl
End If
points(e, n) =
points(e, n) + 1
End Sub
Private Sub countpoints()
Dim e As Integer
Dim n As Integer
Dim count As Long
count = 0
For e = 0 To gridSize
- 1
For n = 0 To gridSize
- 1
count = count +
points(e, n)
Next n
Next e
count = 0
For e = 0 To gridSize
- 1
For n = 0 To gridSize
- 1
If grid(e, n) > 0
Then
count = count + 1
End If
Next n
Next e
End Sub
Public Sub makeGrid()
Dim i As Integer
Dim minN As Double
Dim minE As Double
Dim maxN As Double
Dim maxE As Double
Let minN = 1000000
Let minE = 1000000
Let maxN = 0
Let maxE = 0
Let minN =
getMin(Northing)
Let minE =
getMin(Easting)
Let maxN =
getMax(Northing)
Let maxE =
getMax(Easting)
frmProgress.ProgressBar1.Min = 0
frmProgress.ProgressBar1.Max = RecordCounter
frmProgress.ProgressBar1.Value =
frmProgress.ProgressBar1.Min
frmProgress.ProgressBar1.Visible = True
frmProgress.txtName.Text
= "Generating Grid"
frmProgress.Show
For i = 1 To
RecordCounter
Call
setpoint(Easting(i), Northing(i), masl(i), minE, maxE, minN, maxN)
frmProgress.ProgressBar1.Value = frmProgress.ProgressBar1.Value + 1
frmProgress.Refresh
Next i
frmProgress.Hide
End Sub
Public Function getMin(arr() As Double) As Double
Dim result As Double
Dim i As Integer
result = arr(1)
For i = 2 To
RecordCounter
If arr(i) <
result Then
result =
arr(i)
End If
Next i
getMin = result
End Function
Public Function countNorth(n As Integer) As Integer
'Counts the number of
points east for a given northing
Dim count As Integer
Dim i As Integer
Let count = 0
For i = 0 To (gridSize
- 1) 'Move through the grid
If grid(i, n) > 0
Then 'test if a value occurs at each grid point
Let count = count +
1
End If
Next i
countNorth = count
End Function
Public Function countEast(e As Integer) As Integer
'Counts the number of
points east for a given northing
Dim count As Integer
Dim i As Integer
Let count = 0
For i = 0 To (gridSize
- 1) 'Move through the grid
If grid(e, i) > 0
Then 'test if a value occurs at each grid point
Let count = count +
1
End If
Next i
countEast = count
End Function
Public Function NextE(n As Integer, Start As Integer) As Integer
'Finds the Next Point
along one grid line heading east in the grid
Dim i As Integer
Dim result As Integer
Let result = -1
'Do While i <
gridSize And grid(i, N) = 0 'Test if a
value found and if the edge of the grid is reached
' i = i + 1
'Loop
For i = Start To
gridSize - 1
If grid(i, n) > 0
Then
result = i
Exit For
End If
Next i
NextE = result
End Function
Public Function NextN(e As Integer, Start As Integer) As Integer
'Finds the Next Point
along one grid line heading north in the grid
Dim i As Integer
Dim result As Integer
Let result = -1
'Do While grid(E, i) =
0 And i < gridSize 'Test if a value found and if the edge of the grid is
reached
' i = i + 1
'Loop
For i = Start To
gridSize - 1
If grid(e, i) > 0
Then
result = i
Exit For
End If
Next i
NextN = result
End Function
Public Sub inTerPolate()
'Estimate the values of
cells in the grid between the measured points
'Firstly in an easterly
direction then northerly
'Negate the interpolated
points so they can be determine from the measured ones
Dim e As Integer
Dim n As Integer
Dim i As Integer
Dim iFrom As Integer
Dim iTo As Integer
Dim STeps As Integer
Dim Interval As Integer
Dim HeightDiff As Double
Dim temp As Double
frmProgress.ProgressBar1.Min = 0
frmProgress.ProgressBar1.Max = gridSize + gridSize
frmProgress.ProgressBar1.Value = frmProgress.ProgressBar1.Min
frmProgress.ProgressBar1.Visible = True
frmProgress.Show
'East first
For e = 0 To gridSize -
1
count = countEast(e)
If count > 1 Then
Let STeps = 0
Let iFrom = 0
Do
Let iFrom =
NextN(e, iFrom)
Let iTo =
NextN(e, iFrom + 1)
STeps = STeps + 1
Interval = iTo
- iFrom
HeightDiff =
grid(e, iTo) - grid(e, iFrom)
For i = iFrom +
1 To iTo - 1
grid(e, i) =
(i - iFrom) * HeightDiff / Interval + grid(e, iFrom)
Let grid(e,
i) = -grid(e, i)
Next i
iFrom = iTo
Loop While STeps
< count - 1
End If
frmProgress.ProgressBar1.Value = frmProgress.ProgressBar1.Value + 1
frmProgress.Refresh
Next e
'next north
For n = 0 To gridSize - 1
count = countNorth(n)
If count > 1 Then
Let STeps = 0
Let iFrom = 0
Do
Let iFrom =
NextE(n, iFrom)
Let iTo =
NextE(n, iFrom + 1)
STeps = STeps +
1
Interval = iTo
- iFrom
HeightDiff = grid(iTo, n) - grid(iFrom,
n)
For i = iFrom +
1 To iTo - 1
Let temp =
grid(i, n)
grid(i, n) =
(i - iFrom) * HeightDiff / Interval + grid(iFrom, n)
Let grid(i,
n) = -grid(i, n)
If Abs(temp) > 0 Then
'Due to
the fact points heights are geing averaged there might be a
'difference in height between the north and east grid lines
'so we are
averaging out the height at the intersections
Let
grid(i, n) = (Abs(temp) + Abs(grid(i, n))) / 2
Let
grid(i, n) = -grid(i, n)
End If
Next i
iFrom = iTo
Loop While STeps
< count - 1
End If
frmProgress.ProgressBar1.Value = frmProgress.ProgressBar1.Value + 1
frmProgress.Refresh
Next n
frmProgress.Hide
End Sub
Public Sub resetPoints()
'resets the negative
values (used to differenciate calulated values)
Dim count As Long
Dim e As Integer
Dim n As Integer
For e = 0 To gridSize -
1
For n = 0 To
gridSize - 1
grid(e, n) =
Abs(grid(e, n))
If (grid(e, n)
> 0) Then
count = count
+ 1
End If
Next n
Next e
End Sub
Public Function getMax(arr() As Double) As Double
Dim result As Double
Dim i As Integer
result = arr(1)
For i = 2 To
RecordCounter
If arr(i) >
result Then
result =
arr(i)
End If
Next i
getMax = result
End Function
Private Sub MapTerrain(minMASL As Double, maxMASL As Double)
'MapTerrain scale the
measured data so that they correspond
'to the height range of
MASL.
Dim e As Integer
Dim n As Integer
Dim rangeMASL As Double
Let rangeMASL = maxMASL
- minMASL
For e = 0 To gridSize
- 1
For n = 0 To
gridSize - 1
If grid(e, n) >
0 Then
Terrain(e, n) =
_
Int(255 *
(grid(e, n) - minMASL) / rangeMASL)
If (Terrain(e,
n) > 255) Then
MsgBox
"Terrain too big", vbOKOnly
End If
If (Terrain(e,
n) < 0) Then
MsgBox
"Terrain too small", vbOKOnly
End If
Else
Terrain(e, n)
= 0
End If
Next n
Next e
End Sub
Public Sub genTerrain()
Dim minMASL As Double
Dim maxMASL As Double
minMASL = getMin(masl)
maxMASL = getMax(masl)
frmProgress.txtName.Text
= "Interpolating Points Pass 1 of 2"
Call inTerPolate
Call resetPoints
'functions are recalled
to cover any new points exposed
frmProgress.txtName.Text =
"Interpolating Points Pass 2 of 2"
Call inTerPolate
Call resetPoints
Call MapTerrain(minMASL,
maxMASL)
End Sub
OpenGL Routines
Option Explicit
‘ This module is a modified version of tutorial 31 from
http://nehe.gamedev.net
' a couple of declares to work around some deficiencies of the
type library
' Problems are with the parameter declaration if someone wants to
fix it
' I'd love to have a copy so I can remove these declarations
' I currently do not have
the time to fix vbogl.tlb
'
' Please make sure that you have the type lib registered
' if you do not have a copy of vbogl.tlb
' you can get it here http://is6.pacific.net.hk/~edx/contents.htm
Private Declare Function EnumDisplaySettings Lib
"user32" Alias "EnumDisplaySettingsA" (ByVal lpszDeviceName
As Long, ByVal iModeNum As Long, lpDevMode As Any) As Boolean
Private Declare Function ChangeDisplaySettings Lib
"user32" Alias "ChangeDisplaySettingsA" (lpDevMode As Any,
ByVal dwflags As Long) As Long
Private Declare Function CreateIC Lib "gdi32" Alias
"CreateICA" (ByVal lpDriverName As String, ByVal lpDeviceName As
String, ByVal lpOutput As String, ByVal lpInitData As Long) As Long
Private Const CCDEVICENAME = 32
Private Const CCFORMNAME = 32
Private Const HEIGHT_RATIO = 1.5
Private Const MAP_SIZE = 1024
Private Const STEP_SIZE = 8
Dim bRender As Boolean
Dim scaleValue As Single
'Private Const DM_BITSPERPEL = &H40000
'Private Const DM_PELSWIDTH = &H80000
'Private Const DM_PELSHEIGHT = &H100000
' DEVMODE declare used to query Windows for the
' Display device settings
' the one in the typelib has problems so I included this one.
Private Type DEVMODE
dmDeviceName As String * CCDEVICENAME
dmSpecVersion As Integer
dmDriverVersion As Integer
dmSize As Integer
dmDriverExtra As Integer
dmFields As Long
dmOrientation As Integer
dmPaperSize As Integer
dmPaperLength As Integer
dmPaperWidth As Integer
dmScale As Integer
dmCopies As Integer
dmDefaultSource As Integer
dmPrintQuality As Integer
dmColor As Integer
dmDuplex As Integer
dmYResolution As Integer
dmTTOption As Integer
dmCollate As Integer
dmFormName As String * CCFORMNAME
dmUnusedPadding As Integer
dmBitsPerPel As Integer
dmPelsWidth As Long
dmPelsHeight As Long
dmDisplayFlags As Long
dmDisplayFrequency As Long
End Type
Public Keys(255) As Boolean ' used to keep track of key_downs
Private hrc As Long ' handle for OpenGL redering context
Private fullscreen As Boolean ' are we in full screen
Private OldWidth As Long ' used to restore the starting display settings
Private OldHeight As Long ' Height
Private OldBits As Long ' bit per pixel
Private OldVertRefresh As Long ' and vertical refresh
Private mPointerCount As Integer ' maintains the number of show/hide cursor calls
Private xSpeed, ySpeed As Single
Private xAngle, yAngle As Single
Private Sub HidePointer()
' hide the cursor
(mouse pointer)
mPointerCount =
ShowCursor(False) + 1 ' how many times
will we need to hide the pointer
Do While
ShowCursor(False) >= -1 ' make
sure it's hidden
Loop
Do While
ShowCursor(True) <= -1 ' make
sure the next call will show it
Loop
ShowCursor False ' one last time
End Sub
Private Sub ShowPointer()
' show the cursor
(mouse pointer)
Do While
ShowCursor(False) >= mPointerCount ' restore the cursor back to normal
Loop
Do While
ShowCursor(True) <= mPointerCount
Loop
End Sub
Public Sub ReSizeGLScene(ByVal Width As GLsizei, ByVal Height As
GLsizei)
' Resize And Initialize The GL Window
If Height = 0
Then ' Prevent A Divide By
Zero By
Height = 1 ' Making Height Equal One
End If
glViewport 0, 0, Width, Height ' Reset The Current Viewport
glMatrixMode
mmProjection ' Select The
Projection Matrix
glLoadIdentity ' Reset The Projection
Matrix
' Calculate The Aspect
Ratio Of The Window
gluPerspective 45#,
Width / Height, 0.1, 10000# '100#
glMatrixMode
mmModelView ' Select The
Modelview Matrix
glLoadIdentity ' Reset The Modelview Matrix
End Sub
Public Function InitGL() As Boolean
' All Setup For OpenGL Goes Here
glShadeModel
smSmooth ' Enables Smooth
Shading
glClearColor 0#, 0#,
0#, 0.5 ' Black Background
glClearDepth 1# ' Depth Buffer Setup
glEnable
glcDepthTest ' Enables
Depth Testing
glDepthFunc cfLEqual ' The Type Of Depth Test To Do
glHint
htPerspectiveCorrectionHint, hmNicest
' Really Nice Perspective Calculations
InitGL = True ' Initialization Went
OK
' xSpeed = 0.1 ' start with some movement
' ySpeed = 0.1
xSpeed = 1 ' start with some movement
ySpeed = 1
End Function
Public Sub KillGLWindow()
' Properly Kill The Window
If fullscreen
Then ' Are
We In Fullscreen Mode?
ResetDisplayMode ' If So Switch
Back To The Desktop
ShowPointer ' Show Mouse
Pointer
End If
If hrc Then ' Do We
Have A Rendering Context?
If wglMakeCurrent(0, 0) = 0 Then ' Are We Able To Release The DC
And RC Contexts?
MsgBox
"Release Of DC And RC Failed.", vbInformation, "SHUTDOWN
ERROR"
End If
If
wglDeleteContext(hrc) = 0 Then
' Are We Able To Delete The RC?
MsgBox
"Release Rendering Context Failed.", vbInformation, "SHUTDOWN
ERROR"
End If
hrc = 0 ' Set RC
To NULL
End If
' Note
' The form owns the
device context (hDC) window handle (hWnd) and class (RTThundermain)
' so we do not have to
do all the extra work
End Sub
Private Sub SaveCurrentScreen()
' Save the current
screen resolution, bits, and Vertical refresh
Dim ret As Long
ret =
CreateIC("DISPLAY", "", "", 0&) ' create display information
context
OldWidth =
GetDeviceCaps(ret, HORZRES) '
get the current width
OldHeight =
GetDeviceCaps(ret, VERTRES) '
and current height
OldBits =
GetDeviceCaps(ret, BITSPIXEL) '
and bits per pixel (color depth)
OldVertRefresh =
GetDeviceCaps(ret, VREFRESH) ' and
current refresh rate (this may cause problems in Win98
ret =
DeleteDC(ret)
' delete the information context
End Sub
Private Function FindDEVMODE(ByVal Width As Integer, ByVal Height
As Integer, ByVal Bits As Integer, Optional ByVal VertRefresh As Long = -1) As
DEVMODE
' locate a DEVMOVE
that matches the passed parameters
Dim ret As
Boolean ' return value from api
Dim i As Long ' loop counter
Dim dm As DEVMODE ' Device mode
i = 0
Do ' enumerate the display settings until we
find the one we want
ret =
EnumDisplaySettings(0&, i, dm) '
get windows to enumerate the display settings
If dm.dmPelsWidth
= Width And _
dm.dmPelsHeight = Height And _
dm.dmBitsPerPel = Bits And _
((dm.dmDisplayFrequency = VertRefresh) Or (VertRefresh = -1)) Then Exit
Do ' exit when we have a match
i = i + 1
Loop Until (ret =
False)
FindDEVMODE = dm
End Function
Private Sub ResetDisplayMode()
Dim dm As DEVMODE ' Device Mode
dm =
FindDEVMODE(OldWidth, OldHeight, OldBits, OldVertRefresh) ' find our old
display mode
dm.dmFields = DM_BITSPERPEL Or DM_PELSWIDTH
Or DM_PELSHEIGHT ' what we are about
to change
If OldVertRefresh
<> -1 Then
dm.dmFields =
dm.dmFields Or DM_DISPLAYFREQUENCY
' include vertical refresh
End If
' Try To Set Selected
Mode And Get Results. NOTE:
CDS_FULLSCREEN Gets Rid Of Start Bar.
If
(ChangeDisplaySettings(dm, CDS_FULLSCREEN) <> DISP_CHANGE_SUCCESSFUL)
Then
' If The Mode
Fails, Offer Two Options. Quit Or Run
In A Window.
MsgBox "The
Requested Mode Is Not Supported By Your Video Card", , "Fatal"
End If
End Sub
Private Sub SetDisplayMode(ByVal Width As Integer, ByVal Height
As Integer, ByVal Bits As Integer, ByRef fullscreen As Boolean, Optional
VertRefresh As Long = -1)
Dim dmScreenSettings
As DEVMODE ' Device Mode
Dim p As Long
SaveCurrentScreen ' save the current
screen attributes so we can go back later
dmScreenSettings =
FindDEVMODE(Width, Height, Bits, VertRefresh) ' find a device mode that matches
dmScreenSettings.dmBitsPerPel = Bits
' set pixel bits
dmScreenSettings.dmPelsWidth = Width
' width
dmScreenSettings.dmPelsHeight = Height
' height
dmScreenSettings.dmFields = DM_BITSPERPEL Or DM_PELSWIDTH Or
DM_PELSHEIGHT ' what we are going to change
If VertRefresh
<> -1 Then
dmScreenSettings.dmDisplayFrequency = VertRefresh ' include vertical
refresh
dmScreenSettings.dmFields = dmScreenSettings.dmFields Or
DM_DISPLAYFREQUENCY
End If
' Try To Set Selected
Mode And Get Results. NOTE:
CDS_FULLSCREEN Gets Rid Of Start Bar.
If
(ChangeDisplaySettings(dmScreenSettings, CDS_FULLSCREEN) <>
DISP_CHANGE_SUCCESSFUL) Then
' If The Mode
Fails, Offer Two Options. Quit Or Run
In A Window.
If
(MsgBox("The Requested Mode Is Not Supported By" & vbCr &
"Your Video Card. Use Windowed Mode Instead?", vbYesNo +
vbExclamation, "Fatal") = vbYes) Then
fullscreen =
False ' Select Windowed
Mode (Fullscreen=FALSE)
Else
' Pop Up A
Message Box Letting User Know The Program Is Closing.
MsgBox
"Program Will Now Close.", vbCritical, "ERROR"
End ' Exit And Return FALSE
End If
End If
End Sub
Public Function DrawGLScene() As Boolean
' Here's Where We Do All The Drawing
glClear
clrColorBufferBit Or clrDepthBufferBit
' Clear The Screen And The Depth Buffer
glLoadIdentity ' Reset The
Current Modelview Matrix
If Keys(vbKeyLeft) Then
Let yAngle = yAngle - ySpeed
If Keys(vbKeyRight) Then
Let yAngle = yAngle + ySpeed
'If Keys(vbKeyAdd) Then
xAngle = xAngle + xSpeed
'If Keys(vbKeySubtract)
Then xAngle = xAngle - xSpeed
If Keys(vbKeyAdd) Then
scaleValue = scaleValue + 0.001
If Keys(vbKeySubtract)
Then scaleValue = scaleValue - 0.001
'If Keys(vbKeyUp) Then
scaleValue = scaleValue + 0.001
'If Keys(vbKeyDown) Then
scaleValue = scaleValue - 0.001
If Keys(vbKeyUp) Then
xAngle = xAngle + xSpeed
If Keys(vbKeyDown) Then
xAngle = xAngle - xSpeed
If Keys(vbKeySpace) Then
bRender = Not bRender
Call glRotatef(xAngle,
1, 0, 0)
Call glRotatef(yAngle,
0, 1, 0)
' Call glRotatef(yAngle,
0, 0, 1)
' Call glRotatef(xAngle,
0, 0, 1)
'Call glTranslatef(0#,
0#, -5000)
Call gluLookAt(212, 60,
194, 186, 55, 171, 0, 1, 0) 'This
Determines Where The Camera's Position And View Is
Call
glScalef(scaleValue, scaleValue * HEIGHT_RATIO, scaleValue)
Call
RenderHeightMap ' Render The Height Map
'Call triangles
DrawGLScene = True ' Everything
Went OK
End Function
Public Function CreateGLWindow(frm As Form, Width As Integer,
Height As Integer, Bits As Integer, fullscreenflag As Boolean) As Boolean
Dim PixelFormat As
GLuint ' Holds The
Results After Searching For A Match
Dim pfd As
PIXELFORMATDESCRIPTOR '
pfd Tells Windows How We Want Things To Be
fullscreen =
fullscreenflag ' Set The Global Fullscreen
Flag
If (fullscreen)
Then '
Attempt Fullscreen Mode?
SetDisplayMode
Width, Height, Bits, fullscreen
End If
If fullscreen Then
HidePointer ' Hide Mouse Pointer
frm.WindowState =
vbMaximized ' make the form
big
End If
pfd.cColorBits =
Bits ' color depth
pfd.cDepthBits = 16
pfd.dwflags =
PFD_DRAW_TO_WINDOW Or PFD_SUPPORT_OPENGL Or PFD_DOUBLEBUFFER
pfd.iLayerType =
PFD_MAIN_PLANE
pfd.iPixelType =
PFD_TYPE_RGBA
pfd.nSize = Len(pfd)
pfd.nVersion = 1
PixelFormat =
ChoosePixelFormat(frm.hDC, pfd)
If PixelFormat = 0
Then ' Did Windows
Find A Matching Pixel Format?
KillGLWindow ' Reset The
Display
MsgBox "Can't
Find A Suitable PixelFormat.", vbExclamation, "ERROR"
CreateGLWindow =
False ' Return FALSE
End If
If
SetPixelFormat(frm.hDC, PixelFormat, pfd) = 0 Then ' Are We Able To Set The
Pixel Format?
KillGLWindow ' Reset The
Display
MsgBox "Can't
Set The PixelFormat.", vbExclamation, "ERROR"
CreateGLWindow =
False ' Return
FALSE
End If
hrc =
wglCreateContext(frm.hDC)
If (hrc = 0) Then ' Are We Able To
Get A Rendering Context?
KillGLWindow ' Reset The
Display
MsgBox "Can't Create A GL Rendering
Context.", vbExclamation, "ERROR"
CreateGLWindow =
False ' Return FALSE
End If
If
wglMakeCurrent(frm.hDC, hrc) = 0 Then
' Try To Activate The Rendering Context
KillGLWindow ' Reset The
Display
MsgBox "Can't
Activate The GL Rendering Context.", vbExclamation, "ERROR"
CreateGLWindow =
False ' Return FALSE
End If
frm.Show ' Show The
Window
SetForegroundWindow
frm.hWnd ' Slightly
Higher Priority
frm.SetFocus ' Sets
Keyboard Focus To The Window
ReSizeGLScene
frm.ScaleWidth, frm.ScaleHeight ' Set Up Our Perspective GL Screen
If Not InitGL()
Then ' Initialize
Our Newly Created GL Window
KillGLWindow ' Reset The
Display
MsgBox
"Initialization Failed.", vbExclamation, "ERROR"
CreateGLWindow =
False ' Return FALSE
End If
CreateGLWindow =
True ' Success
End Function
Sub GLmain()
'Set up the values to
do with key bindings
Let scaleValue = 0.15
' Scale Value For The Terrain (NEW)
Let bRender = True
'wirefram or textured object
Dim Done As Boolean
Dim frm As Form
Done = False ' we're
not done yet
' Ask The User Which
Screen Mode They Prefer
fullscreen =
MsgBox("Would You Like To Run In Fullscreen Mode?", vbYesNo +
vbQuestion, "Start FullScreen?") = vbYes
' Create Our OpenGL
Window
Set frm = New
frmVisualise ' create our form
If Not
CreateGLWindow(frm, 800, 600, 16, fullscreen) Then
Done = True ' Quit If Window
Was Not Created
End If
Do While Not Done
' Draw The
Scene. Watch For ESC Key And Quit
Messages From DrawGLScene()
If (Not
DrawGLScene Or Keys(vbKeyEscape)) Then
' Updating View Only If Active
frm.Visible =
False
Call KillGLWindow
Unload
frm ' ESC or DrawGLScene
Signalled A Quit
frmImport.Show
Else ' Not Time
To Quit, Update Screen
SwapBuffers
(frm.hDC) ' Swap Buffers
(Double Buffering)
DoEvents
End If
If Keys(vbKeyF1)
Then ' Is F1 Being
Pressed?
Keys(vbKeyF1)
= False ' If So Make Key
FALSE
Unload
frm ' Kill Our Current Window
Set frm = New
frmVisualise ' create a
new one
fullscreen =
Not fullscreen ' Toggle
Fullscreen / Windowed Mode
' Recreate Our
OpenGL Window
If Not CreateGLWindow(frm, 640, 480, 16,
fullscreen) Then
Unload
frm ' Quit If
Window Was Not Created
End If
End If
Done = frm.Visible
= False ' if the form is
not visible then we are done
Loop
' Shutdown
Set frm = Nothing '
destroy our form
End Sub
Private Sub triangles()
Dim i As Integer
Dim X As Double
Dim Y As Double
Dim z As Double
Dim q As Integer
Dim points(1 To 2250, 1
To 3) As Double
'Global array dosnt
work so create a local one and insert values from local array
For i = 1 To
RecordCounter
Let points(i, 1) =
Northing(i)
Let points(i, 2) =
Easting(i)
Let points(i, 3) =
masl(i)
Next i
glBegin bmTriangles
Let X = 469400
Let Y = 7324955
Let z = 776
For i = 1 To
RecordCounter
glColor3f 1#, 0#,
0#
Call glVertex3f(X -
points(i, 1), Y - points(i, 2), z - points(i, 3))
Call glVertex3f(X -
points(i, 1) + 50, Y - points(i, 2), z - points(i, 3))
Call glVertex3f(X -
points(i, 1), Y - points(i, 2) + 50, z - points(i, 3))
'Using the global
array dosnt work, no idea why
' Call glVertex3f(x - Northing(i), y -
Easting(i), z - Masl(i))
' Call glVertex3f(x - Northing(i) + 50, y -
Easting(i), z - Masl(i))
' Call glVertex3f(x - Northing(i), y -
Easting(i) + 50, z - Masl(i))
Next i
glEnd
End Sub
Private Sub RenderHeightMap()
Dim XX As Integer 'Create Some Variables For Readability
Dim YY As Integer
Dim X As Integer
Dim Y As Integer
Dim z As Integer
Let XX = 0
Let YY = 0
glShadeModel
(smSmooth)
If bRender Then ' What We
Want To Render
glBegin
bmQuads '
Render Polygons
Else
glBegin
bmLines '
Render Lines Instead
End If
For XX = 0 To MAP_SIZE
Step STEP_SIZE
For YY = 0 To
MAP_SIZE Step STEP_SIZE
' Get The (XX,
YY, Z) Value For The Bottom Left Vertex
X = XX
Y = Height(XX,
YY)
z = YY
' Set The
Color Value Of The Current Vertex
Call
SetVertexColour(X, z)
Call
glVertex3i(X, Y, z) 'Send This Vertex To OpenGL To Be Rendered
(Integer Points Are Faster)
' Get The (XX,
YY, Z) Value For The Top Left Vertex
X = XX
Y = Height(XX,
YY + STEP_SIZE)
z = YY +
STEP_SIZE
' Set The
Color Value Of The Current Vertex
Call
SetVertexColour(X, z)
Call
glVertex3i(X, Y, z) ' Send This
Vertex To OpenGL To Be Rendered
' Get The (XX,
YY, Z) Value For The Top Right Vertex
X = XX + STEP_SIZE
Y = Height(XX
+ STEP_SIZE, YY + STEP_SIZE)
z = YY +
STEP_SIZE
' Set The
Color Value Of The Current Vertex
Call
SetVertexColour(X, z)
Call
glVertex3i(X, Y, z) ' Send This
Vertex To OpenGL To Be Rendered
' Get The (XX,
YY, Z) Value For The Bottom Right Vertex
X = XX +
STEP_SIZE
Y = Height(XX
+ STEP_SIZE, YY)
z = YY
' Set The
Color Value Of The Current Vertex
Call
SetVertexColour(X, z)
Call
glVertex3i(X, Y, z) 'Send This
Vertex To OpenGL To Be Rendered
Next YY
Next XX
glEnd
Call glColor4f(1#, 1#,
1#, 1#) ' Reset The
Color
End Sub
Private Function Height(XX As Integer, YY As Integer) As
Integer ' This Returns The
Height From A Height Map Index
Dim X As Integer
Dim Y As Integer
X = XX Mod
MAP_SIZE '
Error Check Our x Value
Y = YY Mod MAP_SIZE ' Error Check
Our y Value
Height = Terrain(X,
Y) ' Index Into Our Height
Array And Return The Height
End Function
Private Sub SetVertexColour(X As Integer, Y As Integer)
' Sets The Color Value
For A Particular Index, Depending On The Height Index
Dim rcolour As Single
Dim gcolour As Single
Dim bcolour As Single
Dim Correction As
Single
Let Correction = 0.15
Let rcolour =
(Correction + Height(X, Y) / 256#)
Let gcolour =
(Correction + Height(X, Y) / 256#)
Let bcolour =
(Correction + Height(X, Y) / 256#)
' Assign This Blue
Shade To The Current Vertex
Call glColor3f(rcolour,
gcolour, bcolour)
End Sub
Import Routines
Private Sub Form_Load()
dataImport = False
End Sub
Private Sub mnuAboutInfo_Click()
frmAbout.Show
End Sub
Private Sub mnuDatabaseConnect_Click()
Dim result As Integer
Let result = 0
If dataOpen = True Then
result =
MsgBox("Database Already Open Change Database?", vbOKCancel,
"Information")
If result = 1 Then
Call openData
End If
Else
Call openData
End If
End Sub
Private Sub openData()
cdgImport.filename =
""
cdgImport.Filter =
"Microsoft Access Databases
|*.mdb"
cdgImport.ShowOpen
Set conDB = New ADODB.Connection
Set adoRS = New
ADODB.Recordset
If
Len(cdgImport.filename) > 0 Then
'test if a file
selected before attepting to open
With conDB
.ConnectionString =
"Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data
Source = " & cdgImport.filename
.Mode =
adModeReadWrite
.Open
End With
dataOpen = True
End If
End Sub
Private Sub mnuDatabaseSurvey_Click()
If dataOpen = True Then
dlgSurvey.Show
Else: MsgBox "Please Connect to a datasource",
vbCritical, "Warning No Database Found"
End If
End Sub
Private Sub mnuDatabaseUpdate_Click()
If dataOpen = True Then
If dataImport = True
Then
dlgUpdate.Show
Else: MsgBox "No
data to add please import a survey", vbCritical, "Warning Nothing to
Do"
End If
Else: MsgBox
"Please Connect to a datasource", vbCritical, "Warning No
Database Found"
End If
End Sub
Private Sub mnuDisplay3d_Click()
dlgChoose.Show
End Sub
Private Sub mnuDisplayVisual_Click()
Call GLmain
End Sub
Private Sub mnuDisplayCompare_Click()
MsgBox "Not
Implemented", vbInformation, "Information"
End Sub
Private Sub mnuFileClose_Click()
Unload frmImport
If dataOpen = True Then
conDB.Close
End If
End
End Sub
Private Sub FileImport(NoRecords)
Dim i As Integer
Dim j As Integer
Dim X As Integer
Dim Y As Integer
'Dim neighbourA(1 To
2500) As Integer
'Dim neighboutB(1 To
2500) As Integer
Dim minA As Double
Dim minB As Double
Dim dist As Double
Let Y = 0
'redim the container
arrays for northing easting masl and sdate
'Note there will be
some empty records if errors occur
'ReDim sDate(1 To
NoRecords)
ReDim Easting(1 To
NoRecords)
ReDim Northing(1 To
NoRecords)
ReDim masl(1 To
NoRecords)
frmProgress.ProgressBar1.Min
= 0
frmProgress.ProgressBar1.Max = RecordCounter
frmProgress.ProgressBar1.Value = frmProgress.ProgressBar1.Min
frmProgress.ProgressBar1.Visible = True
frmProgress.Show
frmProgress.txtName.Text = "Importing Geocoordinates"
frmImport.Enabled =
False
For X = 1 To
RecordCounter
'this loop tests the
points values are valid and adds valid ones to an array
'test easting
northing and masl are numeric values
If
IsNumeric(ReadFile(X, 2)) Then
If IsNumeric(ReadFile(X,
3)) Then
If
IsNumeric(ReadFile(X, 4)) Then
Y = Y + 1
' the date is
not significant so I have removed its import
'If
IsDate(ReadFile(x, 1)) Then
' Let sDate(y) = CDate(tDate)
'Else
' Let sDate(y) = Date
'End If
Let
Northing(Y) = CSng(ReadFile(X, 3))
Let Easting(Y)
= CSng(ReadFile(X, 2))
Let masl(Y) =
CSng(ReadFile(X, 4))
End If
End If
End If
frmProgress.ProgressBar1.Value = X
Next X
frmProgress.ProgressBar1.Min = 1
frmProgress.ProgressBar1.Max = RecordCounter - 2
frmProgress.ProgressBar1.Value = frmProgress.ProgressBar1.Min
frmProgress.ProgressBar1.Visible = True
frmProgress.Show
'frmProgress.txtName.Text = "Calculating Triangles"
frmProgress.Refresh
Let RecordCounter = Y
'y records the actual
number of units held in the array
'For i = 1 To
RecordCounter - 2
'Assign a massive
value to the containers for the minimum values
' minA = 10000000
' minB = 10000000
' For j = i + 1 To
RecordCounter
' dist = Sqr((Easting(i) - Easting(j)) ^ 2 +
(Northing(i) - Northing(j)) ^ 2 + (masl(i) - masl(j)) ^ 2)
' If dist < minA Then
' Let minA = dist
' ElseIf dist < minB Then
' Let minB = dist
'
' End If
' Next j
'MsgBox minA &
" " & minB
'
frmProgress.ProgressBar1.Value = i
'Next i
If RecordCounter > 0
Then
dataImport = True
End If
frmProgress.Hide
frmImport.Enabled =
True
frmImport.Refresh
frmImport.SetFocus
End Sub
Private Sub OpenFile(fileopen, counter)
'Dim counter As Integer
Dim filename As String
Dim biffer As String
Dim i As Integer
'Reset filename
cdgImport.filename =
""
'display a common dialog
box to open a csv file
cdgImport.Filter =
"Comma seprated data | *.csv"
cdgImport.ShowOpen
filename =
cdgImport.filename
'Counter is equal to
zero so that it never exceeds the size of the array
If Len(filename) > 0
Then
'test if a file
selected before attepting to open
Let counter = 0
Let fileopen = True
Open filename For
Input As #1
'count records in a
file
Do While Not EOF(1)
Let counter =
counter + 1
Line Input #1,
Buffer
Loop
ReDim ReadFile(1 To
counter, 1 To 4)
'close and reopen
file until I find a better way to get back to the begining of it
Close #1
Open filename For Input
As #1
For i = 1 To counter
'Know how many
record in the file so read them all in
Input #1,
ReadFile(i, 1), ReadFile(i, 2), ReadFile(i, 3), ReadFile(i, 4)
Next i
Close #1
Let RecordCounter =
counter
End If
End Sub
Private Sub mnuFileOpen_Click()
Dim fileopen As Boolean
Dim NoRecord As Integer
Let fileopen = False
Let NoRecord = 0
Call OpenFile(fileopen,
NoRecords)
If fileopen = True Then
Call
FileImport(NoRecords)
End If
End Sub
Update Database
Private Sub Form_Load()
Set mod_name =
dlgUpdate
cboSurveys.Clear
Call
Read_Survey(mod_name)
End Sub
Private Sub OKButton_Click()
Call add_survey
End Sub
Private Sub add_survey()
'Procedure to add
imported records to the database
Dim dataCommand As
String ' used to build up the dataabase connection string
Dim i As Integer
dlgUpdate.Enabled =
False
frmProgress.ProgressBar1.Min = 1
frmProgress.ProgressBar1.Max = RecordCounter
frmProgress.ProgressBar1.Value = frmProgress.ProgressBar1.Min
frmProgress.txtName.Text
= "Updating Database"
frmProgress.Show
frmProgress.Refresh
For i = 1 To
RecordCounter
dataCommand =
"INSERT INTO POINTS (NORTHING, EASTING, MASL, STUDYID) VALUES (" _
& Str(Northing(i)) & ", "
& Str(Easting(i)) & ", " & Str(masl(i)) & ",
" & Str(Current_Survey) & ");"
conDB.Execute
(dataCommand)
frmProgress.ProgressBar1.Value = i
Next i
frmProgress.Hide
dlgUpdate.Enabled = True
dlgUpdate.Hide
frmImport.SetFocus
End Sub
,
,