9_Appendix.pdf by f191620090bce297

VIEWS: 7 PAGES: 82

									Appendix A                                                                                                                                                                                                                                                                                                               “lowest”
                                                                                                                                                                                            Hourly                                                                                           Lower areas
                                                                                                                                                                                                                               Hourly                                                         (elevation                   map
Summary of Analysis Flowchart                                                                                          Location
                                                                                                                     information for
                                                                                                                                                                                           humidity
                                                                                                                                                                                             maps
                                                                                                                                                                                                            Comfort
                                                                                                                                                                                                              zone            comfort                                                         <=255ft.)
                                                                                                                    weather stations                                                                        criteria         zone maps
                                                                                                                                                                                         Hourly
                                                                                                                                                                                       temp. maps
                                                                                                                                                                                                                                                                                             Higher areas                 “peak”
                                                                                                                     Observations      Convert                             Interpolate                                                                                                        (elevation                   map
                                   Overlay         Summer                                                                                                 Hourly                                                       >20%                                                                   >=451ft.)
                                    maps
                                                                                                                      from each        files into                           point data
                                                   daytime                                                                                               data sets                                                     of time
                                  (summer)         CZ map                                                              weather           hourly                           sets into grid
                                                                                                                        station        data sets          (text)                                        Hourly
                                                                                                                                                                             data sets                                           “w_windy”
                                                                                                                                                                                                >=5     windy          <=5         map
                                  Overlay          Winter                                                                                                                                                                                                                                    Shadow
                                                                                                                                                                                                         maps                     (winter)
               Daytime             maps            daytime
                                                                                                                                                                                                                                                                                              areas            “hsd_se”
               CZ maps            (winter)         CZ map                                                                                                                         Hourly                                                                                                                                            >97
                                                                                                                                                                                 wind speed                            >20%                                                                 (hillshade           map
                                                                                                                                                                                   maps                                of time                                                              110 /23 )
                                                   Annual
                                  Overlay          daytime         Overlay          Winter                                                                                                              Hourly                   “windy”
               yes                 maps            CZ map           maps            CZ map                                                                                                      >=8     windy                      map
  Hourly                                                                                                                                                                                                 maps                     (other)
                                                                                                                                                                                                                                                                                             Shadow
  comfort                                                                                                                                                                                                                                                                                                                                                Overlay
                7am –                           Overlay       Annual                                                                                                                                                                                                     Elevation            areas            “hsd_s”                     “shadow”                    “fs_topo”
 zone (CZ)                                                                                                                                                                                                                                                                                                                         >164                   maps
   maps         7 pm                             maps         CZ map                     Overlay        Summer                                                                                                                                                           Grid map           (hillshade           map                          map                         map
                                                                                                                                                                                                 Hourly
                                                                                          maps          CZ map                                                                                                                   “wind_nw”                                                  180 /50 )
                                                                                                                                                                                                  wind           >20%
                                                                                                                                                                                NW wind                                             map
                                                                                                                                                                                                direction        of time
                                  Overlay          Annual                                                                                                                        map
                                                                                                                                                                                                  maps
                no                 maps           nighttime                                                                                                                                     (winter)
                                                   CZ map                                                                                                                                                                                                                                    Shadow
                                                                                                                                                                                                                                               “ce_climate”                                   areas            “hsd_sw”
                                  Overlay          Winter                                                                                                                                                                                        flowchart                                  (hillshade           map                >97
                                                                                                                                          “wind_nw”
              Nighttime            maps           nighttime                                                                                                                                                                                                                                 250 /23 )
              CZ maps             (winter)         CZ map
                                                                                                                                             map                                                                                               (Figure 4-5)
                                                                                                                                          “w_windy”
                                   Overlay        Summer
                                    maps          nighttime                                                                                  map                                                                                                “fs_climate”                                   “slope”                                    “slope10”
                                                                                                                                                                                                                                                                                                                    <= 10%
                                  (summer)         CZ map                                                                                                                                                                                                                                       map                                          map
                                                                                                                                            “peak”
                                                                                                                                                                                                                                                 flowchart
                                                                                                                                             map                                    Overlay                                                    (Figure 4-6)
                                                                                                                                                                                                        “fs_climate”
                                                                                                                                                                                     maps
                                                                                                                                                                                                            map
                                                                                                                                                                                                                                                                                              “aspect”              East to               “asp_esw”
                                                                                                                    Aspect           Northwest          “asp_nw”                                                                                 “ce_topo”                                      map                southwest                 map
                                                                                                                     map                                  map                                                                                    flowchart
                        “slope”                                 “slope16”
                                                                                                                                                                                                                                               (Figure 4-10)
                                             <= 16%
                         map                                       map                                                                     “windy”
                                                                                                                                             map
  Elevation                                                                                                                                                                                                                                      “fs_topo”
                                                                               Overlay             “ce_topo”
  Grid map                                                                      maps                                                                                                                                                             flowchart
                                                                                                      map
                                                                                                                                                                                                                                               (Figure 4-11)
                       “aspect”              Northeast         “asp_nenw”
                         map                     to                map                                                                                                                                “fs_result”                    Overlay                   Overlay               “ce_result”
                                             northwest                                                                                                                                                   map                                                                            map
                                                                                                                                                                                                                                      maps                      maps
                                                                                                                                                                                                                                                “ce_hydro”
                                                                                                                                                                                                                                                 flowchart
                                                                                                                                                                                                                                               (Figure 4-8)
                                                                                                                                                      Wetland
                                                                                                                                                       map                                                                                      “fs_hydro”
                     Wetland                                                                                                                                                                                                                     flowchart                                            Avoid                 “soil”
                      map                                                                                                                            Floodplain                                                                                                                                      problem
                                                                                                                                                                                                                                               (Figure 4-9)                                          class A                map
                                                 Overlay               “ce_hydro”                                                                       map
                                                  maps                                                                                                                                                                                                                                                 soil
                                                                          map
                  Floodplain                                                                                   River map             Buffer                                                                                                                                  Soil                                                          Overlay               “fc_soil”
                                                                                                                                                               “river”
                     map                                                                                                            (300ft. –                                        Overlay            “fs_hydro”                                                           map                                                            maps                   map
                                                                                                                                    1500ft)
                                                                                                                                                                map                                                                              “fc_soil”
                                                                                                                                                                                      maps                 map                                                                                      Erosion
                                                                                                                                                                                                                                                 flowchart                                         class <=2               “erosion”
                                                                                                                                                                                                                                               (Figure 4-7)                                        and slope                  map
                                                                                                                                                                                                                                                                                                     <7%
                                                                                                               “slope”                                         “slope4”
                                                                                                                map                  >=4%                        map
                                                                                                                                                                                                                                                 “fc_veg”
        process                    decision                    data                    result                                                                                                                                                    flowchart
                                                                                                                                                    “lowest”                                                                                   (Figure 4-12)
                                                                                                                                                      map                                                                                                                                   Tree
                                                                                                                                                                                                                                                                                          coverage                       Evergreen                    “fc_veg”
                                                                                                                                                                                                                                                                                            map                            trees                        map




                                                                             180
Appendix B
List of Chinese Characters and English Translations


chi (qi)                                 氣
Dili Tianji Huiyuan                      地理天機會元
eight trigram (bagua)                    八卦
feng shui                                風水
five element                             五行
Luban Jing                              魯班經
Ming                                     明
qigong                                   氣功
Western Zhou                             西周
yang                                     陽
yin                                      陰
Zang Jing                                葬經
Zhai-nei-xing                            宅內形
Zhai-wai-xing                            宅外形




                                         181
Appendix C
Code for Generating Hourly Climatic Information in Microsoft Access


Option Compare Database

Private Sub Main()
  Dim db As Database
  Dim rs As DAO.Recordset
  Dim rs2 As DAO.Recordset
  Dim result As DAO.Recordset
  Dim sid As String
  Dim Day As Integer
  Dim Hour As Integer

  Dim FSys As Object
  Dim FileName As String
  Dim OutStream As TextStream


  Set db = CurrentDb()
  Set rs = db.OpenRecordset("Select * from aList", dbOpenDynaset)
  Set result = db.OpenRecordset("wwResult")
  Set FSys = CreateObject("Scripting.FileSystemObject")

  ' file will contain data for a month, change the folder and file names for other months
  For Day = 1 To 31                                               ' 30 or 31 days
      For Hour = 0 To 23                                          ' generate hourly data
         FileName = "c:\climate\03Jan\" & "1_" & Day & "_" & Hour & ".txt"
         Set OutStream = FSys.CreateTextFile(FileName, True, False)
         OutStream.WriteLine "sID, rDate, rTime, rTemp, rDPoint, rRH, rWdir, rWspd, rRain"


      Do While Not rs.EOF
        sid = rs.Fields("sid")
        If Hour = 0 Then
        Set rs2 = db.OpenRecordset _
           ("SELECT sID, CDate, CTime, Temp, DewPoint, RH, WDir, Wspeed, Rain " & _
           "FROM " & sid & "_103 " & _
           "WHERE CDate=#1/" & Day & "/2003# And CTime=#" & Hour & ":00#", dbOpenDynaset)

         Else
         Set rs2 = db.OpenRecordset _
         ("SELECT sID, CDate, CTime, Temp, DewPoint, RH, WDir, Wspeed, Rain " & _
         "FROM " & sid & "_103 " & _
         "WHERE CDate=#1/" & Day & "/2003# And CTime>#" & Hour - 1 & ":59# And Ctime<#" & _
         Hour & ":01#", dbOpenDynaset)
         End If


         If (rs2.AbsolutePosition <> -1) Then
            OutStream.WriteLine rs2("sid") & ", " & rs2("CDate") & ", " & _
            rs2("CTime") & ", " & rs2("Temp") & ", " & rs2("DewPoint") _
            & ", " & rs2("RH") & ", " & rs2("WDir") & ", " & rs2("Wspeed") & ", " & rs2("Rain")


                                                   182
          End If

          rs2.Close
          rs.MoveNext

       Loop

       rs.MoveFirst

      Set OutStream = Nothing
    Next Hour
  Next Day


  rs.Close
  db.Close

End Sub




                                183
Appendix D
Scripts for Generating Weather Station Point Map in ArcView GIS

''''''''''''''''''
' active View first
' copyTheme
' Create the SourceName...
theSrc = SrcName.Make("c:\jxu\stationlist.shp")

' Use the SourceName to make a theme...
aTheme = Theme.Make(theSrc)

' Add the theme to the view...
theView = av.GetActiveDoc
theView.AddTheme(aTheme)

' Set a new name for the theme...
theProject = av.GetProject
theDoc = theProject.GetSelectedDocs.Get(0)
theName = theDoc.GetName
aTheme.SetName(theName)

' Draw the theme...
aTheme.SetVisible(true)

' Make new theme active
aTheme.SetActive(true)

' open theme table
theView = av.GetActiveDoc
for each t in theView.GetActiveThemes
  if (t.HasTable) then
    t.EditTable
  end
end

' change table name to the final shape file name
theTable = av.GetActiveDoc
theTable.SetName (theName) ' actual stationlist

' rename theme table
theProject = av.GetProject
theDoc = theProject.GetSelectedDocs.Get(0)

'name = MsgBox.Input("New Name:", "Rename", theDoc.GetName)

name = "stationList" ' actual hourly data
if (nil <> name) then
  theDoc.SetName(name)
  theProject.SetSelectedDoc(theDoc,FALSE)
end


''''''''''''''''''

                                                   184
' loadTxt
' add txt file to table
patterns = {"*.txt"}
labels = {"Delimited Text (*.txt)"}
files = FileDialog.ReturnFiles(patterns, labels, "Add Table", 0)
for each f in files
  v = VTab.Make(f, FALSE, FALSE)
  if (v.HasError) then
    if (v.HasLockError) then
      MsgBox.Error("Unable to acquire Read Lock for file " + f.GetBaseName, "")
    else
      MsgBox.Error("The file '" + f.GetBaseName + "' is not valid.", "")
    end
  else
    gui = av.GetProject.GetSelectedGUI
    if (gui.GetType <> "Table") then
      GUIName = "Table"
    else
      GUIName = gui.GetName
    end
    t = Table.MakeWithGUI(v, GUIName)
    t.SetName(v.GetName)
    t.GetWin.Open
  end
end

''''''''''''''''''
' Set a new name for the theme...
theProject = av.GetProject
theDoc = theProject.GetSelectedDocs.Get(0)
theName = theDoc.GetName
aTheme.SetName(theName)

''''''''''''''''''
' joinTable
' Find the table and join field for the first table....
tab1 = av.GetProject.FindDoc("stationList")
vtab1 = tab1.GetVTab
field1 = vtab1.FindField("Sid")

' Find the table and join field for the second table...
tab2 = av.GetProject.FindDoc(theName)
vtab2 = tab2.GetVtab
field2 = vtab2.FindField("Sid")

' Now perform the join....
vtab1.Join( field1, vtab2, field2)

' sort
' theTable = av.GetActiveDoc
aField = vtab1.FindField("Rdate")
theTable.SetActiveField(aField)
theTable.Sort(theTable.GetActiveField, False)

''''''''''''''''''
' active Table first

                                                          185
' save edits
theTable = av.GetActiveDoc
theVTab = theTable.GetVTab
if (theVTab.IsBeingEditedWithRecovery.Not) then
  return nil
end

'first see if this is actually a Save on an edit theme
theTheme = theTable.GetEditor

if (theTheme <> nil) then
   if (theTheme.Is(FTHEME)) then

  theView = theTheme.getView

   if (theView <> nil) then

    doSave = MsgBox.YesNoCancel("Save edits to "+theTheme.GetName+
                       "?","Save Edits",true)
    if (doSave = nil) then
     return nil
    end

    if (doSave.Not) then
      ' user changed her mind
      return (nil)
    end

    if (theTheme.StopEditing(TRUE).Not) then
      ' unable to save edits to theme
      MsgBox.Info("Unable to Save Edits, please use the Save Edits As option", "")
      ' remain in the editing state
      return nil
    end

     'begin editing again
     theView.SetEditableTheme(theTheme)
     return nil
   end
  end
end

'this is a save on the table
doSave = MsgBox.YesNoCancel("Save Edits to "
  +theTable.GetName+"?", "Save Edits", True)

if (doSave = nil) then
   return nil
end

if (doSave.Not) then
' user changed her mind
   return nil
end
if (theVTab.StopEditingWithRecovery(TRUE).Not) then
  MsgBox.Info("Unable to Save Edits, please use the Save Edits As option", "")

                                                         186
 ' remain in the editing state
 return nil
end

''''''''''''''''''
' active view first
' convertTheme
'View.Export
theView = av.GetActiveDoc
for each t in theView.GetActiveThemes
   p = FALSE

 if (t.Is( FTHEME ).Not) then
   if (t.CanExportToFtab.Not) then continue end

  def = av.GetProject.MakeFileName("theme", "shp")
  def = FileDialog.Put(def, "*.shp", "Convert " + t.getName)
  if (def = NIL) then return NIL end
  anFTab = t.ExportToFtab(def)

  ' For Database themes, which can return a nil FTab sometimes
  if (anFTab=nil) then
    MsgBox.Warning("Error occurred while converting to shapefile."+NL+
       "Shapefile was not created.", "Convert " + t.getName)
    continue
  end

  shpfld = anFTab.FindField("Shape")

 else

  tbl = t.GetFTab
  attribVis = FALSE
  for each f in tbl.GetFields
    if ((f.IsVisible) and not (f.IsTypeShape)) then
      attribVis = TRUE
      break
    end
  end
  shapeVis = tbl.FindField("Shape").IsVisible
  if ((attribVis and shapeVis).Not) then
    continue
  end

  def = av.GetProject.MakeFileName(t.getName, "shp")
  def = FileDialog.Put(def, "*.shp", "Convert " + t.getName)

  if (def = NIL) then return nil end

  shpfld = (tbl.FindField("Shape"))
  if (shpfld.IsVisible.Not) then
    shpfld.SetVisible(shpfld.IsVisible.Not)
    WasNotVisible = TRUE
  else
    WasNotVisible = FALSE
  end

                                                      187
  ' see if the view is projected
  thePrj = theView.GetProjection
  if (thePrj.IsNull.Not) then
    p = MsgBox.YesNoCancel("ArcView has detected that your view is projected."++
      "Do you want the new shapefile to be saved in the projected units?",
      "Convert", FALSE)
    if (p = Nil) then return nil end
  end

  ' if the user wants to project the shape, use ExportProjected
  if (p) then
    anFTab = tbl.ExportProjected(def, thePrj, tbl.GetSelection.Count > 0)
  else
    anFTab = tbl.Export(def, Shape, tbl.GetSelection.Count > 0)
  end

  if (anFTab.HasError) then
    if (anFTab.HasLockError) then
      MsgBox.Error("Unable to acquire Write Lock for file " +
       def.GetBaseName,"")
    else
      MsgBox.Error("Unable to create " + def.GetBaseName,"")
    end
    return nil
  end

  if (WasNotVisible) then
    shpfld.SetVisible(FALSE)
  end

 end

 ' build the spatial index
 anFTab.CreateIndex(shpfld)

 ' don't add the projected shapefile to the view -
 ' it won't show up if you do!
 if (p.Not) then
   if (MsgBox.YesNo("Add shapefile as theme to the view?",
     "Convert to Shapefile",true).Not) then continue end

  ' create a theme and add it to the View
  fthm = FTheme.Make(anFTab)
  theView.AddTheme(fthm)
 else
  MsgBox.Info("Since your view is projected, the projected data" ++
    "will not be added to the view. It has been saved on disk.", "Convert")
 end

 ' bring the View to the front
 theView.GetWin.Activate
