If you can stand one more update, and the inevitable code bloat that comes
with feature creep, here is another version that also includes the ability
to write grid files:
'
*****************************************************************************
' Copyright (c) 2000, MAPINFO CORPORATION
' All rights reserved.
'
' $Workfile: GridInfo.mb $
' $Revision: 2.0 $
' $Author: DRESSEL $
' $Date: June 7 2000 16:14:56 $
'
' Module Description:
'
' MapBasic program to retrieve grid info and create new grid files.
'
' Revision History:
'
' Rev 1.0 May 22 2000 16:14:56 DRESSEL
' Rev 1.1 June 6 2000 13:30:00 DRESSEL
' Check for minimum version of MapInfo Professional (5.5)
' Add support for Northwood's NWGRD30.GHL grid handler
' Fix bug with button help message
' Fix typo refering to 'rotatesymbols'
' Rev 2.0 June 7 2000 13:30:00 DRESSEL
' Add ability to create grids
'
*****************************************************************************
Include "MapBasic.def"
Include "Menu.def"
Include "Icons.def"
'
********************************************************************************
'Define constants
'
********************************************************************************
Define AppVersion 2.0
Define ID_EDIT_TEXT_FILENAME 601
Define ID_EDIT_TEXT_ROWS 602
Define ID_EDIT_TEXT_COLS 603
Define ID_EDIT_TEXT_MIN 604
Define ID_EDIT_TEXT_MAX 605
Define _MAX_PATH 260 ' max. length of full pathname (from
stdlib.h)
Define GE_GRIDINFO_MAGIC_NUMBER 13124 '0x3344 (from gridtypes.h)
Define GE_GRIDINFO_INVALID 43690 '0xaaaa
Define GE_GRIDTYPE_CONTINUOUS 1
Define GE_GRIDTYPE_CLASSIFIED 2
Define GE_MAX_INFLECTIONS 255
Define GE_COLOR Integer 'convert to MapBasic
Define GE_HGRID Integer
'
********************************************************************************
'Define variable types (structures)
'
********************************************************************************
Type GE_COLORINFLECTIONS '(from gridtypes.h)
sNumInflections As SmallInt
alignmentfiller(3) As SmallInt 'meet 8-byte alignment for following
floats
adValue(GE_MAX_INFLECTIONS) As FLoat ' because
GE_GRIDTYPE_CONTINUOUS
aColor(GE_MAX_INFLECTIONS) As GE_COLOR
End Type
Type GE_GRID_INFO '(from gridtypes.h)
lMagic As Integer ' to check validity
lWidth As Integer ' number of columns in grid
lLength As Integer ' number of rows in grid
ptchCoordSys As String ' coordsys description
dMinXVal As Float ' min X coord
dMaxXVal As Float ' max X coord
dMinYVal As Float ' min Y coord
dMaxYVal As Float ' max Y coord
End Type
'
********************************************************************************
'Declare external functions (all in MIGrid.DLL)
'Note: All MapBasic funtion variables are passed by reference unless
' explicitly defined to be passed directly with the 'ByVal' key word.
'
********************************************************************************
Declare Function GE_GetDefaultWriteHandler Lib "Migrid.dll" (
ByVal sGridType As SmallInt,
ptchHandlerName As String) As Logical
Declare Function GE_CreateContinuousGrid Lib "Migrid.dll" (
ptchHandlerName As String,
ptchFilename As String,
pInflections As GE_COLORINFLECTIONS,
ByVal uchIsNullTransparent As SmallInt,
clrNull As GE_COLOR,
pGridInfo As GE_GRID_INFO,
ByVal dMinVal As Float,
ByVal dMaxVal As FLoat,
phGrid As GE_HGRID) As Logical
Declare Function GE_WriteContinuousValue Lib "Migrid.dll" (
ByVal hGrid As GE_HGRID,
ByVal lCol As Integer,
ByVal lRow As Integer,
ByVal dValue As Float) As Logical
Declare Function GE_CloseContinuousGrid Lib "Migrid.dll" (
phGrid As GE_HGRID) As Logical
Declare Function GE_OpenGrid Lib "Migrid.dll" (
lpszFilename As String,
ByVal lCacheSize As Integer,
hGrid As Integer) As Logical
Declare Function GE_GetCoordSysInfo Lib "Migrid.dll" (
ByVal hGrid As Integer,
ptchCoordSys As String,
pdMinXVal As Float,
pdMinYVal As Float,
pdMaxXVal As Float,
pdMaxYVal As Float) As Logical
Declare Function GE_GetContinuousMinMax Lib "Migrid.dll" (
ByVal hGrid As Integer,
pdMinZVal As Float,
pdMaxZVal As Float) As Logical
Declare Function GE_GetDimensions Lib "Migrid.dll" (
ByVal hGrid As Integer,
plWidth As Integer,
plHeight As Integer) As Logical
Declare Function GE_StartRead Lib "Migrid.dll" (
ByVal hGrid As Integer) As Logical
Declare Function GE_GetContinuousValue Lib "Migrid.dll" (
ByVal hGrid As Integer,
ByVal lCol As Integer,
ByVal lRow As Integer,
pdValue As Float,
puchIsNull As SmallInt) As Logical
Declare Function GE_EndRead Lib "Migrid.dll" (
ByVal hGrid As Integer) As Logical
Declare Function GE_CloseGrid Lib "Migrid.dll" (
hGrid As Integer) As Logical
'
********************************************************************************
'Declare Local Functions
'
********************************************************************************
Declare Sub Main
Declare Sub GridInfoToolHandler
Declare Sub CreateGrid
Declare Function CreateGridDialog() As Logical
Declare Sub BrowseButtonHandler
Declare Sub OKButtonHandler
Declare Sub About
Declare Sub GoodBye
'
********************************************************************************
'Global Variables
'
********************************************************************************
Global gsPath, szGridFilename As String
Global lOpenAndMap, lRunSilent As Logical
Global iRows, iCols As Integer
Global fMin, fMax As Float
'
********************************************************************************
'
********************************************************************************
'Sub Main
'
********************************************************************************
'
********************************************************************************
Sub Main
OnError Goto HandleError
If SystemInfo(SYS_INFO_MIVERSION) < 550 Then
Note "This utility depends on the Grid Engine API of " +
"MapInfo Professional version 5.5 or higher to run."
Exit Sub
End If
Create Menu "&Grid Info" As
"&Create Grid..." Calling CreateGrid,
"&About Grid Info..." Calling About,
"E&xit Grid Info" Calling Goodbye
Alter Menu "Tools" Add "&Grid Info" As "&Grid Info"
Alter ButtonPad "Tools"
Add
Separator
ToolButton
Calling GridInfoToolHandler
Icon MI_ICON_INFO
Cursor MI_CURSOR_CROSSHAIR
DrawMode DM_CUSTOM_POINT
HelpMsg "Retrieve value from grid cell.\nRetrieve grid value"
Show
lOpenAndMap = TRUE
lRunSilent = FALSE
iRows = 10
iCols = 10
fMax = 10.0
fMin = 0.0
Exit Sub
HandleError:
Note "Main: " + Error$()
Resume Next
End Sub
'
********************************************************************************
'
********************************************************************************
' Sub GridInfoToolHandler
'
********************************************************************************
'
********************************************************************************
Sub GridInfoToolHandler
OnError Goto HandleError
Dim sCmd As String
Dim i As SmallInt
Dim lVerbose As Logical
Dim x, y As Float
Dim MapWindowID As Integer
Dim lReturn As Logical
Dim hGrid As Integer
Dim sPath As String
Dim ptchCoordSys As String
Dim pdMinXVal, pdMinYVal, pdMaxXVal, pdMaxYVal As Float
Dim pdMinZVal, pdMaxZVal As Float
Dim plWidth, plHeight As Integer
Dim lCol, lRow As Integer
Dim pdValue As Float
Dim puchIsNull As SmallInt
'
********************************************************************************
'Get map window and layer
'
********************************************************************************
MapWindowID = FrontWindow()
If WindowInfo( MapWindowID, WIN_INFO_TYPE) <> WIN_MAPPER Then
Note "Click in a map window."
Exit Sub
End If
For i = 1 To MapperInfo(MapWindowID, MAPPER_INFO_LAYERS)
If LayerInfo(MapWindowID, i, LAYER_INFO_TYPE) =
LAYER_INFO_TYPE_GRID Then
sPath = LayerInfo(MapWindowID, i, LAYER_INFO_PATH)
Exit For
End If
Next
'
********************************************************************************
'Get Grid file name
'
********************************************************************************
sPath = Left$(sPath, Len(sPath)-3) + "MIG"
If Not FileExists(sPath) Then
If FileExists(ProgramDirectory$() + "Nwgrd30.ghl") Then
sPath = Left$(sPath, Len(sPath)-3) + "GRD"
End If
End If
If Not FileExists(sPath) Then
Note "Cannot find grid file " + sPath
Exit Sub
End If
If sPath <> gsPath Then
gsPath = sPath
lVerbose = TRUE
Else
lVerbose = FALSE
End If
'
********************************************************************************
'set MapBasic coordinate system to match map window coordinate system
'
********************************************************************************
sCmd = "Set " + MapperInfo(MapWindowID,
MAPPER_INFO_COORDSYS_CLAUSE_WITH_BOUNDS)
Run Command sCmd
'
********************************************************************************
'Get coordinates of cursor location
'
********************************************************************************
x = CommandInfo(CMD_INFO_X)
y = CommandInfo(CMD_INFO_Y)
Print "X = " + x + ", Y = " + y
'
********************************************************************************
'Open grid file
'
********************************************************************************
lReturn = GE_OpenGrid(sPath, 1024, hGrid)
If Not lReturn Then
Note "Open " + sPath + " failed"
Exit Sub
End If
If hGrid = 0 Then
Note "Open " + sPath + " failed: grid handle = 0"
Exit Sub
End If
If lVerbose Then
Print " Opened " + sPath + " with handle " + hGrid
End If
'
********************************************************************************
'Get grid coordinate system information (especially min and max
coordinates)
'
********************************************************************************
ptchCoordSys = Space$(255) 'Initialize to allocate actually memory.
lReturn = GE_GetCoordSysInfo(hGrid, ptchCoordSys, pdMinXVal,
pdMinYVal, pdMaxXVal, pdMaxYVal)
If lVerbose Then
Print " " + ptchCoordSys
Print " MinXVal = " + pdMinXVal + ", MinYVal = " + pdMinYVal +
", MaxXVal = " + pdMaxXVal + ", MaxYVal = " + pdMaxYVal
End If
'
********************************************************************************
'Get minimum and maximum grid values
'
********************************************************************************
lReturn = GE_GetContinuousMinMax(hGrid, pdMinZVal, pdMaxZVal)
If lVerbose Then
Print " MinZVal = " + pdMinZVal + ", MaxZVal = " + pdMaxZVal
End If
'
********************************************************************************
'Get grid dimensions (rows and columns)
'
********************************************************************************
lReturn = GE_GetDimensions(hGrid, plWidth, plHeight)
If lVerbose Then
Print " Width = " + plWidth + ", Height = " + plHeight
End If
'
********************************************************************************
'Prepare to read grid
'
********************************************************************************
lReturn = GE_StartRead(hGrid)
If lReturn Then
'
********************************************************************************
'Calculate row and column of cursor location
'
********************************************************************************
lCol = (plWidth * (x - pdMinXVal) / (pdMaxXVal - pdMinXVal)) - .5
lRow = (plHeight -
plHeight * (y - pdMinYVal) / (pdMaxYVal - pdMinYVal)) - .5
'
********************************************************************************
'Retrieve and display grid value
'
********************************************************************************
lReturn = GE_GetContinuousValue(hGrid, lCol, lRow, pdValue, puchIsNull)
If lCol < 0 Or lRow < 0 Or lCol >= plWidth Or lRow >= plHeight Then
If pdValue = 0 Then
Print " Value at col: " + (lCol+1) +
", row: " + (lRow+1) + " is undefined."
Else
Print " Value at col: " + (lCol+1) +
", row: " + (lRow+1) + " = " + pdValue +
", but should be undefined."
End If
Else
If puchIsNull Then
Print " Value at col: " + (lCol+1) +
", row: " + (lRow+1) + " is NULL."
Else
Print " Value at col: " + (lCol+1) +
", row: " + (lRow+1) + " = " + pdValue
End If
End If
lReturn = GE_EndRead(hGrid)
Else
Print " StartRead(" + hGrid + ") failed"
End If
lReturn = GE_CloseGrid(hGrid)
Exit Sub
HandleError:
Note "GridInfoToolHandler: " + Error$()
Resume Next
End Sub
'
********************************************************************************
'
********************************************************************************
'Sub CreateGrid
'
********************************************************************************
'
********************************************************************************
Sub CreateGrid
OnError Goto HandleError
Dim lReturn As Logical
Dim atchHandlerName As String
Dim hGrid As GE_HGRID
Dim Inflections As GE_COLORINFLECTIONS
Dim GridInfo As GE_GRID_INFO
Dim clrNull As GE_COLOR
Dim uchIsNullTransparent As SmallInt
Dim r, c, i As Integer
Dim dValue As Float
'
********************************************************************************
'Get default grid handler
'
********************************************************************************
atchHandlerName = Space$(_MAX_PATH)
lReturn = GE_GetDefaultWriteHandler(GE_GRIDTYPE_CONTINUOUS,
atchHandlerName)
print "GetDafulatWriteHandler returned with " + atchHandlerName
If Not CreateGridDialog() Then
Exit Sub
End If
'
********************************************************************************
' setup the information need for the GE_CreateContinuousGrid() call
' this is a simple color inflection ramping from blue to red
'
********************************************************************************
Inflections.sNumInflections = 2
Inflections.adValue(1) = fMin
Inflections.aColor(1) = RGB(0,0,255)
Inflections.adValue(2) = fMax
Inflections.aColor(2) = RGB(255,0,0)
'
********************************************************************************
' setup the grid info
'
********************************************************************************
GridInfo.lMagic = GE_GRIDINFO_MAGIC_NUMBER
GridInfo.lWidth = iRows
GridInfo.lLength = iCols
GridInfo.ptchCoordSys = "CoordSys Earth Projection 1, 62"
GridInfo.dMinXVal = 1
GridInfo.dMaxXVal = 2
GridInfo.dMinYVal = 1
GridInfo.dMaxYVal = 2
'
********************************************************************************
' setup the null cell color/transparency
'
********************************************************************************
clrNull = RGB(0,0,0)
uchIsNullTransparent = 1 ' 0=opaque, 1=transparent
'
********************************************************************************
' create the grid file
'
********************************************************************************
lReturn = GE_CreateContinuousGrid(atchHandlerName, szGridFilename,
Inflections, uchIsNullTransparent,
clrNull, GridInfo,
Inflections.adValue(1),
Inflections.adValue(2), hGrid)
print " Created Continuous Grid " + szGridFilename
'
********************************************************************************
' write the grid cells
'
********************************************************************************
For r=0 To GridInfo.lLength-1
For c=0 To GridInfo.lWidth-1
dValue = Inflections.adValue(1) +
(Inflections.adValue(2)-Inflections.adValue(1)) *
((r*GridInfo.lWidth+c) / (GridInfo.lLength *
GridInfo.lWidth))
If Not lRunSilent Then
Print " Row:"+r+" Col:"+c+" Val="+dValue
End If
lReturn = GE_WriteContinuousValue(hGrid, c, r, dValue)
Next
Next
'
********************************************************************************
' close grid file
'
********************************************************************************
lReturn = GE_CloseContinuousGrid(hGrid)
print "Continuous Grid Closed"
'
********************************************************************************
' open grid as table
'
********************************************************************************
If lOpenAndMap Then
Register Table TrueFileName$(szGridFileName) Type "GRID"
Open Table Left$(szGridFileName, Len(szGridFileName)-4)
Map From TableInfo(0, TAB_INFO_NAME)
End If
Exit Sub
HandleError:
Note "CreateGrid: " + Error$()
Resume Next
End Sub
'
********************************************************************************
'
********************************************************************************
'Function CreateGridDialog
'
********************************************************************************
'
********************************************************************************
Function CreateGridDialog() As Logical
OnError Goto HandleError
Dim sRows, sCols, sMin, sMax As String
sRows = Str$(iRows)
sCols = Str$(iCols)
sMin = Str$(fMin)
sMax = Str$(fMax)
Dialog
Title "Create a new grid file"
Control StaticText
Title "Grid File Name:"
Position 10, 12
Control EditText
Value szGridFilename
Into szGridFilename
ID ID_EDIT_TEXT_FILENAME
Position 60, 10
Width 200
Control Button
Title "&Browse..."
Calling BrowseButtonHandler
Position 270, 10
Control StaticText
Title "Rows:"
Position 10, 32
Control EditText
Value sRows
Into sRows
ID ID_EDIT_TEXT_ROWS
Position 40, 30
Control StaticText
Title "Columns:"
Position 10, 47
Control EditText
Value sCols
Into sCols
ID ID_EDIT_TEXT_COLS
Position 40, 45
Control StaticText
Title "Minimum value:"
Position 143, 32
Control EditText
Value sMin
Into sMin
ID ID_EDIT_TEXT_MIN
Position 195, 30
Control StaticText
Title "Maximum value:"
Position 143, 47
Control EditText
Value sMax
Into sMax
ID ID_EDIT_TEXT_MAX
Position 195, 45
Control CheckBox
Title "Open and &map new grid"
Value lOpenAndMap
Into lOpenAndMap
Position 10, 65
Control CheckBox
Title "Run &silent"
Value lRunSilent
Into lRunSilent
Position 150, 65
Control OKButton
Title "&OK"
Position 100, 90
Calling OKButtonHandler
Control CancelButton
Title "&Cancel"
Position 150, 90
If CommandInfo(CMD_INFO_DLG_OK) Then
iRows = Val(sRows)
iCols = Val(sCols)
fMin = Val(sMin)
fMax = Val(sMax)
CreateGridDialog = TRUE
Else
CreateGridDialog = FALSE
End If
Exit Function
HandleError:
Note "CreateGridDialog: " + Error$()
Resume Next
End Function
'
********************************************************************************
'
********************************************************************************
' Sub BrowseButtonHandler
'
********************************************************************************
'
********************************************************************************
Sub BrowseButtonHandler
OnError Goto HandleError
szGridFilename = FileSaveAsDlg(PathToDirectory$(TempFileName$("")),
"", "MIG", "Specify grid file name")
If szGridFileName <> "" Then
Alter Control ID_EDIT_TEXT
Value szGridFileName
End If
Exit Sub
HandleError:
Note "BrowseButtonHandler: " + Error$()
Resume Next
End Sub
'
********************************************************************************
'
********************************************************************************
' Sub OKButtonHandler
'
********************************************************************************
'
********************************************************************************
Sub OKButtonHandler
OnError Goto HandleError
Dim sRows, sCols As String
Dim i As Integer
szGridFilename = ReadControlValue(ID_EDIT_TEXT_FILENAME)
If szGridFilename <> "" Then
If Right$(UCase$(szGridFilename),4) <> ".MIG" Then
i = InStr(1, szGridFilename, ".")
If i > 0 Then
szGridFilename = Left$(szGridFilename, i-1)
End If
szGridFilename = szGridFilename + ".MIG"
OnError GoTo HandleFileError
Open File szGridFilename For Output As #1
Close File #1
OnError Goto HandleError
Alter Control ID_EDIT_TEXT_FILENAME Value szGridFilename
End If
Else
Note "Invalid blank grid file name"
Dialog Preserve
End If
sRows = ReadControlValue(ID_EDIT_TEXT_ROWS)
sCols = ReadControlValue(ID_EDIT_TEXT_COLS)
iRows = Val(sRows)
iCols = Val(sCols)
If iRows < 1 Or iCols < 1 Then
Note "Rows and Columns need to be greater than 0"
Dialog Preserve
End If
Exit Sub
HandleFileError:
Note "Invalid file name or path: " + szGridFileName
Dialog Preserve
Exit Sub
HandleError:
Note "OKButtonHandler: " + Error$()
Resume Next
End Sub
'
********************************************************************************
'
********************************************************************************
' Sub About
'
********************************************************************************
'
********************************************************************************
Sub About
OnError Goto HandleError
Dialog
Title "About Grid Info (Version " + Str$(AppVersion) + ")"
Width 170
Control StaticText
Title "To open grid and retrieve value at mouse click,"
Position 10, 10
Control StaticText
Title "select 'i' tool from 'Tools' button pad and"
Position 10, 18
Control StaticText
Title "click on grid in a map window."
Position 10, 26
Control StaticText
Title "To create new grid, select 'Create Grid...' menu"
Position 10, 42
Control StaticText
Title "option from 'Grid Info' menu."
Position 10, 50
Control OKButton
Title "&OK"
Position 70, 75
Exit Sub
HandleError:
Note "About: " + Error$()
Resume Next
End Sub
'
********************************************************************************
'
********************************************************************************
' Sub GoodBye
'
********************************************************************************
'
********************************************************************************
Sub GoodBye
OnError Goto HandleError
End Program
Exit Sub
HandleError:
Note "GoodBye: " + Error$()
Resume Next
End Sub
' End of File
----------------------------------------------------------------------
To unsubscribe from this list, send e-mail to [EMAIL PROTECTED] and put
"unsubscribe MAPINFO-L" in the message body, or contact [EMAIL PROTECTED]
