frmslider.frm

gis地图 --- --- --文字1

VERSION 5.00
Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.3#0"; "comctl32.ocx"
Begin VB.Form frmSlider 
   BorderStyle     =   4  'Fixed ToolWindow
   Caption         =   "Label"
   ClientHeight    =   1104
   ClientLeft      =   5340
   ClientTop       =   6876
   ClientWidth     =   6552
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   1104
   ScaleWidth      =   6552
   ShowInTaskbar   =   0   'False
   Begin VB.Frame frTwo 
      BorderStyle     =   0  'None
      Caption         =   "Frame1"
      Height          =   975
      Left            =   5415
      TabIndex        =   6
      Top             =   15
      Width           =   1020
      Begin VB.CheckBox chkLBLVisible 
         Caption         =   "Visible"
         Height          =   255
         Left            =   -15
         TabIndex        =   9
         Top             =   0
         Width           =   975
      End
      Begin VB.CommandButton cmdMessage 
         Caption         =   "Message..."
         Height          =   300
         Left            =   0
         TabIndex        =   8
         Top             =   645
         Width           =   960
      End
      Begin VB.CommandButton cmdFont 
         Caption         =   "Font..."
         Height          =   300
         Left            =   0
         TabIndex        =   7
         Top             =   315
         Width           =   960
      End
   End
   Begin VB.Frame frBasic 
      BorderStyle     =   0  'None
      Caption         =   "Frame1"
      Height          =   1095
      Left            =   0
      TabIndex        =   0
      Top             =   0
      Width           =   5445
      Begin ComctlLib.Slider Slider1 
         Height          =   300
         Left            =   195
         TabIndex        =   10
         Top             =   195
         Width           =   2205
         _ExtentX        =   3895
         _ExtentY        =   529
         _Version        =   327682
      End
      Begin VB.ComboBox cmbSlider 
         Height          =   315
         ItemData        =   "frmSlider.frx":0000
         Left            =   3660
         List            =   "frmSlider.frx":0019
         Style           =   2  'Dropdown List
         TabIndex        =   2
         Top             =   240
         Width           =   1455
      End
      Begin VB.TextBox txtValue 
         Height          =   285
         Left            =   2535
         TabIndex        =   1
         Top             =   225
         Width           =   915
      End
      Begin VB.Label lblMIN 
         Caption         =   "0"
         Height          =   255
         Left            =   240
         TabIndex        =   5
         Top             =   600
         Width           =   1485
      End
      Begin VB.Label lblMAX 
         Caption         =   "100"
         Height          =   255
         Left            =   1920
         TabIndex        =   4
         Top             =   600
         Width           =   2295
      End
      Begin VB.Label lblCurrent 
         Caption         =   "50"
         Height          =   255
         Left            =   1170
         TabIndex        =   3
         Top             =   585
         Visible         =   0   'False
         Width           =   495
      End
      Begin VB.Shape Shape1 
         BorderWidth     =   2
         DrawMode        =   1  'Blackness
         Height          =   855
         Left            =   60
         Top             =   120
         Width           =   5250
      End
   End
End
Attribute VB_Name = "frmSlider"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

' Copyright 1995-2004 ESRI

' All rights reserved under the copyright laws of the United States.

' You may freely redistribute and use this sample code, with or without modification.

' Disclaimer: THE SAMPLE CODE IS PROVIDED "AS IS" AND ANY EXPRESS OR IMPLIED 
' WARRANTIES, INCLUDING THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 
' FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL ESRI OR 
' CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, 
' OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF 
' SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS 
' INTERRUPTION) SUSTAINED BY YOU OR A THIRD PARTY, HOWEVER CAUSED AND ON ANY 
' THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT ARISING IN ANY 
' WAY OUT OF THE USE OF THIS SAMPLE CODE, EVEN IF ADVISED OF THE POSSIBILITY OF 
' SUCH DAMAGE.

' For additional information contact: Environmental Systems Research Institute, Inc.

' Attn: Contracts Dept.

' 380 New York Street

' Redlands, California, U.S.A. 92373 

' Email: [e-mail]

Option Explicit

Public m_pCurrentGroup As LabelGroup
Public m_pCurrentLabel As IDDDText

Dim m_bDuringInit As Boolean
Dim m_iStatus As Integer
Dim m_nValue As Double

Private Sub chkLBLVisible_Click()

On Error GoTo SetLayerLabelVis_ERR
Dim p As IDDDText
'   toggle the visibility of the current label:
    If Not m_pCurrentGroup Is Nothing Then
        Set p = m_pCurrentGroup.Labels.Item(1)
    Else
        Set p = m_pCurrentLabel
    End If
    
    p.Enabled = (frmSlider.chkLBLVisible.Value = 1)

    g_pDoc.Scene.SceneGraph.RefreshViewers
    
    Exit Sub
    
SetLayerLabelVis_ERR:
    MsgBox "SetLayerVis_ERR: " & Err.Description
End Sub

Private Sub cmbSlider_Click()
On Error Resume Next
    If m_bDuringInit Then Exit Sub
    InitControls
    
End Sub


Private Sub InitControls()
Dim n As Double
Dim nMin As Double
Dim nMax As Double
Dim bOK As Boolean
Dim sForWhat As String
Dim pCurLayer As LabelGroup

On Error GoTo SyncSliderToCurrentLayerLabel_ERR
    
    If m_pCurrentGroup Is Nothing Then
        Set pCurLayer = frmProps.GetCurrentLabelGroup
    Else
        Set pCurLayer = m_pCurrentGroup
    End If
    
    
    sForWhat = frmSlider.cmbSlider.Text
    
'   if we are setting for the label group:
    If Not m_pCurrentGroup Is Nothing Then
    
        Select Case UCase(sForWhat)
            Case "FONT SIZE"
                nMin = m_pCurrentGroup.m_nFontMin
                nMax = m_pCurrentGroup.m_nFontMax
                n = m_pCurrentGroup.FontSize
                bOK = True
            Case "X ROTATION"
                nMin = m_pCurrentGroup.m_nXRotMin
                nMax = m_pCurrentGroup.m_nXRotMax
                n = m_pCurrentGroup.XRotation
                bOK = True
            Case "Y ROTATION"
                nMin = m_pCurrentGroup.m_nYRotMin
                nMax = m_pCurrentGroup.m_nYRotMax
                n = m_pCurrentGroup.YRotation
                bOK = True
            Case "Z ROTATION"
                nMin = m_pCurrentGroup.m_nZRotMin
                nMax = m_pCurrentGroup.m_nZRotMax
                n = m_pCurrentGroup.ZRotation
                bOK = True
            Case "X OFFSET"
                nMin = m_pCurrentGroup.m_nXOffMin
                nMax = m_pCurrentGroup.m_nXOffMax
                n = 0
                bOK = True
            Case "Y OFFSET"
                nMin = m_pCurrentGroup.m_nYOffMin
                nMax = m_pCurrentGroup.m_nYOffMax
                n = 0
                bOK = True
            Case "Z OFFSET"
                nMin = m_pCurrentGroup.m_nZOffMin
                nMax = m_pCurrentGroup.m_nZOffMax
                n = 0
                bOK = True
        End Select
    ElseIf Not m_pCurrentLabel Is Nothing Then
'   if we are setting for the current label:
        Dim xRot As Double, yRot As Double, zRot As Double
        m_pCurrentLabel.GetAxisRotation xRot, yRot, zRot
        Select Case UCase(sForWhat)
            Case "FONT SIZE"
                nMin = pCurLayer.m_nFontMin
                nMax = pCurLayer.m_nFontMax
                n = m_pCurrentLabel.FontSize
                bOK = True
            Case "X ROTATION"
                nMin = pCurLayer.m_nXRotMin
                nMax = pCurLayer.m_nXRotMax
                n = xRot
                bOK = True
            Case "Y ROTATION"
                nMin = pCurLayer.m_nYRotMin
                nMax = pCurLayer.m_nYRotMax
                n = yRot
                bOK = True
            Case "Z ROTATION"
                nMin = pCurLayer.m_nZRotMin
                nMax = pCurLayer.m_nZRotMax
                n = zRot
                bOK = True
            Case "X OFFSET"
                nMin = pCurLayer.m_nXOffMin
                nMax = pCurLayer.m_nXOffMax
                n = 0
                bOK = True
            Case "Y OFFSET"
                nMin = pCurLayer.m_nYOffMin
                nMax = pCurLayer.m_nYOffMax
                n = 0
                bOK = True
            Case "Z OFFSET"
                nMin = pCurLayer.m_nZOffMin
                nMax = pCurLayer.m_nZOffMax
                n = 0
                bOK = True
        End Select

    End If
    
'   ensure something...ensure hope:
    If nMax < nMin Then
        nMax = -(nMin)
    ElseIf nMax = nMin Then
        nMax = 5000
        nMin = -5000
    ElseIf nMin > nMax Then
        nMin = -(nMax)
    ElseIf nMax > nMin Then
    
    Else
        nMax = 5000
        nMin = -5000
    
    End If
                
'   if we have a setting to calibrate to:
    If bOK Then
    '   set the slider controls:
        With frmSlider
            .Slider1.Max = nMax
            .Slider1.Min = nMin
            .Slider1.Value = n
            .Slider1.TickFrequency = (nMax - nMin) / 50
            .txtValue = n
            m_nValue = n
            .lblMIN = Mid(CStr(nMin), 1, 6)
            .lblMAX = Mid(CStr(nMax), 1, 6)
            
            If Not m_pCurrentLabel Is Nothing Then
            '   use the visibility control:
                Me.chkLBLVisible.Visible = True
                If m_pCurrentLabel.Enabled Then
                    Me.chkLBLVisible.Value = 1
                Else
                    Me.chkLBLVisible.Value = 0
                End If
                Me.cmdMessage.Enabled = True
            Else
                Me.chkLBLVisible.Visible = False
                Me.cmdMessage.Enabled = False
            End If
            
        End With
    Else

        Exit Sub
    End If
        
    frmSlider.RefreshMe

    Exit Sub
    
SyncSliderToCurrentLayerLabel_ERR:
    'MsgBox "SyncSliderToCurrentLayerLabel_ERR: " & err.Description & vbCrLf & sForWhat & vbCrLf & nMin & vbCrLf & nMax & vbCrLf & n
    Resume Next
End Sub

Public Sub RefreshMe()
On Error Resume Next

    With Me
        .cmbSlider.Refresh
        .txtValue.Refresh
        .Slider1.Refresh
    End With
    
End Sub

Public Function RunMe(pLBL As IDDDText, pLayer As LabelGroup, sType As String, xLeft As Long, xTop As Long, Optional bComplete As Boolean, Optional sCaption As String)
    
On Error GoTo FrmSliderRun_ERR