end




                                                       188
Appendix E
Graphical Information for Interviews


1. Map of Buildings and Street (see Figure 6-1)
2. Map of Bodies of Water
3. Map of Zoning (see Figure 5-4)
4. Map of Public Facilities
5. Map of Historic Sites, Historic Area, and Schools
6. Map of Parcels
7. Map of Slope (derived from contour map) (see Figure 5-7)
8. Map of Soil Type (see Figure 5-2)
9. Map of Urban Forestry (from Department of Public Works and Environmental Services,
   Fairfax County, Virginia)
10. Aerial Photo (derived from USGS DOQQs)




                                            189
      Reston, VA




190
      Reston, VA




191
      Reston, VA




192
      Reston, VA




193
      Reston, VA




194
Aerial Photo of Reston, VA




        195
Appendix F
Code for SiteOne


'Form fmBegin
''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub Command1_Click()                               ' next button
      Set fmCEem = Nothing
      Set fmCEex = Nothing
      Set fmCEsm = Nothing
      Set fmCEst = Nothing
      Set fmCEwt = Nothing
      Set fmFCem = Nothing
      Set fmFCex = Nothing
      Set fmFCsm = Nothing
      Set fmFCst = Nothing
      Set fmFCwt = Nothing
      Set fmFSem = Nothing
      Set fmFSex = Nothing
      Set fmFSsm = Nothing
      Set fmFSst = Nothing
      Set fmFSwt = Nothing
      Set fmDefine = Nothing
      Set fmPrint = Nothing

  Load fmDefine
  fmDefine.Show
  fmBegin.Visible = False
End Sub

Private Sub Command2_Click()                               ' load help frame
  Load fmHelp
  fmHelp.Show
End Sub

'Form fmCEem
''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Option Explicit
Public g_ActiveLayer As Object
Public strMapUnits As String
Private collGtextStrings As New VBA.Collection
Private collGtextPoints As New VBA.Collection
Private symGtext As New mapobjects2.TextSymbol
'Private m_mapTip As New clsMapTip
Private dropValid As Boolean
Private BarState As String
Private Const MIN_LEGEND_WIDTH = 350
Private Const INCH2FEET = 12
Private Const INCH2METERS = 39.37
Private Const INCH2DEGREES = 4322893.46

' BUTTON BAR FOR "DISPLAY" TOOLS

                                                                               196
Private Sub barDisplay_ButtonClick(ByVal Button As Button)
 Dim bKey As String
 bKey = Button.Key
 Call doTask(bKey)
 BarState = bKey
End Sub

Sub InitializeMap()
 Dim dc As New DataConnection
 Dim layer As MapLayer
 dc.Database = "C:\final"

 If dc.Connect Then
  If fmCEex.CEexLoad = 1 Or fmCEwt.CEwtLoad = 1 Then         ' expert settings
     If fmCEwt.Option3.Value = False Then
        Select Case fmCEex.cc
        Case "1"
          Set layer = New MapLayer
          layer.GeoDataset = dc.FindGeoDataset("day")
          MapDisp.Layers.Add layer
          layer.Visible = False
        Case "2"
          Set layer = New MapLayer
          layer.GeoDataset = dc.FindGeoDataset("night")
          MapDisp.Layers.Add layer
          layer.Visible = False
        Case "3"
          Set layer = New MapLayer
          layer.GeoDataset = dc.FindGeoDataset("call")
          MapDisp.Layers.Add layer
          layer.Visible = False
        End Select
     End If

    If fmCEwt.Option6.Value = False Then
       Select Case fmCEex.cg
       Case "1"
         Set layer = New MapLayer
         layer.GeoDataset = dc.FindGeoDataset("soil")
         layer.Visible = False
       Case "2"
         Set layer = New MapLayer
         layer.GeoDataset = dc.FindGeoDataset("erosion")
         MapDisp.Layers.Add layer
         layer.Visible = False
       Case "3"
         Set layer = New MapLayer
         layer.GeoDataset = dc.FindGeoDataset("geo")
         MapDisp.Layers.Add layer
         layer.Visible = False
       End Select
    End If

    If fmCEwt.Option9.Value = False Then

                                                   197
  Set layer = New MapLayer
  layer.GeoDataset = dc.FindGeoDataset("chydro")
  MapDisp.Layers.Add layer
  layer.Visible = False
End If

If fmCEwt.Option12.Value = False Then
   Select Case fmCEex.cs
   Case "1"
     Set layer = New MapLayer
     layer.GeoDataset = dc.FindGeoDataset("slope10")
     MapDisp.Layers.Add layer
     layer.Visible = False
   Case "2"
     Set layer = New MapLayer
     layer.GeoDataset = dc.FindGeoDataset("slope16")
     MapDisp.Layers.Add layer
     layer.Visible = False
   End Select

  Select Case fmCEex.co
  Case "1"
    Set layer = New MapLayer
    layer.GeoDataset = dc.FindGeoDataset("ne-s")
    MapDisp.Layers.Add layer
    layer.Visible = False
  Case "2"
    Set layer = New MapLayer
    layer.GeoDataset = dc.FindGeoDataset("ne-sw")
    MapDisp.Layers.Add layer
    layer.Visible = False
  Case "3"
    Set layer = New MapLayer
    layer.GeoDataset = dc.FindGeoDataset("ne-w")
    MapDisp.Layers.Add layer
    layer.Visible = False
  Case "4"
    Set layer = New MapLayer
    layer.GeoDataset = dc.FindGeoDataset("ne-nw")
    MapDisp.Layers.Add layer
    layer.Visible = False
  Case "5"
    Set layer = New MapLayer
    layer.GeoDataset = dc.FindGeoDataset("e-sw")
    MapDisp.Layers.Add layer
    layer.Visible = False
  Case "6"
    Set layer = New MapLayer
    layer.GeoDataset = dc.FindGeoDataset("e-w")
    MapDisp.Layers.Add layer
    layer.Visible = False
  Case "7"
    Set layer = New MapLayer
    layer.GeoDataset = dc.FindGeoDataset("e-nw")

                                               198
        MapDisp.Layers.Add layer
        layer.Visible = False
      Case "8"
        Set layer = New MapLayer
        layer.GeoDataset = dc.FindGeoDataset("se-w")
        MapDisp.Layers.Add layer
        layer.Visible = False
      Case "9"
        Set layer = New MapLayer
        layer.GeoDataset = dc.FindGeoDataset("se-nw")
        MapDisp.Layers.Add layer
        layer.Visible = False
      Case "0"
        Set layer = New MapLayer
        layer.GeoDataset = dc.FindGeoDataset("s-nw")
        MapDisp.Layers.Add layer
        layer.Visible = False
      End Select
    End If

    If fmDefine.ChVeg.Value = 1 And fmCEwt.Option15.Value = False Then
       Set layer = New MapLayer
       layer.GeoDataset = dc.FindGeoDataset("tree")
       MapDisp.Layers.Add layer
       layer.Visible = False
    End If
  End If

  Set layer = New MapLayer

  If fmCEex.CEexLoad = 1 Then
     layer.GeoDataset = dc.FindGeoDataset(fmCEex.mapName)
     MapDisp.Layers.Add layer
     layer.Visible = True
  ElseIf fmCEwt.CEwtLoad = 1 Then
     layer.GeoDataset = dc.FindGeoDataset(fmCEwt.mapName)
     MapDisp.Layers.Add layer
     layer.Visible = True
  End If

 Else
  MsgBox "The data could not be located."
  End ' exit the application
 End If
End Sub

Private Sub Command1_Click()     ' help
  fmHelp.Visible = True
  'fmCEem.Visible = False
End Sub

Private Sub Command3_Click()     ' restart
  fmBegin.Visible = True
  fmCEem.Visible = False

                                                  199
  Set fmCEem = Nothing
End Sub

Private Sub Command4_Click()      ' previous
  If fmCEex.CEexLoad = 1 Then
     fmCEex.Visible = True
     fmCEem.Visible = False
  End If

  If fmCEwt.CEwtLoad = 1 Then
     fmCEwt.Visible = True
     fmCEem.Visible = False
  End If

  Set fmCEem = Nothing
End Sub

Private Sub Form_Load()
  Dim Index As Long
  Index = legMapDisp.getActiveLayer
  If Index <> -1 Then
     MapDisp.Layers.Remove Index
     legMapDisp.LoadLegend 'Refresh legend
  End If

  InitializeMap

  'Link legend to the Map control
  legMapDisp.setMapSource MapDisp
  legMapDisp.LoadLegend True
  legMapDisp.ShowAllLegend
  legMapDisp.Active(0) = True
End Sub

Private Sub legMapDisp_AfterSetLayerVisible(Index As Integer, isVisible As Boolean)
  MapDisp.Refresh
End Sub

' MAP DISPLAY RELATED ACTIVITY
Private Sub mapDisp_AfterTrackingLayerDraw(ByVal hDC As StdOle.OLE_HANDLE)

Select Case BarState
Case "Graphics"
  MapDisp.MousePointer = moCross
Case "Spatial Select"
  MapDisp.MousePointer = moArrow
Case "Zoom in"
  MapDisp.MousePointer = moZoomIn
Case "Zoom out"
  MapDisp.MousePointer = moZoomOut
Case "Pan"
  MapDisp.MousePointer = moPan
Case "Identify"
  MapDisp.MousePointer = moIdentify

                                                    200
Case Else
  MapDisp.MousePointer = moDefault
End Select
End Sub

Public Sub doTask(buttonKey As String)
  Select Case buttonKey
  Case "Print"
   fmPrint.Show
  Case "Zoom in"
    MapDisp.MousePointer = moZoomIn
  Case "Zoom out"
    MapDisp.MousePointer = moZoomOut
  Case "Pan"
    MapDisp.MousePointer = moPan
  Case "Full extent"
   MapDisp.Extent = MapDisp.FullExtent
  End Select
End Sub

Private Sub MapDisp_DragFiles(ByVal fileNames As Object, ByVal X As Single, ByVa l Y As Single, ByVal state
As Integer, dropValid As Boolean)
   Dim dcx As New mapobjects2.DataConnection
   Dim shpfile As Variant
   Dim i As Integer
   Dim ml As mapobjects2.MapLayer
   shpfile = (Dir(fileNames.Item(0), vbDirectory))
   shpfile = CStr(Left(shpfile, Len(shpfile) - 4))

   dcx.Database = Left(fileNames.Item(0), Len(fileNames.Item(0)) - Len(shpfile) - 5)
   If dcx.Connect Then
     For i = 0 To fileNames.Count - 1
      Set ml = New mapobjects2.MapLayer
      shpfile = Dir(fileNames.Item(i), vbDirectory)
      shpfile = CStr(Left(shpfile, Len(shpfile) - 4))
      Set ml.GeoDataset = dcx.FindGeoDataset(shpfile)
      MapDisp.Layers.Add ml
      legMapDisp.LoadLegend
    Next i

    'prepare collections to sort layers
    Dim ptcoll As New Collection
    Dim linecoll As New Collection
    Dim polycoll As New Collection
    Dim imagecoll As New Collection

    For i = 0 To MapDisp.Layers.Count - 1
     If MapDisp.Layers(i).LayerType = moImageLayer Then
        imagecoll.Add MapDisp.Layers(i)
     ElseIf MapDisp.Layers(i).LayerType = moMapLayer Then
      Select Case MapDisp.Layers(i).shapeType
        Case moShapeTypePoint
         ptcoll.Add MapDisp.Layers(i)
        Case moShapeTypeLine

                                                       201
        linecoll.Add MapDisp.Layers(i)
       Case moShapeTypePolygon
        polycoll.Add MapDisp.Layers(i)
      End Select
     End If
    Next i
    MapDisp.Layers.Clear

    'add all the layers back in sorted by type
    Dim p As mapobjects2.MapLayer
    For Each p In polycoll
      MapDisp.Layers.Add p
    Next p

    Dim l As mapobjects2.MapLayer
    For Each l In linecoll
     MapDisp.Layers.Add l
    Next l

    For Each p In ptcoll
     MapDisp.Layers.Add p
    Next p

    Dim im As mapobjects2.ImageLayer
    For Each im In imagecoll
     MapDisp.Layers.Add im
    Next im

   End If
   MapDisp.Extent = MapDisp.FullExtent
   MapDisp.Refresh
End Sub

Private Sub mapDisp_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
 'This procedure invokes the active map tool; zoom in, zoom out, pan, or other.
 Dim curRectangle As Rectangle

 'Zoom in button was pushed
 If barDisplay.Buttons("Zoom in").Value = 1 Then
  Set curRectangle = MapDisp.TrackRectangle
  Set MapDisp.Extent = curRectangle

 'Zoom out button was pushed
 ElseIf barDisplay.Buttons("Zoom out").Value = 1 Then
  Dim Loc As New Point
  Set Loc = MapDisp.ToMapPoint(X, Y)

  Dim MapWidth As Double, MapHeight As Double
  Set curRectangle = MapDisp.Extent
  MapWidth = MapDisp.Extent.Width
  MapHeight = MapDisp.Extent.Height
  curRectangle.Right = Loc.X + MapWidth
  curRectangle.Left = Loc.X - MapWidth
  curRectangle.Top = Loc.Y + MapHeight

                                                   202
    curRectangle.Bottom = Loc.Y - MapHeight
    Set MapDisp.Extent = curRectangle

 'Pan button
 ElseIf barDisplay.Buttons("Pan").Value = 1 Then
  MapDisp.Pan
 End If
End Sub


'Form fmCEex
''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Option Explicit
Private firstFlag As Integer
Private checkNum As Integer
Private CheckAll As Integer
Public mapSelect As Integer
Public CEexLoad As Integer
Public cc As String
Public cg As String
Public ch As String
Public cs As String
Public co As String
Public cv As String
Public mapName As String

Private Sub checkOptions()
  If fmDefine.ChClimate.Value = 0 Then
     cc = "A"
  ElseIf fmDefine.ChClimate.Value = 1 Then
     If Option4.Value = True Then
        cc = 3
     ElseIf Option5.Value = True Then
        cc = 1
     ElseIf Option6.Value = True Then
        cc = 2
    End If
  End If

    If fmDefine.ChGeology.Value = 0 Then
       cg = "A"
    ElseIf fmDefine.ChGeology.Value = 1 Then
       If Option7.Value = True Then
          cg = 1
       ElseIf Option8.Value = True Then
          cg = 2
       ElseIf Option9.Value = True Then
          cg = 3
       End If
    End If

    If fmDefine.ChHydro.Value = 0 Then
       ch = "A"
    ElseIf fmDefine.ChHydro.Value = 1 Then

                                                           203
  ch = 1
