?? frmslider.frm
字號:
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: contracts@esri.com
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
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -