form1.frm

abel Tool Sample Requires: Visual Basic 6 and MapObjects 2.x Data: redlands.shp (Redlands sample

VERSION 5.00
Object = "{9BD6A640-CE75-11D1-AF04-204C4F4F5020}#2.0#0"; "mo20.ocx"
Begin VB.Form Form1 
   Caption         =   "Label Streets"
   ClientHeight    =   7545
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   9045
   LinkTopic       =   "Form1"
   ScaleHeight     =   7545
   ScaleWidth      =   9045
   StartUpPosition =   3  'Windows Default
   Begin MapObjects2.Map Map1 
      Height          =   5895
      Left            =   120
      TabIndex        =   6
      Top             =   120
      Width           =   8775
      _Version        =   131072
      _ExtentX        =   15478
      _ExtentY        =   10398
      _StockProps     =   225
      BackColor       =   16777215
      BorderStyle     =   1
      Contents        =   "Form1.frx":0000
   End
   Begin VB.HScrollBar HScroll1 
      Height          =   255
      Left            =   5760
      TabIndex        =   4
      Top             =   6720
      Width           =   2295
   End
   Begin VB.OptionButton Option2 
      Caption         =   "Option2"
      Height          =   495
      Left            =   2640
      TabIndex        =   2
      Top             =   6720
      Width           =   2415
   End
   Begin VB.OptionButton Option1 
      Caption         =   "Option1"
      Height          =   495
      Left            =   2640
      TabIndex        =   1
      Top             =   6360
      Width           =   2535
   End
   Begin VB.CommandButton Command1 
      Caption         =   "Command1"
      Height          =   495
      Left            =   720
      TabIndex        =   0
      Top             =   6600
      Width           =   1215
   End
   Begin VB.Label Label2 
      Caption         =   "Label2"
      Height          =   375
      Left            =   5880
      TabIndex        =   5
      Top             =   7080
      Width           =   855
   End
   Begin VB.Label Label1 
      Caption         =   "Label1"
      Height          =   255
      Left            =   5520
      TabIndex        =   3
      Top             =   6360
      Width           =   2895
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim closestLine As MapObjects2.Line
Dim closestLineLabel As String
Dim tsym As New MapObjects2.TextSymbol


Private Sub Command1_Click()

Dim dc As New MapObjects2.DataConnection
Dim gds As MapObjects2.GeoDataset
Dim mlyr As New MapObjects2.MapLayer
'dc.Database = App.Path
dc.Database = "C:\Program Files\ESRI\MapObjects2\Samples\data\Redlands"
dc.Connect
Set gds = dc.FindGeoDataset("redlands")
Set mlyr.GeoDataset = gds
mlyr.Symbol.Color = moBlue
Map1.Layers.Add mlyr

End Sub

Private Sub Form_Load()

Dim fnt As New StdFont
fnt.Name = "Arial"
fnt.Size = 10
tsym.Color = moBlack
Set tsym.Font = fnt
Command1.Caption = "Load Layer"
Option1.Caption = "Mouse is Pan/Zoom tool"
Option2.Caption = "Mouse is Label tool"
Option1.Value = True
Label1.Caption = "Search tolerance in screen pixels: 3"

HScroll1.Min = 1
HScroll1.Max = 30
HScroll1.Value = 3

End Sub

Private Sub HScroll1_Change()

Label1.Caption = "Search tolerance in screen pixels: " & HScroll1.Value

End Sub

Private Sub Map1_AfterTrackingLayerDraw(ByVal hDC As Stdole.OLE_HANDLE)

Label2.Caption = tsym.Rotation
If Not closestLine Is Nothing Then
 Map1.DrawText closestLineLabel, closestLine, tsym
End If

End Sub

Private Sub Map1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)

'If the check box is checked, then the mouse
'down location will search for the closest
'line, and label it with the street name.
'
'If the check box is not checked, then the
'mouse down will turn into a pan/zoom tool

If Option2 Then
  Dim ptClicked As New MapObjects2.Point
  Set ptClicked = Map1.ToMapPoint(x, y)
  Dim tol As Double
    'Make the search tolerance to be
    'whatever the map units equivalent
    'is for 3 pixels, regardless of the
    'current scale/extent.
  tol = HScroll1.Value * Screen.TwipsPerPixelX
  tol = Map1.ToMapDistance(tol)
  Dim selRecs As MapObjects2.Recordset
  Set selRecs = Map1.Layers(0).SearchByDistance _
                (ptClicked, tol, "")
    
  If selRecs.Count > 0 Then
    'Find the closest line to the click.
    Dim i As Integer
    Dim thisLine As MapObjects2.Line
    Dim closestDist, thisDist As Double
    closestDist = 999999999
    Do While Not selRecs.EOF
       Set thisLine = selRecs.Fields("shape").Value
       thisDist = thisLine.DistanceTo(ptClicked)
       If thisDist < closestDist Then
         closestDist = thisDist
         Dim gaa As Double
         gaa = thisLine.Length
         Set closestLine = thisLine
         closestLineLabel = selRecs.Fields("Name").Value
       End If
       selRecs.MoveNext
    Loop
    Map1.Refresh
   Else 'if there were no selected records
    Set closestLine = Nothing
    Map1.Refresh
  End If
  
 Else 'be a pan/zoom tool
   If Shift = 0 Then
     If Button = 1 Then
      Set Map1.Extent = Map1.TrackRectangle
       Else
        Map1.Pan
     End If
    Else
     If Button = 1 Then
        Dim rect As New MapObjects2.Rectangle
        Set rect = Map1.Extent
        rect.ScaleRectangle (1.2)
        Set Map1.Extent = rect
      Else
        Set Map1.Extent = Map1.FullExtent
     End If
   End If
End If

End Sub