End If

If fmDefine.ChTopo.Value = 0 Then
   cs = "A"
   co = "A"
ElseIf fmDefine.ChTopo.Value = 1 Then
   If SLselect.ListIndex = 0 Then
      cs = 1
   Else
      cs = 2
   End If

  If Check1.Value = 1 Then
     If Check5.Value = 0 Then
        co = 1
     ElseIf Check5.Value = 1 Then
        If Check6.Value = 0 Then
           co = 2
        ElseIf Check6.Value = 1 Then
           If Check7.Value = 0 Then
              co = 3
           ElseIf Check7.Value = 1 Then
              co = 4
           End If
        End If
     End If
  ElseIf Check1.Value = 0 Then
     If Check2.Value = 1 Then
        If Check6.Value = 0 Then
           co = 5
        ElseIf Check6.Value = 1 Then
           If Check7.Value = 0 Then
              co = 6
           ElseIf Check7.Value = 1 Then
              co = 7
           End If
        End If
     ElseIf Check2.Value = 0 Then
        If Check3.Value = 1 Then
           If Check7.Value = 0 Then
              co = 8
           ElseIf Check7.Value = 1 Then
              co = 9
           End If
        ElseIf Check3.Value = 0 Then
           co = 0
        End If
     End If
  End If

End If 'end topo value check

If fmDefine.ChVeg.Value = 0 Then

                                          204
    cv = "A"
  ElseIf fmDefine.ChVeg.Value = 1 Then
    cv = 1
  End If

  mapName = "C" & cc & cg & ch & cs & co & cv
End Sub

Private Sub checkOrientation()            ' check if 4 continuous directions
  firstFlag = 0                ' for the first checked box
  checkNum = 0

  If Check1.Value = 1 And firstFlag = 0 Then
     firstFlag = 1
     checkNum = 1
  End If

  If Check2.Value = 1 Then
     If firstFlag = 0 Then
        firstFlag = 1
        checkNum = 1
     ElseIf firstFlag = 1 Then
        checkNum = checkNum + 1
     End If
  ElseIf Check2.Value = 0 And firstFlag = 1 Then
     firstFlag = 0
     checkNum = 0
  End If

  If Check3.Value = 1 Then
     If firstFlag = 0 Then
        firstFlag = 1
        checkNum = 1
     ElseIf firstFlag = 1 Then
        checkNum = checkNum + 1
     End If
  ElseIf Check3.Value = 0 And firstFlag = 1 Then
     firstFlag = 0
     checkNum = 0
  End If

  If Check4.Value = 1 Then
     If firstFlag = 0 Then
        firstFlag = 1
        checkNum = 1
     ElseIf firstFlag = 1 Then
        checkNum = checkNum + 1
     End If
  ElseIf Check4.Value = 0 And firstFlag = 1 Then
     firstFlag = 0
     checkNum = 0
  End If

  If Check5.Value = 1 Then

                                                        205
    If firstFlag = 0 Then
       Exit Sub
    ElseIf firstFlag = 1 Then
       checkNum = checkNum + 1
    End If
  ElseIf Check5.Value = 0 And firstFlag = 1 Then
    If checkNum < 4 Then
    End If
  End If

  If Check6.Value = 1 Then
     If firstFlag = 0 Then
        Exit Sub
     ElseIf firstFlag = 1 Then
        checkNum = checkNum + 1
     End If
  End If

  If Check7.Value = 1 Then
     If firstFlag = 0 Then
        Exit Sub
     ElseIf firstFlag = 1 Then
        checkNum = checkNum + 1
     End If
  End If
End Sub

Private Sub Command1_Click()           ' load help frame
  Load fmHelp
  fmHelp.Show
End Sub

Private Sub Command2_Click()            ' switch to standard settings
  fmCEst.Visible = True
  fmDefine.standBt.Value = True
  fmCEex.Visible = False
  'Set fmCEex = Nothing
End Sub

Private Sub Command3_Click()           ' restart button
  fmBegin.Show
  fmCEex.Visible = False
  Set fmDefine = Nothing
  Set fmCEex = Nothing
End Sub

Private Sub Command4_Click()           ' previous button
  fmDefine.Show
  fmCEex.Visible = False
  Set fmCEex = Nothing
End Sub

Private Sub Command5_Click()           ' last button
  checkOrientation

                                                          206
  If checkNum < 4 Then
    MsgBox "error: you need to continously select 4 directions"
  Else
     checkOptions
     Load fmCEem
     fmCEem.Visible = True
     fmCEex.Visible = False
  End If
End Sub

Private Sub Command6_Click()           ' next button
  checkOrientation

  If checkNum < 4 Then
    MsgBox "error: you need to continously select 4 directions"

  Else
    checkOptions
    Load fmCEem
    fmCEem.Visible = True
    fmCEex.Visible = False
  End If
End Sub

Private Sub Form_Load()
  CEexLoad = 1

  If fmDefine.ChClimate.Value = 0 Then
     Frame1.Enabled = False
     Frame7.Enabled = False
     Option1.Enabled = False
     Option2.Enabled = False
     Option3.Enabled = False
     Option4.Enabled = False
     Option5.Enabled = False
     Option6.Enabled = False
  End If
  If fmDefine.ChGeology.Value = 0 Then
     Frame2.Enabled = False
     Option7.Enabled = False
     Option8.Enabled = False
     Option9.Enabled = False
  End If
  If fmDefine.ChHydro.Value = 0 Then
     Frame3.Enabled = False
     Option10.Enabled = False
  End If
  If fmDefine.ChTopo.Value = 0 Then
     Frame4.Enabled = False
     Check1.Enabled = False
     Check2.Enabled = False
     Check3.Enabled = False
     Check4.Enabled = False

                                                       207
     Check5.Enabled = False
     Check6.Enabled = False
     Check7.Enabled = False
     SLselect.Enabled = False
  End If
  If fmDefine.ChVeg.Value = 0 Then
     Frame5.Enabled = False
     Option11.Enabled = False
  End If
End Sub

'Form fmCEst
''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Option Explicit
Public g_ActiveLayer As Object
Public strMapUnits As String
Private collGtextStrings As New VBA.Collection
Private collGtextPoints As New VBA.Collection
Private symGtext As New mapobjects2.Text Symbol
'Private m_mapTip As New clsMapTip
Private dropValid As Boolean
Private BarState As String

Private Const MIN_LEGEND_WIDTH = 350
Private Const INCH2FEET = 12
Private Const INCH2METERS = 39.37
Private Const INCH2DEGREES = 4322893.46

' BUTTON BAR FOR "DISPLAY" TOOLS
Private Sub barDisplay_ButtonClick(ByVal Button As Button)
 Dim bKey As String
 bKey = Button.Key
 Call doTask(bKey)
 BarState = bKey
End Sub

Sub InitializeMap()
 Dim dc As New DataConnection
 Dim layer As MapLayer
 dc.Database = "C:\final"

 If dc.Connect Then
  Set layer = New MapLayer
  layer.GeoDataset = dc.FindGeoDataset("call")
  MapDisp.Layers.Add layer
  layer.Visible = False

  Set layer = New MapLayer
  layer.GeoDataset = dc.FindGeoDataset("geo")
  MapDisp.Layers.Add layer
  layer.Visible = False

  Set layer = New MapLayer
  layer.GeoDataset = dc.FindGeoDataset("chydro")

                                                           208
  MapDisp.Layers.Add layer
  layer.Visible = False

  Set layer = New MapLayer
  layer.GeoDataset = dc.FindGeoDataset("slope16")
  MapDisp.Layers.Add layer
  layer.Visible = False

  Set layer = New MapLayer
  layer.GeoDataset = dc.FindGeoDataset("ne-nw")
  MapDisp.Layers.Add layer
  layer.Visible = False

  Set layer = New MapLayer
  layer.GeoDataset = dc.FindGeoDataset("tree")
  MapDisp.Layers.Add layer
  layer.Visible = False

  Set layer = New MapLayer
  layer.GeoDataset = dc.FindGeoDataset("c331241")
  MapDisp.Layers.Add layer
  layer.Visible = True

 Else
  MsgBox "The data could not be located."
  End ' exit the application
 End If
End Sub

Private Sub Command1_Click()
  fmHelp.Visible = True
  'fmCEsm.Visible = False
End Sub

Private Sub Command3_Click()
  fmBegin.Visible = True
  fmCEsm.Visible = False
  Set fmCEsm = Nothing
End Sub

Private Sub Command4_Click()
  fmCEst.Visible = True
  fmCEsm.Visible = False
End Sub

Private Sub Form_Load()
  Dim Index As Long
  Index = legMapDisp.getActiveLayer
  If Index <> -1 Then
     MapDisp.Layers.Remove Index
     legMapDisp.LoadLegend 'Refresh legend
  End If

  InitializeMap

                                                    209
  'Link legend to the Map control
  legMapDisp.setMapSource MapDisp
  legMapDisp.LoadLegend True
  legMapDisp.ShowAllLegend
  legMapDisp.Active(0) = True

End Sub

Private Sub legMapDisp_AfterSetLayerVisible(Index As Integer, isVisible As Boolean)
  MapDisp.Refresh
End Sub

' MAP DISPLAY RELATED ACTIVITY
Private Sub mapDisp_AfterTrackingLayerDraw(ByVal hDC As StdOle.OLE_HANDLE)
Select Case BarState
Case "Graphics"
  MapDisp.MousePointer = moCross
Case "Spatial Select"
  MapDisp.MousePointer = moArrow
Case "Zoom in"
  MapDisp.MousePointer = moZoomIn
Case "Zoom out"
  MapDisp.MousePointer = moZoomOut
Case "Pan"
  MapDisp.MousePointer = moPan
Case "Identify"
  MapDisp.MousePointer = moIdentify
Case Else
  MapDisp.MousePointer = moDefault
End Select
End Sub

Public Sub doTask(buttonKey As String)
  Select Case buttonKey
  Case "Print"
   fmPrint.Show
  Case "Zoom in"
    MapDisp.MousePointer = moZoomIn
  Case "Zoom out"
    MapDisp.MousePointer = moZoomOut
  Case "Pan"
    MapDisp.MousePointer = moPan
  Case "Full extent"
   MapDisp.Extent = MapDisp.FullExtent
  End Select
End Sub

Private Sub MapDisp_DragFiles(ByVal fileNames As Object, ByVal X As Single, ByVal Y As Single, ByVal state
As Integer, dropValid As Boolean)
    Dim dcx As New mapobjects2.DataConnection
    Dim shpfile As Variant
    Dim i As Integer
    Dim ml As mapobjects2.MapLayer

                                                    210
shpfile = (Dir(fileNames.Item(0), vbDirectory))
shpfile = CStr(Left(shpfile, Len(shpfile) - 4))

dcx.Database = Left(fileNames.Item(0), Len(fileNames.Item(0)) - Len(shpfile) - 5)
If dcx.Connect Then
 For i = 0 To fileNames.Count - 1
   Set ml = New mapobjects2.MapLayer
   shpfile = Dir(fileNames.Item(i), vbDirectory)
   shpfile = CStr(Left(shpfile, Len(shpfile) - 4))
   Set ml.GeoDataset = dcx.FindGeoDataset(shpfile)
   MapDisp.Layers.Add ml
   legMapDisp.LoadLegend
 Next i

 'prepare collections to sort layers
 Dim ptcoll As New Collection
 Dim linecoll As New Collection
 Dim polycoll As New Collection
 Dim imagecoll As New Collection

 For i = 0 To MapDisp.Layers.Count - 1
  If MapDisp.Layers(i).LayerType = moImageLayer Then
     imagecoll.Add MapDisp.Layers(i)
  ElseIf MapDisp.Layers(i).LayerType = moMapLayer Then
   Select Case MapDisp.Layers(i).shapeType
     Case moShapeTypePoint
      ptcoll.Add MapDisp.Layers(i)
     Case moShapeTypeLine
      linecoll.Add MapDisp.Layers(i)
     Case moShapeTypePolygon
      polycoll.Add MapDisp.Layers(i)
   End Select
  End If
 Next i
 MapDisp.Layers.Clear

 'add all the layers back in sorted by type
 Dim p As mapobjects2.MapLayer
 For Each p In polycoll
   MapDisp.Layers.Add p
 Next p

 Dim l As mapobjects2.MapLayer
 For Each l In linecoll
  MapDisp.Layers.Add l
 Next l

 For Each p In ptcoll
  MapDisp.Layers.Add p
 Next p

 Dim im As mapobjects2.ImageLayer
 For Each im In imagecoll
  MapDisp.Layers.Add im

                                                    211
       Next im
      End If

   MapDisp.Extent = MapDisp.FullExtent
   MapDisp.Refresh
End Sub

Private Sub mapDisp_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
 'This procedure invokes the active map tool; zoom in, zoom out, pan, or other.
 Dim curRectangle As Rectangle

  'Zoom in button was pushed
  If barDisplay.Buttons("Zoom in").Value = 1 Then
   Set curRectangle = MapDisp.TrackRectangle
   Set MapDisp.Extent = curRectangle

  'Zoom out button was pushed
  ElseIf barDisplay.Buttons("Zoom out").Value = 1 Then
   Dim Loc As New Point
   Set Loc = MapDisp.ToMapPoint(X, Y)
   'We calculate the full width and height. Adding and substracting
   'the full values from Loc has the effect of zooming out by a factor of 2.
   Dim MapWidth As Double, MapHeight As Double
   Set curRectangle = MapDisp.Extent
   MapWidth = MapDisp.Extent.Width
   MapHeight = MapDisp.Extent.Height
   curRectangle.Right = Loc.X + MapWidth
   curRectangle.Left = Loc.X - MapWidth
   curRectangle.Top = Loc.Y + MapHeight
   curRectangle.Bottom = Loc.Y - MapHeight
   Set MapDisp.Extent = curRectangle

 'Pan button
 ElseIf barDisplay.Buttons("Pan").Value = 1 Then
  MapDisp.Pan
 End If
End Sub


'Form fmCEsm
''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Option Explicit
Public CEstLoad As Integer
Private Sub Command1_Click()                               ' help frame
      Load fmHelp
      fmHelp.Show
End Sub

Private Sub Command2_Click()                               ' switch to expert settings
  fmCEex.Visible = True
  fmDefine.exptBt.Value = True
  fmCEst.Visible = False
  Set fmCEst = Nothing
End Sub

                                                                               212
Private Sub Command3_Click()      ' restart button
  fmBegin.Visible = True
  fmCEst.Visible = False
  Set fmDefine = Nothing
  Set fmCEst = Nothing
End Sub

Private Sub Command4_Click()      ' previous button
  fmDefine.Visible = True
  fmCEst.Visible = False
  Set fmCEst = Nothing
End Sub

Private Sub Command5_Click()     ' last button
  Load fmCEsm
  fmCEsm.Show
  fmCEst.Visible = False
End Sub

Private Sub Command6_Click()     ' next button
  Load fmCEsm
  fmCEsm.Show
  fmCEst.Visible = False
End Sub

Private Sub Form_Load()
  CEstLoad = 1
  ' Standard contemporary setting
  If fmDefine.ChClimate.Value = 1 Then
     Label2.Caption = fmDefine.ruleCE1
  End If
  If fmDefine.ChGeology.Value = 1 Then
     Label3.Caption = fmDefine.ruleCE2
  End If
  If fmDefine.ChHydro.Value = 1 Then
     Label4.Caption = fmDefine.ruleCE3
  End If
  If fmDefine.ChTopo.Value = 1 Then
     Label5.Caption = fmDefine.ruleCE4
  End If
  If fmDefine.ChVeg.Value = 1 Then
     Label6.Caption = fmDefine.ruleCE5
  End If

  Label2.Visible = False
  Label4.Visible = False
  Label3.Visible = False
  Label5.Visible = False
  Label6.Visible = False
  Label7.Caption = Label2.Caption & Label3.Caption & Label4.Caption & Label5.Caption & Label6.Caption
End Sub

'Form fmCEst

                                                      213
''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Option Explicit
Public CEstLoad As Integer
Private Sub Command1_Click()                               ' help frame
      Load fmHelp
      fmHelp.Show
End Sub

Private Sub Command2_Click()                               ' switch to expert settings
  fmCEex.Visible = True
  fmDefine.exptBt.Value = True
  fmCEst.Visible = False
  Set fmCEst = Nothing
End Sub

Private Sub Command3_Click()                               ' restart button
  fmBegin.Visible = True
  fmCEst.Visible = False
  Set fmDefine = Nothing
  Set fmCEst = Nothing
End Sub

Private Sub Command4_Click()                               ' previous button
  fmDefine.Visible = True
  fmCEst.Visible = False
  Set fmCEst = Nothing
End Sub

Private Sub Command5_Click()                               ' last button
  Load fmCEsm
  fmCEsm.Show
  fmCEst.Visible = False
End Sub

Private Sub Command6_Click()                               ' next button
  Load fmCEsm
  fmCEsm.Show
  fmCEst.Visible = False
End Sub

Private Sub Form_Load()
  CEstLoad = 1
  ' Standard contemporary setting
  If fmDefine.ChClimate.Value = 1 Then
     Label2.Caption = fmDefine.ruleCE1
  End If
  If fmDefine.ChGeology.Value = 1 Then
     Label3.Caption = fmDefine.ruleCE2
  End If
  If fmDefine.ChHydro.Value = 1 Then
     Label4.Caption = fmDefine.ruleCE3
  End If
  If fmDefine.ChTopo.Value = 1 Then
     Label5.Caption = fmDefine.ruleCE4

                                                                               214
    End If
    If fmDefine.ChVeg.Value = 1 Then
       Label6.Caption = fmDefine.ruleCE5
    End If

  Label2.Visible = False
  Label4.Visible = False
  Label3.Visible = False
  Label5.Visible = False
  Label6.Visible = False
  Label7.Caption = Label2.Caption & Label3.Caption & Label4.Caption & Label5.Caption & Label6.Caption
End Sub

'Form fmCEwt
''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Option Explicit
Public mapSelect As Integer
Public CEwtLoad As Integer
Private cc As String
Private cg As String
Private ch As String
Private cs As String
Private co As String
Private cv As String
Public mapName As String

Private Sub checkOptions()           ' pass user selections to map names
  If fmDefine.ChClimate.Value = 0 Then
     cc = "A"
  ElseIf fmDefine.ChClimate.Value = 1 Then
     If Option1.Value = True Then
        cc = "B"
     ElseIf Option2.Value = True Then
        cc = 3
     ElseIf Option3.Value = True Then
        cc = "A"
     End If
  End If

    If fmDefine.ChGeology.Value = 0 Then
       cg = "A"
    ElseIf fmDefine.ChGeology.Value = 1 Then
       If Option4.Value = True Then
          cg = "B"
       ElseIf Option5.Value = True Then
          cg = 3
       ElseIf Option6.Value = True Then
          cg = "A"
       End If
    End If

    If fmDefine.ChHydro.Value = 0 Then
       ch = "A"
    ElseIf fmDefine.ChHydro.Value = 1 Then

                                                           215
    If Option7.Value = True Then
       ch = "B"
    ElseIf Option8.Value = True Then
       ch = 1
    ElseIf Option9.Value = True Then
       ch = "A"
    End If
  End If

  If fmDefine.ChTopo.Value = 0 Then
     cs = "A"
     co = "A"
  ElseIf fmDefine.ChTopo.Value = 1 Then
     If Option10.Value = True Then
        cs = "B"
        co = "B"
     ElseIf Option11.Value = True Then
        cs = 2
        co = 4
     ElseIf Option12.Value = True Then
        cs = "A"
        co = "A"
     End If
  End If

  If fmDefine.ChVeg.Value = 0 Then
     cv = "A"
  ElseIf fmDefine.ChVeg.Value = 1 Then
     If Option13.Value = True Then
        cv = "B"
     ElseIf Option14.Value = True Then
        cv = 1
     ElseIf Option15.Value = True Then
        cv = "A"
     End If
  End If

  mapName = "c" & cc & cg & ch & cs & co & cv
End Sub

Private Sub Command1_Click()       ' load help frame
  Load fmHelp
  fmHelp.Show
End Sub

Private Sub Command2_Click()           ' switch to standard settings
  fmCEst.Visible = True
  fmCEwt.Visible = False
  Set fmCEwt = Nothing
End Sub

Private Sub Command3_Click()           ' restart button
  fmBegin.Show
  fmCEwt.Visible = False

                                                          216
  Set fmDefine = Nothing
  Set fmCEwt = Nothing
End Sub

Private Sub Command4_Click()        ' previous button
  fmDefine.Show
  fmCEwt.Visible = False
  Set fmCEwt = Nothing
End Sub

Private Sub Command5_Click()        ' last button
  checkOptions
  Load fmCEem
  fmCEem.Visible = True
  fmCEwt.Visible = False
End Sub

Private Sub Command6_Click()        ' next button
  checkOptions
  Load fmCEem
  fmCEem.Visible = True
  fmCEwt.Visible = False
End Sub
Private Sub Command8_Click()        ' switch to expert settings
  Load fmCEex
  fmCEex.Visible = True
  fmCEwt.Visible = False
End Sub

Private Sub Form_Load()
  CEwtLoad = 1

  If fmDefine.ChClimate.Va lue = 0 Then
     Frame1.Enabled = False
     Option1.Enabled = False
     Option2.Enabled = False
     Option3.Enabled = False
  End If
  If fmDefine.ChGeology.Value = 0 Then
     Frame2.Enabled = False
     Option4.Enabled = False
     Option5.Enabled = False
     Option6.Enabled = False
  End If
  If fmDefine.ChHydro.Value = 0 Then
     Frame3.Enabled = False
     Option7.Enabled = False
     Option8.Enabled = False
     Option9.Enabled = False
  End If
  If fmDefine.ChTopo.Value = 0 Then
     Frame4.Enabled = False
     Option10.Enabled = False
     Option11.Enabled = False

                                                        217
     Option12.Enabled = False
  End If
  If fmDefine.ChVeg.Value = 0 Then
     Frame5.Enabled = False
     Option13.Enabled = False
     Option14.Enabled = False
     Option15.Enabled = False
  End If
End Sub

'Form fmDefine
''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Option Explicit
Public FsCe As Integer
' contemporary rules
Public ruleCE1 As String
Public ruleCE2 As String
Public ruleCE3 As String
Public ruleCE4 As String
Public ruleCE5 As String
' feng shui rules
Public ruleFS1 As String
Public ruleFS2 As String
Public ruleFS3 As String
Public ruleFS4 As String
Public ruleFS5 As String

' integration rules
Public ruleFC1 As String
Public ruleFC2 As String
Public ruleFC3 As String
Public ruleFC4 As String
Public ruleFC5 As String

Private Sub chCE_Click()
  If chFS.Value = 0 Then
     chCE.Value = 1
  End If
End Sub

Private Sub chFS_Click()
  If chCE.Value = 0 Then
     chFS.Value = 1
  End If
End Sub

Private Sub Command1_Click()                               ' next button
  Set fmCEem = Nothing
  Set fmCEex = Nothing
  Set fmCEsm = Nothing
  Set fmCEst = Nothing
  Set fmCEwt = Nothing

     Set fmFCem = Nothing

                                                                           218
  Set fmFCex = Nothing
  Set fmFCsm = Nothing
  Set fmFCst = Nothing
  Set fmFCwt = Nothing

  Set fmFSem = Nothing
  Set fmFSex = Nothing
  Set fmFSsm = Nothing
  Set fmFSst = Nothing
  Set fmFSwt = Nothing

  ' standard analysis
  If standBt.Value = True Then
     If chFS.Value = True Then    ' feng shui
        Load fmFSst
        fmFSst.Show
     ElseIf chFC.Value = True Then ' integrated method
        Load fmFCst
        fmFCst.Show
     ElseIf chCE.Value = True Then ' contemporary
        Load fmCEst
        fmCEst.Show
     End If

  ' expert (modify settings)
  ElseIf exptBt.Value = True Or Option1.Value = True Then
     If chFS.Value = True Then    ' feng shui
        Load fmFSex
        fmFSex.Show
     ElseIf chFC.Value = True Then ' integrated method
        Load fmFCex
        fmFCex.Show
     ElseIf chCE.Value = True Then ' contemporary
        Load fmCEex
        fmCEex.Show
     End If

  ' expert (modify weights)
  ElseIf Option2.Value = True Then
     If chFS.Value = True Then    ' feng shui
        Load fmFSwt
        fmFSwt.Show
     ElseIf chFC.Value = True Then ' integrated method
        Load fmFCwt
        fmFCwt.Show
     ElseIf chCE.Value = True Then ' contemporary
        Load fmCEwt
        fmCEwt.Show
     End If
  End If

  fmDefine.Visible = False
End Sub


                                                    219
Private Sub Command2_Click()     ' help frame loaded
  Load fmHelp
  fmHelp.Show
End Sub

Private Sub Command3_Click()      ' restart button
  fmBegin.Show
  fmDefine.Visible = False
  Set fmDefine = Nothing
End Sub

Private Sub Command4_Click()     ' previous button
  fmBegin.Show
  fmDefine.Visible = False
End Sub

Private Sub Command5_Click()      ' last button
  Set fmCEem = Nothing
  Set fmCEex = Nothing
  Set fmCEsm = Nothing
  Set fmCEst = Nothing
  Set fmCEwt = Nothing

  Set fmFCem = Nothing
  Set fmFCex = Nothing
  Set fmFCsm = Nothing
  Set fmFCst = Nothing
  Set fmFCwt = Nothing

  Set fmFSem = Nothing
  Set fmFSex = Nothing
  Set fmFSsm = Nothing
  Set fmFSst = Nothing
  Set fmFSwt = Nothing

  If chFS.Value = True Then    ' feng shui
     fmFSst.FSstLoad = 1
     Load fmFSsm
     fmFSsm.Visible = True
     fmDefine.Visible = False
  ElseIf chFC.Value = True Then ' integrated method
     fmFCst.FCstLoad = 1
     Load fmFCsm
     fmFCsm.Visible = True
     fmDefine.Visible = False
  ElseIf chCE.Value = True Then ' contemporary
     fmCEst.CEstLoad = 1
     Load fmCEsm
     fmCEsm.Visible = True
     fmDefine.Visible = False
  End If
End Sub

Private Sub Form_Load()

                                                       220
  ruleCE1 = "Climate: Comfort zone: 73-84°F (summer), 58-65°F (winter) at 50% humidity; Wind speed, direction,
and solar radiation will impact comfort zone. " & vbCrLf & vbCrLf
  ruleCE2 = "Geology: avoid class A of soil rating; good foundation support rate; low erosion potential; slope
class: A-C (0%-14%). " & vbCrLf & vbCrLf
  ruleCE3 = "Hydrology: avoid 100-year floodplain and wetland. " & vbCrLf & vbCrLf
  ruleCE4 = "Topography: slope < 16%; aspect: Northeast-northwest (22.5°-337.5°) (0° = North). " & vbCrLf &
vbCrLf
  ruleCE5 = "Vegetation: tree coverage impacts comfort zone. " & vbCrLf & vbCrLf

  ruleFS1 = "Climate: balanced temperature, radiation, and elevation; no wind or mild wind: < 8 mph. " & vbCrLf
& vbCrLf
  ruleFS2 = "Geology: soil color, texture, moisture, and weight: prefer sandy soil and clay, favor reinforced sand
soil. " & vbCrLf & vbCrLf
  ruleFS3 = "Hydrology: avoid floodplain and favor locations near bodies of water. " & vbCrLf & vbCrLf
  ruleFS4 = "Topography: slope < 14%; aspect: East-southeast (67.5°-247.5°) (0° = North). " & vbCrLf & vbCrLf
  ruleFS5 = "Vegetation: tree coverage indicates good sites. " & vbCrLf & vbCrLf

  ruleFC1 = "Climate: Comfort zone: 73-84°F (summer), 58-65°F (winter) at 50% humidity; wind speed < 8 mph;
impacts from radiation. " & vbCrLf & vbCrLf
  ruleFC2 = "Geology: prefer sandy soil and clay, favor reinforced sand soil; avoid class A of soil rating and fall
into good foundation support rate and low erosion potential areas. " & vbCrLf & vbCrLf
  ruleFC3 = "Hydrology: avoid 100-year floodplain and wetland, and favor locations near bodies of water. " &
vbCrLf & vbCrLf
  ruleFC4 = "Topography: slope < 14%; aspect: East-southeast (67.5°-247.5°) (0° = North). " & vbCrLf & vbCrLf
  ruleFC5 = "Vegetation: tree coverage indicates good sites. " & vbCrLf & vbCrLf
End Sub

'Form fmFCem
''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Option Explicit
Public g_ActiveLayer As Object
Public strMapUnits As String
Private collGtextStrings As New VBA.Collection
Private collGtextPoints As New VBA.Collection
Private symGtext As New mapobjects2.TextSymbol
'Private m_mapTip As New clsMapTip
Private dropValid As Boolean
Private BarState As String

Private Const MIN_LEGEND_WIDTH = 350
Private Const INCH2FEET = 12
Private Const INCH2METERS = 39.37
Private Const INCH2DEGREES = 4322893.46

' BUTTON BAR FOR "DISPLAY" TOOLS
Private Sub barDisplay_ButtonClick(ByVal Button As Button)
 Dim bKey As String
 bKey = Button.Key
 Call doTask(bKey)
 BarState = bKey
End Sub

Sub InitializeMap()
 Dim dc As New DataConnection

                                                           221
Dim layer As MapLayer
dc.Database = "C:\final"

If dc.Connect Then
 If fmFCex.FCexLoad = 1 Or fmFCwt.FCwtLoad = 1 Then         ' expert settings
    If fmFCwt.Option3.Value = False Then
       Select Case fmFCex.ac
       Case "1"
         Set layer = New MapLayer
         layer.GeoDataset = dc.FindGeoDataset("wind")
         MapDisp.Layers.Add layer
         layer.Visible = False
       Case "2"
         Set layer = New MapLayer
         layer.GeoDataset = dc.FindGeoDataset("call")
         MapDisp.Layers.Add layer
         layer.Visible = False
       Case "3"
         Set layer = New MapLayer
         layer.GeoDataset = dc.FindGeoDataset("aClimate")
         MapDisp.Layers.Add layer
         layer.Visible = False
       End Select
    End If

   If fmFCwt.Option6.Value = False Then
      Select Case fmFCex.ag
      Case "1"
        Set layer = New MapLayer
        layer.GeoDataset = dc.FindGeoDataset("soil")
        MapDisp.Layers.Add layer
        layer.Visible = False
      Case "2"
        Set layer = New MapLayer
        layer.GeoDataset = dc.FindGeoDataset("erosion")
        MapDisp.Layers.Add layer
        layer.Visible = False
      Case "3"
        Set layer = New MapLayer
        layer.GeoDataset = dc.FindGeoDataset("geo")
        MapDisp.Layers.Add layer
        layer.Visible = False
      End Select
   End If

   If fmFCwt.Option9.Value = False Then
      Select Case fmFCex.ah
      Case "1"
        Set layer = New MapLayer
        layer.GeoDataset = dc.FindGeoDataset("flood")
        MapDisp.Layers.Add layer
        layer.Visible = False
      Case "2"
        Set layer = New MapLayer

                                                   222
      layer.GeoDataset = dc.FindGeoDataset("dwater")
      MapDisp.Layers.Add layer
      layer.Visible = False
    Case "3"
      Set layer = New MapLayer
      layer.GeoDataset = dc.FindGeoDataset("fhydro")
      MapDisp.Layers.Add layer
      layer.Visible = False
    End Select
  End If

  If fmFCwt.Option12.Value = False Then
     Select Case fmFCex.ss
     Case "1"
       Set layer = New MapLayer
       layer.GeoDataset = dc.FindGeoDataset("slope10")
       MapDisp.Layers.Add layer
       layer.Visible = False
     Case "2"
       Set layer = New MapLayer
       layer.GeoDataset = dc.FindGeoDataset("slope16")
       MapDisp.Layers.Add layer
       layer.Visible = False
     End Select

    Select Case fmFCex.ao
    Case "1"
      Set layer = New MapLayer
      layer.GeoDataset = dc.FindGeoDataset("e-s")
      MapDisp.Layers.Add layer
      layer.Visible = False
    Case "2"
      Set layer = New MapLayer
      layer.GeoDataset = dc.FindGeoDataset("se-sw")
      MapDisp.Layers.Add layer
      layer.Visible = False
    Case "3"
      Set layer = New MapLayer
      layer.GeoDataset = dc.FindGeoDataset("e-sw")
      MapDis p.Layers.Add layer
      layer.Visible = False
    End Select
  End If

  If fmDefine.ChVeg.Value = 1 And fmFCwt.Option15.Value = False Then
     Set layer = New MapLayer
     layer.GeoDataset = dc.FindGe oDataset("tree")
     MapDisp.Layers.Add layer
     layer.Visible = False
  End If
End If

Set layer = New MapLayer


                                                 223
  If fmFCex.FCexLoad = 1 Then
     layer.GeoDataset = dc.FindGeoDataset(fmFCex.mapName)
     MapDisp.Layers.Add layer
     layer.Visible = True
  ElseIf fmFCwt.FCwtLoad = 1 Then
     layer.GeoDataset = dc.FindGeoDataset(fmFCwt.mapName)
     MapDisp.Layers.Add layer
     layer.Visible = True
  End If
 Else
  MsgBox "The data could not be located."
  End ' exit the application
 End If
End Sub

Private Sub Command1_Click()    ' help
  fmHelp.Visible = True
  'fmFCem.Visible = False
End Sub

Private Sub Command3_Click()    ' restart
  fmBegin.Visible = True
  fmFCem.Visible = False
  Set fmFCem = Nothing
End Sub

Private Sub Command4_Click()    ' previous
  If fmFCex.FCexLoad = 1 Then
     fmFCex.Visible = True
     fmFCem.Visible = False
  End If

  If fmFCwt.FCwtLoad = 1 Then
     fmFCwt.Visible = True
     fmFCem.Visible = False
  End If

  Set fmFCem = Nothing
End Sub

Private Sub Form_Load()
  Dim Index As Long
  Index = legMapDisp.getActiveLayer
  If Index <> -1 Then
     MapDisp.Layers.Remove Index
     legMapDisp.LoadLegend 'Refresh legend
  End If

  InitializeMap

  'Link legend to the Map control
  legMapDisp.setMapSource MapDisp
  legMapDisp.LoadLegend True
  legMapDisp.ShowAllLegend

                                                 224
  legMapDisp.Active(0) = True
End Sub

Private Sub legMapDisp_AfterSetLayerVisible(Index As Integer, isVisible As Boolean)
  MapDisp.Refresh
End Sub

' MAP DISPLAY RELATED ACTIVITY
Private Sub mapDisp_AfterTrackingLayerDraw(ByVal hDC As StdOle.OLE_HANDLE)
Select Case BarState
Case "Graphics"
  MapDisp.MousePointer = moCross
Case "Spatial Select"
  MapDisp.MousePointer = moArrow
Case "Zoom in"
  MapDisp.MousePointer = moZoomIn
Case "Zoom out"
  MapDisp.MousePointer = moZoomOut
Case "Pan"
  MapDisp.MousePointer = moPan
Case "Identify"
  MapDisp.MousePointer = moIdentify
Case Else
  MapDisp.MousePointer = moDefault
End Select
End Sub


Public Sub doTask(buttonKey As String)
  Select Case buttonKey
  Case "Print"
   fmPrint.Show
  Case "Zoom in"
    MapDisp.MousePointer = moZoomIn
  Case "Zoom out"
    MapDisp.MousePointer = moZoomOut
  Case "Pan"
    MapDisp.MousePointer = moPan
  Case "Full extent"
   MapDisp.Extent = MapDisp.FullExtent
  End Select
End Sub

Private Sub MapDisp_DragFiles(ByVal fileNames As Object, ByVal X As Single, ByVal Y As Single, ByVal state
As Integer, dropValid As Boolean)
   Dim dcx As New mapobjects2.DataConnection
   Dim shpfile As Variant
   Dim i As Integer
   Dim ml As mapobjects2.MapLayer
   shpfile = (Dir(fileNames.Item(0), vbDirectory))
   shpfile = CStr(Left(shpfile, Len(shpfile) - 4))

   dcx.Database = Left(fileNames.Item(0), Len(fileNames.Item(0)) - Len(shpfile) - 5)
   If dcx.Connect Then

                                                       225
 For i = 0 To fileNames.Count - 1
  Set ml = New mapobjects2.MapLayer
  shpfile = Dir(fileNames.Item(i), vbDirectory)
  shpfile = CStr(Left(shpfile, Len(shpfile) - 4))
  Set ml.GeoDataset = dcx.FindGeoDataset(shpfile)
  MapDisp.Layers.Add ml
  legMapDisp.LoadLegend
 Next i

 'prepare collections to sort layers
 Dim ptcoll As New Collection
 Dim linecoll As New Collection
 Dim polycoll As New Collection
 Dim imagecoll As New Collection

 For i = 0 To MapDisp.Layers.Count - 1
  If MapDisp.Layers(i).LayerType = moImageLayer Then
     imagecoll.Add MapDisp.Layers(i)
  ElseIf MapDisp.Layers(i).LayerType = moMapLayer Then
   Select Case MapDisp.Layers(i).shapeType
     Case moShapeTypePoint
      ptcoll.Add MapDisp.Layers(i)
     Case moShapeTypeLine
      linecoll.Add MapDisp.Layers(i)
     Case moShapeTypePolygon
      polycoll.Add MapDisp.Layers(i)
   End Select
  End If
 Next i
 MapDisp.Layers.Clear

 'add all the layers back in sorted by type
 Dim p As mapobjects2.MapLayer
 For Each p In polycoll
   MapDisp.Layers.Add p
 Next p

 Dim l As mapobjects2.MapLayer
 For Each l In linecoll
  MapDisp.Layers.Add l
 Next l

 For Each p In ptcoll
  MapDisp.Layers.Add p
 Next p

Dim im As mapobjects2.ImageLayer
For Each im In imagecoll
 MapDisp.Layers.Add im
Next im

End If
MapDisp.Extent = MapDisp.FullExtent
MapDisp.Refresh

                                                226
End Sub

Private Sub mapDisp_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
 'This procedure invokes the active map tool; zoom in, zoom out, pan, or other.
 Dim curRectangle As Rectangle

  'Zoom in button was pushed
  If barDisplay.Buttons("Zoom in").Value = 1 Then
   Set curRectangle = MapDisp.TrackRectangle
   Set MapDisp.Extent = curRectangle

  'Zoom out button was pushed
  ElseIf barDisplay.Buttons("Zoom out").Value = 1 Then
   Dim Loc As New Point
   Set Loc = MapDisp.ToMapPoint(X, Y)

    Dim MapWidth As Double, MapHeight As Double
    Set curRectangle = MapDisp.Extent
    MapWidth = MapDisp.Extent.Width
    MapHeight = MapDisp.Extent.Height
    curRectangle.Right = Loc.X + MapWidth
    curRectangle.Left = Loc.X - MapWidth
    curRectangle.Top = Loc.Y + MapHeight
    curRectangle.Bottom = Loc.Y - MapHeight
    Set MapDisp.Extent = curRectangle

 'Pan button
 ElseIf barDisplay.Buttons("Pan").Value = 1 Then
  MapDisp.Pan
 End If
End Sub

'Form fmFCex
''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Option Explicit
Public mapSelect As Integer
Public FCexLoad As Integer
Public ac As String
Public ag As String
Public ah As String
Public ss As String
Public ao As String
Public av As String
Public mapName As String

Private Sub checkOptions()
  If fmDefine.ChClimate.Value = 0 Then
     ac = "A"
  ElseIf fmDefine.ChClimate.Value = 1 Then
     If Option1.Value = True Then
        ac = 1
     ElseIf Option2.Value = True Then
        ac = 2
     ElseIf Option3.Value = True Then

                                                           227
    ac = 3
 End If
End If

If fmDefine.ChGeology.Value = 0 Then
   ag = "A"
ElseIf fmDefine.ChGeology.Value = 1 Then
   If Option4.Value = True Then
      ag = 1
   ElseIf Option5.Value = True Then
      ag = 2
   ElseIf Option6.Value = True Then
      ag = 3
   End If
End If

If fmDefine.ChHydro.Value = 0 Then
   ah = "A"
ElseIf fmDefine.ChHydro.Value = 1 Then
   If Option7.Value = True Then
      ah = 1
   ElseIf Option8.Value = True Then
      ah = 2
   ElseIf Option9.Value = True Then
      ah = 3
   End If
End If

If fmDefine.ChTopo.Value = 0 Then
   ss = "A"
   ao = "A"
ElseIf fmDefine.ChTopo.Value = 1 Then
   If SLselect.ListIndex = 1 Then
      ss = 2
   Else
      ss = 1
   End If

  If Check4.Value = 0 Then
     ao = 1
  ElseIf Check1.Value = 0 Then
     ao = 2
  ElseIf Check1.Value = 1 And Check4.Value = 1 Then
     ao = 3
  End If
End If

If fmDefine.ChVeg.Value = 0 Then
   av = "A"
ElseIf fmDefine.ChVeg.Value = 1 Then
   If Option10.Value = True Then
      av = 1
   End If
End If

                                                 228
  mapName = "A" & ac & ag & ah & ss & ao & av
End Sub

Private Sub Check4_Click()
  If Check1.Value = 0 Then
     Check4.Value = 1
  End If
End Sub
Private Sub Check3_Click()
     Check3.Value = 1
End Sub
Private Sub Check2_Click()
     Check2.Value = 1
End Sub
Private Sub Check1_Click()
  If Check4.Value = 0 Then
     Check1.Value = 1
  End If
End Sub

Private Sub Command1_Click()      ' help frame loaded
  Load fmHelp
  fmHelp.Show
End Sub

Private Sub Command2_Click()      ' switch to standard settings
  fmFCst.Visible = True
  fmDefine.standBt.Value = True
  fmFCex.Visible = False
  'Set fmCEex = Nothing
End Sub

Private Sub Command3_Click()      ' restart button
  fmBegin.Show
  fmFCex.Visible = False
  Set fmDefine = Nothing
  Set fmFCex = Nothing
End Sub

Private Sub Command4_Click()      ' previous button
  fmDefine.Show
  fmFCex.Visible = False
  Set fmFCex = Nothing
End Sub

Private Sub Command5_Click()      ' last button
  checkOptions
  Load fmFCem
  fmFCem.Visible = True
  fmFCex.Visible = False
End Sub

Private Sub Command6_Click()      ' next button

                                                      229
  checkOptions
  Load fmCEem
  fmFCem.Visible = True
  fmFCex.Visible = False
End Sub

Private Sub Form_Load()
  FCexLoad = 1
  If fmDefine.ChClimate.Value = 0 Then
     Frame1.Enabled = False
     Option1.Enabled = False
     Option2.Enabled = False
     Option3.Enabled = False
  End If
  If fmDefine.ChGeology.Value = 0 Then
     Frame2.Enabled = False
     Option4.Enabled = False
     Option5.Enabled = False
     Option6.Enabled = False
  End If
  If fmDefine.ChHydro.Value = 0 Then
     Frame3.Enabled = False
     Option7.Enabled = False
     Option8.Enabled = False
     Option9.Enabled = False
  End If
  If fmDefine.ChTopo.Value = 0 Then
     Frame4.Enabled = False
     Check1.Enabled = False
     Check2.Enabled = False
     Check3.Enabled = False
     Check4.Enabled = False
     Check5.Enabled = False
     SLselect.Enabled = False
  End If
  If fmDefine.ChVeg.Value = 0 Then
     Frame5.Enabled = False
     Option10.Enabled = False
  End If
End Sub


'Form fmFCsm
''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Option Explicit

Public g_ActiveLayer As Object
Public strMapUnits As String

Private collGtextStrings As New VBA.Collection
Private collGtextPoints As New VBA.Collection
Private symGtext As New mapobjects2.TextSymbol
'Private m_mapTip As New clsMapTip
Private dropValid As Boolean

                                                           230
Private BarState As String

Private Const MIN_LEGEND_WIDTH = 350
Private Const INCH2FEET = 12
Private Const INCH2METERS = 39.37
Private Const INCH2DEGREES = 4322893.46

' BUTTON BAR FOR "DISPLAY" TOOLS
Private Sub barDisplay_ButtonClick(ByVal Button As Button)
 Dim bKey As String
 bKey = Button.Key
 Call doTask(bKey)
 BarState = bKey
End Sub

Sub InitializeMap()

 Dim dc As New DataConnection
 Dim layer As MapLayer
 dc.Database = "C:\final"

 If dc.Connect Then

  Set layer = New MapLayer
  layer.GeoDataset = dc.FindGeoDataset("aClimate")
  MapDisp.Layers.Add layer
  layer.Visible = False

  Set layer = New MapLayer
  layer.GeoDataset = dc.FindGeoDataset("geo")
  MapDisp.Layers.Add layer
  layer.Visible = False

  Set layer = New MapLayer
  layer.GeoDataset = dc.FindGeoDataset("fhydro")
  MapDisp.Layers.Add layer
  layer.Visible = False

  Set layer = New MapLayer
  layer.GeoDataset = dc.FindGeoDataset("slope10")
  MapDisp.Layers.Add layer
  layer.Visible = False

  Set layer = New MapLayer
  layer.GeoDataset = dc.FindGeoDataset("e-sw")
  MapDisp.Layers.Add layer
  layer.Visible = False

  Set layer = New MapLayer
  layer.GeoDataset = dc.FindGeoDataset("tree")
  MapDisp.Layers.Add layer
  layer.Visible = False

  Set layer = New MapLayer

                                                     231
  layer.GeoDataset = dc.FindGeoDataset("A333131")
  MapDisp.Layers.Add layer
  layer.Visible = True

 Else
  MsgBox "The data could not be located."
  End ' exit the application
 End If
End Sub

Private Sub Command1_Click()
  fmHelp.Visible = True
  'fmResult.Visible = False
End Sub

Private Sub Command3_Click()
  fmBegin.Visible = True
  fmFCsm.Visible = False
End Sub

Private Sub Command4_Click()
  fmFCst.Visible = True
  fmFCsm.Visible = False
End Sub

Private Sub Form_Load()
  Dim Index As Long
  Index = legMapDisp.getActiveLayer
  If Index <> -1 Then
     MapDisp.Layers.Remove Index
     legMapDisp.LoadLegend 'Refresh legend
  End If

  InitializeMap

  'Link legend to the Map control
  legMapDisp.setMapSource MapDisp
  legMapDisp.LoadLegend True
  legMapDisp.ShowAllLegend
  legMapDisp.Active(0) = True
End Sub


Private Sub legMapDisp_AfterSetLayerVisible(Index As Integer, isVisible As Boolean)
  MapDisp.Refresh
End Sub

' MAP DISPLAY RELATED ACTIVITY
Private Sub mapDisp_AfterTrackingLayerDraw(ByVal hDC As StdOle.OLE_HANDLE)
Select Case BarState
Case "Graphics"
  MapDisp.MousePointer = moCross
Case "Spatial Select"
  MapDisp.MousePointer = moArrow

                                                    232
Case "Zoom in"
  MapDisp.MousePointer = moZoomIn
Case "Zoom out"
  MapDisp.MousePointer = moZoomOut
Case "Pan"
  MapDisp.MousePointer = moPan
Case "Identify"
  MapDisp.MousePointer = moIdentify
Case Else
  MapDisp.MousePointer = moDefault
End Select
End Sub

Public Sub doTask(buttonKey As String)
  'This block examines the return key from the toolbar or menu
  'and performs the requested action.
  Select Case buttonKey
  Case "Print"
    fmPrint.Show
  Case "Zoom in"
     MapDisp.MousePointer = moZoomIn
  Case "Zoom out"
     MapDisp.MousePointer = moZoomOut
  Case "Pan"
     MapDisp.MousePointer = moPan
  Case "Full extent"
    MapDisp.Extent = MapDisp.FullExtent
  End Select
End Sub

Private Sub MapDisp_DragFiles(ByVal fileNames As Object, ByVal X As Single, ByVal Y As Single, ByVal state
As Integer, dropValid As Boolean)
    Dim dcx As New mapobjects2.DataConnection
    Dim shpfile As Variant
    Dim i As Integer
    Dim ml As mapobjects2.MapLayer
    shpfile = (Dir(fileNames.Item(0), vbDirectory))
    shpfile = CStr(Left(shpfile, Len(shpfile) - 4))

   dcx.Database = Left(fileNames.Item(0), Len(fileNames.Item(0)) - Len(shpfile) - 5)
   If dcx.Connect Then
    For i = 0 To fileNames.Count - 1
      Set ml = New mapobjects2.MapLayer
      shpfile = Dir(fileNames.Item(i), vbDirectory)
      shpfile = CStr(Left(shpfile, Len(shpfile) - 4))
      Set ml.GeoDataset = dcx.FindGeoDataset(shpfile)
      MapDisp.Layers.Add ml
      legMapDisp.LoadLegend
    Next i

    'prepare collections to sort layers
    Dim ptcoll As New Collection
    Dim linecoll As New Collection
    Dim polycoll As New Collection

                                                       233
    Dim imagecoll As New Collection

    For i = 0 To MapDisp.Layers.Count - 1
     If MapDisp.Layers(i).LayerType = moImageLayer Then
        imagecoll.Add MapDisp.Layers(i)
     ElseIf MapDisp.Layers(i).LayerType = moMapLayer Then
      Select Case MapDisp.Layers(i).shapeType
        Case moShapeTypePoint
         ptcoll.Add MapDisp.Layers(i)
        Case moShapeTypeLine
         linecoll.Add MapDisp.Layers(i)
        Case moShapeTypePolygon
         polycoll.Add MapDisp.Layers(i)
      End Select
     End If
    Next i
    MapDisp.Layers.Clear

    'add all the layers back in sorted by type
    Dim p As mapobjects2.MapLayer
    For Each p In polycoll
      MapDisp.Layers.Add p
    Next p

    Dim l As mapobjects2.MapLayer
    For Each l In linecoll
     MapDisp.Layers.Add l
    Next l

    For Each p In ptcoll
     MapDisp.Layers.Add p
    Next p

    Dim im As mapobjects2.ImageLayer
    For Each im In imagecoll
     MapDisp.Layers.Add im
    Next im

   End If
   MapDisp.Extent = MapDisp.FullExtent
   MapDisp.Refresh
End Sub

Private Sub mapDisp_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
 'This procedure invokes the active map tool; zoom in, zoom out, pan, or other.
 Dim curRectangle As Rectangle

 'Zoom in button was pushed
 If barDisplay.Buttons("Zoom in").Value = 1 Then
  Set curRectangle = MapDisp.TrackRectangle
  Set MapDisp.Extent = curRectangle

 'Zoom out button was pushed
 ElseIf barDisplay.Buttons("Zoom out").Value = 1 Then

                                                   234
    Dim Loc As New Point
    Set Loc = MapDisp.ToMapPoint(X, Y)
    'We calculate the full width and height. Adding and substracting
    'the full values from Loc has the effect of zooming out by a factor of 2.
    Dim MapWidth As Double, MapHeight As Double
    Set curRectangle = MapDisp.Extent
    MapWidth = MapDisp.Extent.Width
    MapHeight = MapDisp.Extent.Height
    curRectangle.Right = Loc.X + MapWidth
    curRectangle.Left = Loc.X - MapWidth
    curRectangle.Top = Loc.Y + MapHeight
    curRectangle.Bottom = Loc.Y - MapHeight
    Set MapDisp.Extent = curRectangle

 'Pan button
 ElseIf barDisplay.Buttons("Pan").Value = 1 Then
  MapDisp.Pan
 End If
End Sub

'Form fmFCst
''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Option Explicit
Public FCstLoad As Integer

Private Sub Command1_Click()                               ' help frame loaded
  Load fmHelp
  fmHelp.Show
End Sub

Private Sub Command2_Click()                               ' switch to expert settings
  fmFCex.Visible = True
  fmFCst.Visible = False
End Sub

Private Sub Command3_Click()                               ' restart button
  fmBegin.Visible = True
  fmFCst.Visible = False
  Set fmDefine = Nothing
  Set fmFCst = Nothing
End Sub

Private Sub Command4_Click()                               ' previous button
  fmDefine.Visible = True
  fmFCst.Visible = False
  Set fmFCst = Nothing
End Sub

Private Sub Command5_Click()                               ' last button
  Load fmFCsm
  fmFCsm.Visible = True
  fmFCst.Visible = False
End Sub


                                                                               235
Private Sub Command6_Click()                    ' next button
  Load fmFCsm
  fmFCsm.Visible = True
  fmFCst.Visible = False
End Sub

Private Sub Form_Load()
  FCstLoad = 1

  ' Standard contemporary setting
  If fmDefine.ChClimate.Value = 1 Then
     Label2.Caption = fmDefine.ruleFC1
  End If
  If fmDefine.ChGeology.Value = 1 Then
     Label3.Caption = fmDefine.ruleFC2
  End If
  If fmDefine.ChHydro.Value = 1 Then
     Label4.Caption = fmDefine.ruleFC3
  End If
  If fmDefine.ChTopo.Value = 1 Then
     Label5.Caption = fmDefine.ruleFC4
  End If
  If fmDefine.ChVeg.Value = 1 Then
     Label6.Caption = fmDefine.ruleFC5
  End If

  Label2.Visible = False
  Label4.Visible = False
  Label3.Visible = False
  Label5.Visible = False
  Label6.Visible = False
  Label7.Caption = Label2.Caption + Label3.Caption + Label4.Caption + Label5.Caption + Label6.Caption
End Sub

'Form fmFCwt
''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Option Explicit
Public mapSelect As Integer
Public FCwtLoad As Integer
Private ac As String
Private ag As String
Private ah As String
Private ss As String
Private ao As String
Private av As String
Public mapName As String
Private Sub checkOptions()                               ' pass user selections to map names
      If fmDefine.ChClimate.Value = 0 Then
            ac = "A"
      ElseIf fmDefine.ChClimate.Value = 1 Then
            If Option1.Value = True Then
                  ac = "B"
            ElseIf Option2.Value = True Then
                  ac = 3

                                                                     236
  ElseIf Option3.Value = True Then
    ac = "A"
  End If
End If

If fmDefine.ChGeology.Value = 0 Then
   ag = "A"
ElseIf fmDefine.ChGeology.Value = 1 Then
   If Option4.Value = True Then
      ag = "B"
   ElseIf Option5.Value = True Then
      ag = 3
   ElseIf Option6.Value = True Then
      ag = "A"
   End If
End If

If fmDefine.ChHydro.Value = 0 Then
   ah = "A"
ElseIf fmDefine.ChHydro.Value = 1 Then
   If Option7.Value = True Then
      ah = "B"
   ElseIf Option8.Value = True Then
      ah = 3
   ElseIf Option9.Value = True Then
      ah = "A"
   End If
End If

If fmDefine.ChTopo.Value = 0 Then
   ss = "A"
   ao = "A"
ElseIf fmDefine.ChTopo.Value = 1 Then
   If Option10.Value = True Then
      ss = "B"
      ao = "B"
   ElseIf Option11.Value = True Then
      ss = 1
      ao = 3
   ElseIf Option12.Value = True Then
      ss = "A"
      ao = "A"
   End If
End If

If fmDefine.ChVeg.Value = 0 Then
   av = "A"
ElseIf fmDefine.ChVeg.Value = 1 Then
   If Option13.Value = True Then
      av = "B"
   ElseIf Option14.Value = True Then
      av = 1
   ElseIf Option15.Value = True Then
      av = "A"

                                           237
    End If
  End If

  mapName = "A" & ac & ag & ah & ss & ao & av

End Sub
Private Sub Command1_Click()        ' help frame loaded
  Load fmHelp
  fmHelp.Show
End Sub

Private Sub Command2_Click()        ' switch to standard settings
  fmFCst.Visible = True
  fmFCwt.Visible = False
  Set fmFCwt = Nothing
End Sub

Private Sub Command3_Click()        ' restart button
  fmBegin.Show
  fmFCwt.Visible = False
  Set fmDefine = Nothing
  Set fmFCwt = Nothing
End Sub

Private Sub Command4_Click()        ' previous button
  fmDefine.Show
  fmFCwt.Visible = False
  Set fmFCwt = Nothing
End Sub

Private Sub Command5_Click()        ' last button
  checkOptions
  Load fmFCem
  fmFCem.Visible = True
  fmFCwt.Visible = False
End Sub

Private Sub Command6_Click()       ' next button
  checkOptions
  Load fmFCem
  fmFCem.Visible = True
  fmFCwt.Visible = False
End Sub
Private Sub Command8_Click()        ' switch to expert settings
  Load fmFCex
  fmFCex.Visible = True
  fmFCwt.Visible = False
End Sub

Private Sub Form_Load()
  FCwtLoad = 1

  If fmDefine.ChClimate.Value = 0 Then
     Frame1.Enabled = False

                                                        238
     Option1.Enabled = False
     Option2.Enabled = False
     Option3.Enabled = False
  End If
  If fmDefine.ChGeology.Value = 0 Then
     Frame2.Enabled = False
     Option4.Enabled = False
     Option5.Enabled = False
     Option6.Enabled = False
  End If
  If fmDefine.ChHydro.Value = 0 Then
     Frame3.Enabled = False
     Option7.Enabled = False
     Option8.Enabled = False
     Option9.Enabled = False
  End If
  If fmDefine.ChTopo.Value = 0 Then
     Frame4.Enabled = False
     Option10.Enabled = False
     Option11.Enabled = False
     Option12.Enabled = False
  End If
  If fmDefine.ChVeg.Value = 0 Then
     Frame5.Enabled = False
     Option13.Enabled = False
     Option14.Enabled = False
     Option15.Enabled = False
  End If
End Sub

'Form fmFSem
''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Option Explicit
Public g_ActiveLayer As Object
Public strMapUnits As String
Private collGtextStrings As New VBA.Collection
Private collGtextPoints As New VBA.Collection
Private symGtext As New mapobjects2.TextSymbol
'Private m_mapTip As New clsMapTip
Private dropValid As Boolean
Private BarState As String

Private Const MIN_LEGEND_WIDTH = 350
Private Const INCH2FEET = 12
Private Const INCH2METERS = 39.37
Private Const INCH2DEGREES = 4322893.46

' BUTTON BAR FOR "DISPLAY" TOOLS
Private Sub barDisplay_ButtonClick(ByVal Button As Button)
 Dim bKey As String
 bKey = Button.Key
 Call doTask(bKey)
 BarState = bKey
End Sub

                                                           239
Sub InitializeMap()

 Dim dc As New DataConnection
 Dim layer As MapLayer
 dc.Database = "C:\final"

 If dc.Connect Then
  If fmFSex.FSexLoad = 1 Or fmFSwt.FSwtLoad = 1 Then         ' expert settings
     If fmDefine.ChClimate.Value = 1 And fmFSwt.Option3.Value = False Then
        Set layer = New MapLayer
        layer.GeoDataset = dc.FindGeoDataset("wind")
        MapDisp.Layers.Add layer
        layer.Visible = False
     End If

    If fmFSwt.Option6.Value = False Then
       Select Case fmFSex.fg
       Case "1"
         Set layer = New MapLayer
         layer.GeoDataset = dc.FindGeoDataset("soil")
         MapDisp.Layers.Add layer
         layer.Visible = False
       Case "2"
         Set layer = New MapLayer
         layer.GeoDataset = dc.FindGeoDataset("erosion")
         MapDisp.Layers.Add layer
         layer.Visible = False
       Case "3"
         Set layer = New MapLayer
         layer.GeoDataset = dc.FindGeoDataset("geo")
         MapDisp.Layers.Add layer
         layer.Visible = False
       End Select
    End If

    If fmFSwt.Option9.Value = False Then
       Select Case fmFSex.fh
       Case "1"
         Set layer = New MapLayer
         layer.GeoDataset = dc.FindGeoDataset("flood")
         MapDisp.Layers.Add layer
         layer.Visible = False
       Case "2"
         Set layer = New MapLayer
         layer.GeoDataset = dc.FindGeoDataset("dwater")
         MapDisp.Layers.Add layer
         layer.Visible = False
       Case "3"
         Set layer = New MapLayer
         layer.GeoDataset = dc.FindGeoDataset("fhydro")
         MapDisp.Layers.Add layer
         layer.Visible = False
       End Select

                                                     240
  End If

  If fmFSwt.Option12.Value = False Then
     Select Case fmFSex.fs
     Case "1"
       Set layer = New MapLayer
       layer.GeoDataset = dc.FindGeoDataset("slope10")
       MapDisp.Layers.Add layer
       layer.Visible = False
     Case "2"
       Set layer = New MapLayer
       layer.GeoDataset = dc.FindGeoDataset("slope16")
       MapDisp.Layers.Add layer
       layer.Visible = False
     End Select

    Select Case fmFSex.fo
    Case "1"
      Set layer = New MapLayer
      layer.GeoDataset = dc.FindGeoDataset("e-s")
      MapDisp.Layers.Add layer
      layer.Visible = False
    Case "2"
      Set layer = New MapLayer
      layer.GeoDataset = dc.FindGeoDataset("se-sw")
      MapDisp.Layers.Add layer
      layer.Visible = False
    Case "3"
      Set layer = New MapLayer
      layer.GeoDataset = dc.FindGeoDataset("e-sw")
      MapDisp.Layers.Add layer
      layer.Visible = False
    End Select
  End If

  If fmDefine.ChVeg.Value = 1 And fmFSwt.Option15.Value = False Then
     Set layer = New MapLayer
     layer.GeoDataset = dc.FindGeoDataset("tree")
     MapDisp.Layers.Add layer
     layer.Visible = False
  End If

End If

Set layer = New MapLayer

If fmFSex.FSexLoad = 1 Then
   layer.GeoDataset = dc.FindGeoDataset(fmFSex.mapName)
   MapDisp.Layers.Add layer
   layer.Visible = True
ElseIf fmFSwt.FSwtLoad = 1 Then
   layer.GeoDataset = dc.FindGeoDataset(fmFSwt.mapName)
   MapDisp.Layers.Add layer
   layer.Visible = True

                                                 241
  End If

 Else
  MsgBox "The data could not be located."
  End ' exit the application
 End If
End Sub

Private Sub Command1_Click()       ' load help frame
  fmHelp.Visible = True
End Sub

Private Sub Command3_Click()        ' restart button
  fmBegin.Visible = True
  fmFSem.Visible = False
  Set fmFSem = Nothing
End Sub

Private Sub Command4_Click()      ' previous button
  If fmFSex.FSexLoad = 1 Then
     fmFSex.Visible = True
  ElseIf fmFSwt.FSwtLoad = 1 Then
     fmFSwt.Visible = True
  End If

  fmFSem.Visible = False
  Set fmFSem = Nothing
End Sub

Private Sub Form_Load()
  Dim Index As Long
  Index = legMapDisp.getActiveLayer
  If Index <> -1 Then
     MapDisp.Layers.Remove Index
     legMapDisp.LoadLegend 'Refresh legend
  End If

  InitializeMap

  'Link legend to the Map control
  legMapDisp.setMapSource MapDisp
  legMapDisp.LoadLegend True
  legMapDisp.ShowAllLegend
  legMapDisp.Active(0) = True
End Sub

Private Sub legMapDisp_AfterSetLayerVisible(Index As Integer, isVisible As Boolean)
  MapDisp.Refresh
End Sub

' MAP DISPLAY RELATED ACTIVITY
Private Sub mapDisp_AfterTrackingLayerDraw(ByVal hDC As StdOle.OLE_HANDLE)
Select Case BarState
Case "Graphics"

                                                       242
  MapDisp.MousePointer = moCross
Case "Spatial Select"
  MapDisp.MousePointer = moArrow
Case "Zoom in"
  MapDisp.MousePointer = moZoomIn
Case "Zoom out"
  MapDisp.MousePointer = moZoomOut
Case "Pan"
  MapDisp.MousePointer = moPan
Case "Identify"
  MapDisp.MousePointer = moIdentify
Case Else
  MapDisp.MousePointer = moDefault
End Select

End Sub

Public Sub doTask(buttonKey As String)
  Select Case buttonKey
  Case "Print"
   fmPrint.Show
  Case "Zoom in"
    MapDisp.MousePointer = moZoomIn
  Case "Zoom out"
    MapDisp.MousePointer = moZoomOut
  Case "Pan"
    MapDisp.MousePointer = moPan
  Case "Full extent"
   MapDisp.Extent = MapDisp.FullExtent
  End Select
End Sub

Private Sub MapDisp_DragFiles(ByVal fileNames As Object, ByVal X As Single, ByVal Y As Single, ByVal state
As Integer, dropValid As Boolean)
   Dim dcx As New mapobjects2.DataConnection
   Dim shpfile As Variant
   Dim i As Integer
   Dim ml As mapobjects2.MapLayer
   shpfile = (Dir(fileNames.Item(0), vbDirectory))
   shpfile = CStr(Left(shpfile, Len(shpfile) - 4))

   dcx.Database = Left(fileNames.Item(0), Len(fileNames.Item(0)) - Len(shpfile) - 5)
   If dcx.Connect Then
     For i = 0 To fileNames.Count - 1
      Set ml = New mapobjects2.MapLayer
      shpfile = Dir(fileNames.Item(i), vbDirectory)
      shpfile = CStr(Left(shpfile, Len(shpfile) - 4))
      Set ml.GeoDataset = dcx.FindGeoDataset(shpfile)
      MapDisp.Layers.Add ml
      legMapDisp.LoadLegend
    Next i

    'prepare collections to sort layers
    Dim ptcoll As New Collection

                                                       243
    Dim linecoll As New Collection
    Dim polycoll As New Collection
    Dim imagecoll As New Collection

    For i = 0 To MapDisp.Layers.Count - 1
     If MapDisp.Layers(i).LayerType = moImageLayer Then
        imagecoll.Add MapDisp.Layers(i)
     ElseIf MapDisp.Layers(i).LayerType = moMapLayer Then
      Select Case MapDisp.Layers(i).shapeType
        Case moShapeTypePoint
         ptcoll.Add MapDisp.Layers(i)
        Case moShapeTypeLine
         linecoll.Add MapDisp.Layers(i)
        Case moShapeTypePolygon
         polycoll.Add MapDisp.Layers(i)
      End Select
     End If
    Next i
    MapDisp.Layers.Clear

    'add all the layers back in sorted by type
    Dim p As mapobjects2.MapLayer
    For Each p In polycoll
      MapDisp.Layers.Add p
    Next p

    Dim l As mapobjects2.MapLayer
    For Each l In linecoll
     MapDisp.Layers.Add l
    Next l

    For Each p In ptcoll
     MapDisp.Layers.Add p
    Next p

    Dim im As mapobjects2.ImageLayer
    For Each im In imagecoll
     MapDisp.Layers.Add im
    Next im

   End If
   MapDisp.Extent = MapDisp.FullExtent
   MapDisp.Refresh
End Sub

Private Sub mapDisp_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
 'This procedure invokes the active map tool; zoom in, zoom out, pan, or other.
 Dim curRectangle As Rectangle

 'Zoom in button was pushed
 If barDisplay.Buttons("Zoom in").Value = 1 Then
  Set curRectangle = MapDisp.TrackRectangle
  Set MapDisp.Extent = curRectangle


                                                   244
  'Zoom out button was pushed
  ElseIf barDisplay.Buttons("Zoom out").Value = 1 Then
   Dim Loc As New Point
   Set Loc = MapDisp.ToMapPoint(X, Y)
   'calculate the full width and height. Adding and substracting
   'the full values from Loc has the effect of zooming out by a factor of 2.
   Dim MapWidth As Double, MapHeight As Double
   Set curRectangle = MapDisp.Extent
   MapWidth = MapDisp.Extent.Width
   MapHeight = MapDisp.Extent.Height
   curRectangle.Right = Loc.X + MapWidth
   curRectangle.Left = Loc.X - MapWidth
   curRectangle.Top = Loc.Y + MapHeight
   curRectangle.Bottom = Loc.Y - MapHeight
   Set MapDisp.Extent = curRectangle

 'Pan button
 ElseIf barDisplay.Buttons("Pan").Value = 1 Then
  MapDisp.Pan
 End If
End Sub

'Form fmFSex
''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Option Explicit
Public mapSelect As Integer
Public FSexLoad As Integer
Public fc As String
Public fg As String
Public fh As String
Public fs As String
Public fo As String
Public fv As String
Public mapName As String

Private Sub checkOptions()
  If fmDefine.ChClimate.Value = 0 Then
     fc = "A"
  ElseIf fmDefine.ChClimate.Value = 1 Then
     If Option1.Value = True Then
        fc = 1
     End If
  End If

    If fmDefine.ChGeology.Value = 0 Then
       fg = "A"
    ElseIf fmDefine.ChGeology.Value = 1 Then
       If Option2.Value = True Then
          fg = 1
       ElseIf Option3.Value = True Then
          fg = 2
       ElseIf Option4.Value = True Then
          fg = 3
       End If

                                                           245
  End If

  If fmDefine.ChHydro.Value = 0 Then
     fh = "A"
  ElseIf fmDefine.ChHydro.Value = 1 Then
     If Option5.Value = True Then
        fh = 1
     ElseIf Option6.Value = True Then
        fh = 2
     ElseIf Option7.Value = True Then
        fh = 3
     End If
  End If

  If fmDefine.ChTopo.Value = 0 Then
     fs = "A"
     fo = "A"
  ElseIf fmDefine.ChTopo.Value = 1 Then
     If SLselect.ListIndex = 1 Then
        fs = 2
     Else
        fs = 1
     End If

    If Check4.Value = 0 Then
       fo = 1
    ElseIf Check1.Value = 0 Then
       fo = 2
    ElseIf Check1.Value = 1 And Check4.Value = 1 Then
       fo = 3
    End If
  End If

  If fmDefine.ChVeg.Value = 0 Then
     fv = "A"
  ElseIf fmDefine.ChVeg.Value = 1 Then
     If Option8.Value = True Then
        fv = 1
     End If
  End If

  mapName = "f" & fc & fg & fh & fs & fo & fv
End Sub

Private Sub Check4_Click()
  If Check1.Value = 0 Then
     Check4.Value = 1
  End If
End Sub
Private Sub Check3_Click()
     Check3.Value = 1
End Sub
Private Sub Check2_Click()
     Check2.Value = 1

                                                   246
End Sub
Private Sub Check1_Click()
  If Check4.Value = 0 Then
     Check1.Value = 1
  End If
End Sub

Private Sub Command1_Click()       ' help frame loaded
  Load fmHelp
  fmHelp.Show
End Sub

Private Sub Command2_Click()       ' switch to standard settings
  fmFSst.Visible = True
  fmDefine.standBt.Value = True
  fmFSex.Visible = False
  'Set fmFSex = Nothing
End Sub

Private Sub Command3_Click()      ' restart button
  fmBegin.Show
  fmFSex.Visible = False
  Set fmDefine = Nothing
  Set fmFSex = Nothing
End Sub

Private Sub Command4_Click()       ' previous button
  fmDefine.Show
  fmFSex.Visible = False
  Set fmFSex = Nothing
End Sub

Private Sub Command5_Click()       ' last button
  checkOptions
  Load fmFSem
  fmFSem.Visible = True
  fmFSex.Visible = False
End Sub

Private Sub Command6_Click()       ' next button
  checkOptions
  Load fmFSem
  fmFSem.Visible = True
  fmFSex.Visible = False
End Sub

Private Sub Form_Load()
  FSexLoad = 1

  If fmDefine.ChClimate.Value = 0 Then
     Frame1.Enabled = False
     Option1.Enabled = False
  End If
  If fmDefine.ChGeology.Value = 0 Then

                                                       247
     Frame2.Enabled = False
     Option2.Enabled = False
     Option3.Enabled = False
     Option4.Enabled = False
  End If
  If fmDefine.ChHydro.Value = 0 Then
     Frame3.Enabled = False
     Option5.Enabled = False
     Option6.Enabled = False
     Option7.Enabled = False
  End If
  If fmDefine.ChTopo.Value = 0 Then
     Frame4.Enabled = False
     Check1.Enabled = False
     Check2.Enabled = False
     Check3.Enabled = False
     Check4.Enabled = False
     SLselect.Enabled = False
  End If
  If fmDefine.ChVeg.Value = 0 Then
     Frame5.Enabled = False
     Option8.Enabled = False
  End If
End Sub

'Form fmFSsm
''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Option Explicit

Public g_ActiveLayer As Object
Public strMapUnits As String

Private collGtextStrings As New VBA.Collection
Private collGtextPoints As New VBA.Collection
Private symGtext As New mapobjects2.TextSymbol
'Private m_mapTip As New clsMapTip
Private dropValid As Boolean
Private BarState As String

Private Const MIN_LEGEND_WIDTH = 350
Private Const INCH2FEET = 12
Private Const INCH2METERS = 39.37
Private Const INCH2DEGREES = 4322893.46

' BUTTON BAR FOR "DISPLAY" TOOLS
Private Sub barDisplay_ButtonClick(ByVal Button As Button)
 Dim bKey As String
 bKey = Button.Key
 Call doTask(bKey)
 BarState = bKey
End Sub

Sub InitializeMap()


                                                           248
 Dim dc As New DataConnection
 Dim layer As MapLayer
 dc.Database = "C:\final"

 If dc.Connect Then

    Set layer = New MapLayer
    layer.GeoDataset = dc.FindGeoDataset("wind")
    MapDisp.Layers.Add layer
    layer.Visible = False

    Set layer = New MapLayer
    layer.GeoDataset = dc.FindGeoDataset("geo")
    MapDisp.Layers.Add layer
    layer.Visible = False

    Set layer = New MapLayer
    layer.GeoDataset = dc.FindGeoDataset("fhydro")
    MapDisp.Layers.Add layer
    layer.Visible = False

    Set layer = New MapLayer
    layer.GeoDataset = dc.FindGeoDataset("slope10")
    MapDisp.Layers.Add layer
    layer.Visible = False

    Set layer = New MapLayer
    layer.GeoDataset = dc.FindGeoDataset("e-sw")
    MapDisp.Layers.Add layer
    layer.Visible = False

    Set layer = New MapLayer
    layer.GeoDataset = dc.FindGeoDataset("tree")
    MapDisp.Layers.Add layer
    layer.Visible = False

    Set layer = New MapLayer
    layer.GeoDataset = dc.FindGeoDataset("F133131")
    MapDisp.Layers.Add layer
    layer.Visible = True

 Else
  MsgBox "The data could not be located."
  End ' exit the application
 End If
End Sub

Private Sub Command1_Click()       ' load help frame
  fmHelp.Visible = True
End Sub

Private Sub Command3_Click()        ' restart button
  fmBegin.Visible = True
  fmFSem.Visible = False

                                                       249
  Set fmFSem = Nothing
End Sub

Private Sub Command4_Click()      ' previous button
  If fmFSex.FSexLoad = 1 Then
     fmFSex.Visible = True
  ElseIf fmFSwt.FSwtLoad = 1 Then
     fmFSwt.Visible = True
  End If

  fmFSem.Visible = False
  Set fmFSem = Nothing
End Sub

Private Sub Form_Load()
  Dim Index As Long
  Index = legMapDisp.getActiveLayer
  If Index <> -1 Then
     MapDisp.Layers.Remove Index
     legMapDisp.LoadLegend 'Refresh legend
  End If

  InitializeMap

  'Link legend to the Map control
  legMapDisp.setMapSource MapDisp
  legMapDisp.LoadLegend True
  legMapDisp.ShowAllLegend
  legMapDisp.Active(0) = True

End Sub

Private Sub legMapDisp_AfterSetLayerVisible(Index As Integer, isVisible As Boolean)
  MapDisp.Refresh
End Sub

' MAP DISPLAY RELATED ACTIVITY
Private Sub mapDisp_AfterTrackingLayerDraw(ByVal hDC As StdOle.OLE_HANDLE)
Select Case BarState
Case "Graphics"
  MapDisp.MousePointer = moCross
Case "Spatial Select"
  MapDisp.MousePointer = moArrow
Case "Zoom in"
  MapDisp.MousePointer = moZoomIn
Case "Zoom out"
  MapDisp.MousePointer = moZoomOut
Case "Pan"
  MapDisp.MousePointer = moPan
Case "Identify"
  MapDisp.MousePointer = moIdentify
Case Else
  MapDisp.MousePointer = moDefault
End Select

                                                      250
End Sub

Public Sub doTask(buttonKey As String)
  Select Case buttonKey
  Case "Print"
   fmPrint.Show
  Case "Zoom in"
    MapDisp.MousePointer = moZoomIn
  Case "Zoom out"
    MapDisp.MousePointer = moZoomOut
  Case "Pan"
    MapDisp.MousePointer = moPan
  Case "Full extent"
   MapDisp.Extent = MapDisp.FullExtent
  End Select
End Sub

Private Sub MapDisp_DragFiles(ByVal fileNames As Object, ByVal X As Single, ByVal Y As Single, ByVal state
As Integer, dropValid As Boolean)
   Dim dcx As New mapobjects2.DataConnection
   Dim shpfile As Variant
   Dim i As Integer
   Dim ml As mapobjects2.MapLayer
   shpfile = (Dir(fileNames.Item(0), vbDirectory))
   shpfile = CStr(Left(shpfile, Len(shpfile) - 4))

   dcx.Database = Left(fileNames.Item(0), Len(fileNames.Item(0)) - Len(shpfile) - 5)
   If dcx.Connect Then
    For i = 0 To fileNames.Count - 1
      Set ml = New mapobjects2.MapLayer
      shpfile = Dir(fileNames.Item(i), vbDirectory)
      shpfile = CStr(Left(shpfile, Len(shpfile) - 4))
      Set ml.GeoDataset = dcx.FindGeoDataset(shpfile)
      MapDisp.Layers.Add ml
      legMapDisp.LoadLegend
    Next i

    'prepare collections to sort layers
    Dim ptcoll As New Collection
    Dim linecoll As New Collection
    Dim polycoll As New Collection
    Dim imagecoll As New Collection

    For i = 0 To MapDisp.Layers.Count - 1
     If MapDisp.Layers(i).LayerType = moImageLayer Then
        imagecoll.Add MapDisp.Layers(i)
     ElseIf MapDisp.Layers(i).LayerType = moMapLayer Then
      Select Case MapDisp.Layers(i).shapeType
        Case moShapeTypePoint
         ptcoll.Add MapDisp.Layers(i)
        Case moShapeTypeLine
         linecoll.Add MapDisp.Layers(i)
        Case moShapeTypePolygon
         polycoll.Add MapDisp.Layers(i)

                                                       251
      End Select
     End If
    Next i
    MapDisp.Layers.Clear

    'add all the layers back in sorted by type
    Dim p As mapobjects2.MapLayer
    For Each p In polycoll
      MapDisp.Layers.Add p
    Next p

    Dim l As mapobjects2.MapLayer
    For Each l In linecoll
     MapDisp.Layers.Add l
    Next l

    For Each p In ptcoll
     MapDisp.Layers.Add p
    Next p

    Dim im As mapobjects2.ImageLayer
    For Each im In imagecoll
     MapDisp.Layers.Add im
    Next im

   End If
   MapDisp.Extent = MapDisp.FullExtent
   MapDisp.Refresh
End Sub

Private Sub mapDisp_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
 'This procedure invokes the active map tool; zoom in, zoom out, pan, or other.
 Dim curRectangle As Rectangle

 'Zoom in button was pushed
 If barDisplay.Buttons("Zoom in").Value = 1 Then
   Set curRectangle = MapDisp.TrackRectangle
  Set MapDisp.Extent = curRectangle

 'Zoom out button was pushed
 ElseIf barDisplay.Buttons("Zoom out").Value = 1 Then
  Dim Loc As New Point
  Set Loc = MapDisp.ToMapPoint(X, Y)
  'calculate the full width and height. Adding and substracting
  'the full values from Loc has the effect of zooming out by a factor of 2.
  Dim MapWidth As Double, MapHeight As Double
  Set curRectangle = MapDisp.Extent
  MapWidth = MapDisp.Extent.Width
  MapHeight = MapDisp.Extent.Height
  curRectangle.Right = Loc.X + MapWidth
  curRectangle.Left = Loc.X - MapWidth
  curRectangle.Top = Loc.Y + MapHeight
  curRectangle.Bottom = Loc.Y - MapHeight
  Set MapDisp.Extent = curRectangle

                                                        252
 'Pan button
 ElseIf barDisplay.Buttons("Pan").Value = 1 Then
  MapDisp.Pan
 End If
End Sub

'Form fmFSst
''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Option Explicit
Public FSstLoad As Integer

Private Sub Command1_Click()                               ' help frame loaded
  Load fmHelp
  fmHelp.Show
End Sub

Private Sub Command2_Click()                               ' switch to expert settings
  Load fmFSex
  fmFSex.Visible = True
  fmFSst.Visible = False
  Set fmFSst = Nothing
End Sub

Private Sub Command3_Click()                               ' restart button
  fmBegin.Visible = True
  fmFSst.Visible = False
  Set fmDefine = Nothing
  Set fmFSst = Nothing
End Sub

Private Sub Command4_Click()                               ' previous button
  fmDefine.Visible = True
  fmFSst.Visible = False
  Set fmFSst = Nothing
End Sub

Private Sub Command6_Click()                               ' last button
  Load fmFSsm
  fmFSsm.Visible = True
  fmFSst.Visible = False
End Sub

Private Sub Command7_Click()                               ' next button
  Load fmFSsm
  fmFSsm.Visible = True
  fmFSst.Visible = False
End Sub

Private Sub Form_Load()
  FSstLoad = 1

    ' Standard feng shui setting
    If fmDefine.ChClimate.Value = 1 Then

                                                                               253
       Label2.Caption = fmDefine.ruleFS1
    End If
    If fmDefine.ChGeology.Value = 1 Then
       Label3.Caption = fmDefine.ruleFS2
    End If
    If fmDefine.ChHydro.Value = 1 Then
       Label4.Caption = fmDefine.ruleFS3
    End If
    If fmDefine.ChTopo.Value = 1 Then
       Label5.Caption = fmDefine.ruleFS4
    End If
    If fmDefine.ChVeg.Value = 1 Then
       Label6.Caption = fmDefine.ruleFS5
    End If

  Label2.Visible = False
  Label4.Visible = False
  Label3.Visible = False
  Label5.Visible = False
  Label6.Visible = False
  Label7.Caption = Label2.Caption + Label3.Caption + Label4.Caption + Label5.Caption + Label6.Caption
End Sub

'Form fmFSwt
''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Option Explicit
Public mapSelect As Integer
Public FSwtLoad As Integer
Private fc As String
Private fg As String
Private fh As String
Private fs As String
Private fo As String
Private fv As String
Public mapName As String

Private Sub checkOptions()           ' pass user selections to map names
  If fmDefine.ChClimate.Value = 0 Then
     fc = "A"
  ElseIf fmDefine.ChClimate.Value = 1 Then
     If Option1.Value = True Then
        fc = "B"
     ElseIf Option2.Value = True Then
        fc = 1
     ElseIf Option3.Value = True Then
        fc = "A"
     End If
  End If

    If fmDefine.ChGeology.Value = 0 Then
       fg = "A"
    ElseIf fmDefine.ChGeology.Value = 1 Then
       If Option4.Value = True Then
          fg = "B"

                                                           254
    ElseIf Option5.Value = True Then
      fg = 3
    ElseIf Option6.Value = True Then
      fg = "A"
    End If
  End If

  If fmDefine.ChHydro.Value = 0 Then
     fh = "A"
  ElseIf fmDefine.ChHydro.Value = 1 Then
     If Option7.Value = True Then
        fh = "B"
     ElseIf Option8.Value = True Then
        fh = 3
     ElseIf Option9.Value = True Then
        fh = "A"
     End If
  End If

  If fmDefine.ChTopo.Value = 0 Then
     fs = "A"
     fo = "A"
  ElseIf fmDefine.ChTopo.Value = 1 Then
     If Option10.Value = True Then
        fs = "B"
        fo = "B"
     ElseIf Option11.Value = True Then
        fs = 1
        fo = 3
     ElseIf Option12.Value = True Then
        fs = "A"
        fo = "A"
     End If
  End If

  If fmDefine.ChVeg.Value = 0 Then
     fv = "A"
  ElseIf fmDefine.ChVeg.Value = 1 Then
     If Option13.Value = True Then
        fv = "B"
     ElseIf Option14.Value = True Then
        fv = 1
     ElseIf Option15.Value = True Then
        fv = "A"
     End If
  End If

  mapName = "f" & fc & fg & fh & fs & fo & fv
End Sub

Private Sub Command1_Click()       ' help frame loaded
  Load fmHelp
  fmHelp.Show
End Sub

                                                    255
Private Sub Command2_Click()       ' switch to standard settings
  fmFSst.Visible = True
  fmFSwt.Visible = False
  Set fmFSwt = Nothing
End Sub

Private Sub Command3_Click()       ' restart button
  fmBegin.Show
  fmFSwt.Visible = False
  Set fmDefine = Nothing
  Set fmFSwt = Nothing
End Sub

Private Sub Command4_Click()       ' previous button
  fmDefine.Show
  fmFSwt.Visible = False
  Set fmFSwt = Nothing
End Sub

Private Sub Command5_Click()       ' last button
  checkOptions
  Load fmFSem
  fmFSem.Visible = True
  fmFSwt.Visible = False
End Sub

Private Sub Command6_Click()       ' next button
  checkOptions
  Load fmFSem
  fmFSem.Visible = True
  fmFSwt.Visible = False
End Sub
Private Sub Command8_Click()       ' switch to expert settings
  Load fmFSex
  fmFSex.Visible = True
  fmFSwt.Visible = False
End Sub

Private Sub Form_Load()
  FSwtLoad = 1
  If fmDefine.ChClimate.Value = 0 Then
     Frame1.Enabled = False
     Option1.Enabled = False
     Option2.Enabled = False
     Option3.Enabled = False
  End If
  If fmDefine.ChGeology.Value = 0 Then
     Frame2.Enabled = False
     Option4.Enabled = False
     Option5.Enabled = False
     Option6.Enabled = False
  End If
  If fmDefine.ChHydro.Value = 0 Then

                                                       256
     Frame3.Enabled = False
     Option7.Enabled = False
     Option8.Enabled = False
     Option9.Enabled = False
  End If
  If fmDefine.ChTopo.Value = 0 Then
     Frame4.Enabled = False
     Option10.Enabled = False
     Option11.Enabled = False
     Option12.Enabled = False
  End If
  If fmDefine.ChVeg.Value = 0 Then
     Frame5.Enabled = False
     Option13.Enabled = False
     Option14.Enabled = False
     Option15.Enabled = False
  End If
End Sub

'Form fmPrint
''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Option Explicit
Private Sub Form_Load()
lblDefaultPrinter.Caption = Printer.DeviceName
sstPrint.Tab = 0

'Printing to fit the page will work whether or not
'the map units are defined on the MapProperties form.
'However, printing to scale will only work if the
'map units are known. Instruct the user if this is
'the case.

If fmCEem.strMapUnits <> "Unknown" Then
 lblMapUnits.Caption = "Your map units are currently set as " & _
       UCase(fmCEem.strMapUnits) & ". It is very important " & _
       "that this be correct for the map to print to the " & _
       "scale you expect."
 Else
 lblMapUnits.Caption = "Your map units are currently set as " & _
       UCase(fmCEem.strMapUnits) & ". Printing to scale " & _
       "cannot continue. Please set the correct map units " & _
       "in the Map Properties dialog."
 lblOneTo.Enabled = False
 lblIwant.Enabled = False
 txtRatioScale.Enabled = False
 cmdPrintNow(1).Enabled = False
End If

End Sub

Private Sub cmdPrintNow_Click(Index As Integer)

Select Case Index


                                                           257
'Fit map to page of the Windows default printer.
 Case 0
   fmCEem.MapDisp.PrintMap "MyMap", "", optLand.Value

'Print map to scale. Send to Windows default printer.
 Case 1
  Dim scalePrinter As New clsPTSobj 'Print-to-scale object
  Set scalePrinter.MapControl = fmCEem.MapDisp
  scalePrinter.MapUnits = fmCEem.strMapUnits
  If IsNumeric(txtRatioScale) Then
    scalePrinter.RatioScale = txtRatioScale.Text
   Else
    MsgBox "Invalid ratio scale entered.", vbCritical, "Stop"
    Exit Sub
  End If
  scalePrinter.PrintNow
End Select
End Sub

'Module clsPTSobj
''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Option Explicit

'This class provides "printing to scale" functionality. No Property procedures due to the very basic nature
'of this class. All four properties are exposed. 'The one single method is exposed.

Public MapControl As mapobjects2.Map
Public MapUnits As String
Public RatioScale As Long
Public OneInchToUnits As Double

Public Sub PrintNow()

Dim PrinterWidth As Double
Dim PrinterHeight As Double
Dim MapWidth As Double
Dim MapHeight As Double
Dim TwipsPerPixX As Double
Dim TwipsPerPixY As Double
Dim OutputRectWidth As Double
Dim OutputRectHeight As Double
Dim ConversionFactor As Double
Dim PageOriginX As Double
Dim PageOriginY As Double

'Establish map units conversion factor
If MapUnits = "Feet" Then
 ConversionFactor = 12
   'number of inches in a foot
 ElseIf MapUnits = "Meters" Then
 ConversionFactor = 39.37
   'number of inches in a meter
 ElseIf MapUnits = "Decimal Degrees" Then
 ConversionFactor = 4322893.46

                                                           258
  'number of inches in an longitudinal
  'degree at the equator
Else
MsgBox "Map units property not correctly set." & vbCrLf & _
    "Set it as a string, FEET, METERS, or DD."
Exit Sub
End If

'Ensure that MapControl property is set.
If MapControl Is Nothing Then
 MsgBox "Please set MapControl property before using" & vbCrLf & _
     "the PrintNow method."
 Exit Sub
End If

'Ensure that one of the two scale properties are set.
If RatioScale = 0 Then
 If OneInchToUnits = 0 Then
  MsgBox "Please set the RatioScale or OneInchToScale property" & vbCrLf & _
     "before using the PrintNow method."
  Exit Sub
  Else
  RatioScale = OneInchToUnits * ConversionFactor
 End If
End If

'Convert page units to inches
Printer.ScaleMode = vbInches

'Get this printer's Twips per Pixel value
TwipsPerPixX = Printer.TwipsPerPixelX
TwipsPerPixY = Printer.TwipsPerPixelY

'Get width and height of page in inches
PrinterWidth = Printer.ScaleWidth
PrinterHeight = Printer.ScaleHeight

'Convert ground map units into inches
MapWidth = MapControl.Extent.Width * ConversionFactor
MapHeight = MapControl.Extent.Height * ConversionFactor

'Calculate output rectangle
OutputRectWidth = MapWidth / RatioScale
OutputRectHeight = MapHeight / RatioScale

'Set the InchToUnits property
OneInchToUnits = RatioScale / ConversionFactor

'Check to ensure that the output rectangle
'is not too large for the printer page. If it
'is, warn the user, then bail out.
If OutputRectWidth > PrinterWidth Then
  MsgBox "The scale you specified makes the map too wide for the printed page." & _
      vbCrLf & vbCrLf & _

                                                     259
     "Your printer is only " & Format(PrinterWidth, "#0.00") & " inches wide," & vbCrLf & _
     "but a scale of 1:" & RatioScale & " makes the map " & _
     Format(OutputRectWidth, "#0.00") & " inches wide."
 Exit Sub
 ElseIf OutputRectHeight > PrinterHeight Then
 MsgBox "The scale you specified makes the map too tall for the printed page." & _
     vbCrLf & vbCrLf & _
     "Your printer is only " & Format(PrinterHeight, "#0.00") & " inches tall," & vbCrLf & _
     "but a scale of 1:" & RatioScale & " makes the map " & _
     Format(OutputRectHeight, "#0.00") & " inches tall."
 Exit Sub
 Else
 Dim continueAnswer As Integer

 continueAnswer = MsgBox("DO YOU WISH TO CONTINUE?" & vbNewLine & _
      "Page Size: " & vbNewLine & _
      Format(PrinterWidth, "#0.00") & " inches wide" & vbNewLine & _
      Format(PrinterHeight, "#0.00") & " inches tall" & vbNewLine & vbNewLine & _
      "Printed map extent: " & vbNewLine & _
      Format(OutputRectWidth, "#0.00") & " inches wide" & vbNewLine & _
      Format(OutputRectHeight, "#0.00") & " inches tall" & vbNewLine & vbNewLine & _
      "RATIO SCALE" & vbNewLine & _
     "1:" & RatioScale & vbNewLine & vbNewLine & _
     "SCALE TO MAP UNITS" & vbNewLine & _
     "One inch equals " & Format(OneInchToUnits, "#0.00") & _
     " " & MapUnits, vbYesNo)

 If continueAnswer = 7 Then
  'MsgBox "Output process halted"
  Exit Sub
 End If
End If

'Center the output rectangle onto the page
PageOriginX = (PrinterWidth - OutputRectWidth) / 2
PageOriginY = (PrinterHeight - OutputRectHeight) / 2

'Convert all measurements into Printer Pixels
PageOriginX = (PageOriginX * 1440) / TwipsPerPixX
PageOriginY = (PageOriginY * 1440) / TwipsPerPixY
OutputRectWidth = (OutputRectWidth * 1440) / TwipsPerPixX
OutputRectHeight = (OutputRectHeight * 1440) / TwipsPerPixY

'Print the map
Printer.Print
MapControl.OutputMap2 Printer.hDC, _
          PageOriginX, PageOriginY, _
          OutputRectWidth, OutputRectHeight
Printer.EndDoc

End Sub




                                                       260
CURRICULUM VITA

Jun Xu
9692 Lindenbrook Street, Fairfax, VA 22031, USA
Email: junxu99@hotmail.com

EDUCATION:
  • Ph.D. in Environmental Design & Planning Program, September 2003
    Virginia Tech, Blacksburg, VA
  • M. ARCH. December 1999
    Virginia Tech, Blacksburg, VA
  • M. ARCH. March 1997
    Tongji University, Shanghai, PRC
  • B. S. in Architecture, July 1990
    Tongji University, Shanghai, PRC

EXPERIENCE:
  • Graduate Assistant, 2001 – 2003
     Virginia Tech, Blacksburg, VA
  • Web Designer, 1998 – 2001
     Virginia Tech, Blacksburg, VA
  • Graduate Assistant, 1997 – 1998
     Virginia Tech, Blacksburg, VA
  • Interior Designer and Project Manager, 1996 – 1997
     T-Deco Design and Construction Company, Shanghai, PRC
  • Graduate Assistant, 1994 – 1996
     Tongji University, Shanghai, PRC
  • Intern Architect, 1990 – 1994
     The 9th Design & Research Institute, Shanghai, PRC

PUBLICATIONS/REPORTS:
  • Jun Xu and James Jones, East Meets West: On Feng Shui and Western Environmental
     Models, The Architectural Research Centers Consortium 2002 Conference Proceedings,
     Montreal, Canada, accepted in May 2002
  • Jun Xu, Experiencing Architecture: A Guide to Washington, DC (Huashengdun
     Lueying), Haifeng, Journal of Chinese-American Science and Technology Association,
     New York, NY, Summer 2001
  • Jun Xu and James Jones, Managing Computer-based Environmental Information, The
     Architectural Research Centers Consortium 2001 Conference Proceedings, Blacksburg,
     VA, 2001
  • Zhong Liu and Jun Xu, Feasibility Study on No.3 Shanghai Welfare Home for the Aged,
     internal report to the Shanghai Municipal Bureau of Civil Affairs, Shanghai, PRC, 1996


                                            261

								
To top