📄 frmlookup.frm
字号:
TabIndex = 24
Top = 2040
Width = 495
End
Begin VB.Label LblHz
Alignment = 1 'Right Justify
Caption = "Hz"
Height = 195
Index = 0
Left = 60
TabIndex = 23
Top = 2040
Width = 495
End
Begin VB.Label LblHz
Caption = "Hz"
Height = 195
Index = 1
Left = 4920
TabIndex = 22
Top = 2040
Width = 495
End
Begin VB.Label LblMin
Alignment = 1 'Right Justify
Caption = "0%"
Height = 195
Index = 0
Left = 60
TabIndex = 21
Top = 1740
Width = 495
End
Begin VB.Label LblMin
Caption = "0%"
Height = 195
Index = 1
Left = 4920
TabIndex = 20
Top = 1740
Width = 495
End
Begin VB.Label LblMid
Alignment = 1 'Right Justify
Caption = "50%"
Height = 195
Index = 0
Left = 60
TabIndex = 19
Top = 1020
Width = 495
End
Begin VB.Label LblMid
Caption = "50%"
Height = 195
Index = 1
Left = 4920
TabIndex = 18
Top = 1020
Width = 495
End
Begin VB.Label LblMax
Alignment = 1 'Right Justify
Caption = "100%"
Height = 195
Index = 0
Left = 60
TabIndex = 17
Top = 240
Width = 495
End
Begin VB.Label LblMax
Caption = "100%"
Height = 195
Index = 1
Left = 4920
TabIndex = 16
Top = 240
Width = 495
End
End
Begin VB.CommandButton CmdSave
Caption = "&Save"
Height = 372
Left = 1260
TabIndex = 4
Top = 7800
Width = 1095
End
Begin VB.TextBox TxtLookup
BorderStyle = 0 'None
Height = 375
Left = 8460
TabIndex = 3
Top = 7800
Visible = 0 'False
Width = 435
End
Begin VB.CommandButton CmdOPen
Caption = "&Open..."
Height = 372
Left = 60
TabIndex = 2
Top = 7800
Width = 1095
End
Begin VB.CommandButton CmdSaveAs
Caption = "Save &As..."
Height = 372
Left = 2460
TabIndex = 0
Top = 7800
Width = 1095
End
Begin VB.CommandButton CmdClose
Cancel = -1 'True
Caption = "&Close"
Height = 372
Left = 9000
TabIndex = 1
Top = 7800
Width = 1092
End
Begin MSComDlg.CommonDialog CDLookup
Left = 3660
Top = 7800
_ExtentX = 699
_ExtentY = 699
_Version = 393216
CancelError = -1 'True
Filter = "Lookup Tables (*.lut)|*.lut|All Files|*.*"
Flags = 2
End
Begin MSFlexGridLib.MSFlexGrid FGLookup
Height = 7215
Left = 120
TabIndex = 6
Top = 420
Visible = 0 'False
Width = 9915
_ExtentX = 17484
_ExtentY = 12721
_Version = 393216
Rows = 50
Cols = 50
FillStyle = 1
AllowUserResizing= 3
End
Begin ComctlLib.TabStrip TSLookup
Height = 7635
Left = 60
TabIndex = 5
Top = 60
Width = 10035
_ExtentX = 17695
_ExtentY = 13462
_Version = 327682
BeginProperty Tabs {0713E432-850A-101B-AFC0-4210102A8DA7}
NumTabs = 2
BeginProperty Tab1 {0713F341-850A-101B-AFC0-4210102A8DA7}
Caption = "Volume && Range"
Object.Tag = ""
ImageVarType = 2
EndProperty
BeginProperty Tab2 {0713F341-850A-101B-AFC0-4210102A8DA7}
Caption = "Frequency"
Object.Tag = ""
ImageVarType = 2
EndProperty
EndProperty
End
End
Attribute VB_Name = "FrmLookup"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Sub ShowTab()
'Check tab index
If TSLookup.SelectedItem.Index = 1 Then
'Set controls
FmeFreq(0).Visible = False
FmeFreq(1).Visible = False
FmeFreq(2).Visible = False
CmdReset.Visible = False
FGLookup.Visible = True
Exit Sub
End If
'Check tab index
If TSLookup.SelectedItem.Index = 2 Then
'Set controls
FGLookup.Visible = False
FmeFreq(0).Visible = True
FmeFreq(1).Visible = True
FmeFreq(2).Visible = True
CmdReset.Visible = True
End If
End Sub
Sub ShowLabels()
Dim n, m As Integer
Dim nPos As Integer
Dim sData As String
Dim sNum As String
'Clear grid
FGLookup.Clear
'Set grid size
FGLookup.Cols = nVRCount * 2 + 1
FGLookup.Rows = nHeadCount + 1
'Set row
FGLookup.Row = 0
'Loop thru volume/range labels
For n = 0 To nVRCount * 2 - 1
'Set column
FGLookup.Col = n + 1
'Set volume/range label
If n Mod 2 = 0 Then FGLookup.Text = "Volume" + " (" + Str(n / 2 + 1) + ")"
If n Mod 2 = 1 Then FGLookup.Text = "Range" + " (" + Str((n - 1) / 2 + 1) + ")"
Next n
'Set column
FGLookup.Col = 0
'Loop thru header labels
sData = sHeadLabels
For n = 0 To nHeadCount - 1
'Set column
FGLookup.Row = n + 1
'Get position of space character in string
nPos = InStr(sData, " ")
'Set number
sNum = " (" + Str(n) + ")"
'If possible, truncate string at space character
If nPos > 0 Then
'Set header label
FGLookup.Text = Left(sData, nPos - 1) + sNum
sData = Mid(sData, nPos + 1, Len(sData))
Else
'Set header label
FGLookup.Text = sData + sNum
End If
Next n
'Set row and column
FGLookup.Col = 1
FGLookup.Row = 1
End Sub
Function OpenLookup(ByVal sFileName As String, ByVal nOffset As Integer) As Boolean
Dim i As Integer, j As Integer, k As Integer
Dim nVolRC As Integer
Dim nHeaderC As Integer
Dim nErr As Long
Dim aLookup() As Long
Dim sText As String
'Default
OpenLookup = True
'Set mouse pointer
MousePointer = vbHourglass
'Dimension data array
ReDim aLookup(nVRCount)
'Open lookup table
nErr = volOpenRLookup(sFileName, nVolRC, nHeaderC)
If nErr < 0 Then
'Reset mouse pointer
MousePointer = vbDefault
'Inform User
Call volGetErr(nErr, sText)
Call MsgBox("Error: " + TruncStr(sText) + "!", vbOKOnly Or vbExclamation, "VolTool")
'Error
OpenLookup = False
Exit Function
End If
'Check volume/range count
If nVolRC <> nVRCount Then
'Reset mouse pointer
MousePointer = vbDefault
'Inform User
Call MsgBox("Error: Invalid number of columns in lookup table (" + Str(nVolRC) + ")!", vbOKOnly Or vbExclamation, "VolTool")
'Close lookup table
Call volCloseRLookup
'Error
OpenLookup = False
Exit Function
End If
'Check header count
If nHeaderC <> nHeadCount Then
'Reset mouse pointer
MousePointer = vbDefault
'Inform User
Call MsgBox("Error: Invalid number of rows in lookup table (" + Str(nHeaderC) + ")!", vbOKOnly Or vbExclamation, "VolTool")
'Close lookup table
Call volCloseRLookup
'Error
OpenLookup = False
Exit Function
End If
'Loop thru lookup table
For i = 0 To nHeadCount - 1
'Read from lookup table
nErr = volReadLookup(aLookup(0))
If nErr < 0 Then
'Set row and column
FGLookup.Col = 1
FGLookup.Row = 1
'Reset mouse pointer
MousePointer = vbDefault
'Inform User
Call volGetErr(nErr, sText)
Call MsgBox("Error: " + TruncStr(sText) + "!", vbOKOnly Or vbExclamation, "VolTool")
'Close lookup table
Call volCloseRLookup
'Error
OpenLookup = False
Exit Function
End If
'Set row
FGLookup.Row = i + 1
For j = 0 To nVRCount * 2 - 1
'Set column
FGLookup.Col = j + 1
'Set data
If j Mod 2 = nOffset Then FGLookup.Text = Str(aLookup((j - nOffset) / 2))
Next j
Next i
'Close lookup table
nErr = volCloseRLookup()
If nErr < 0 Then
'Set row and column
FGLookup.Col = 1
FGLookup.Row = 1
'Reset mouse pointer
MousePointer = vbDefault
'Inform User
Call volGetErr(nErr, sText)
Call MsgBox("Error: " + TruncStr(sText) + "!", vbOKOnly Or vbExclamation, "VolTool")
'Error
OpenLookup = False
Exit Function
End If
'Set row and column
FGLookup.Col = 1
FGLookup.Row = 1
'Reset mouse pointer
MousePointer = vbDefault
End Function
Function OpenFreq(ByVal sFileName As String) As Boolean
Dim i As Integer, j As Integer
Dim nVolRC As Integer
Dim nErr As Long
Dim aFreq(8) As Single
Dim sText As String
'Default
OpenFreq = True
'Set mouse pointer
MousePointer = vbHourglass
'Open frequency data
nErr = volOpenRFreq(sFileName, nVolRC)
If nErr < 0 Then
'Reset mouse pointer
MousePointer = vbDefault
'Inform User
Call volGetErr(nErr, sText)
Call MsgBox("Error: " + TruncStr(sText) + "!", vbOKOnly Or vbExclamation, "VolTool")
'Error
OpenFreq = False
Exit Function
End If
'Check volume/range count
If nVolRC <> nVRCount Then
'Reset mouse pointer
MousePointer = vbDefault
'Inform User
Call MsgBox("Error: Invalid number of rows in frequency data (" + Str(nVolRC) + ")!", vbOKOnly Or vbExclamation, "VolTool")
'Close frequency data
Call volCloseRFreq
'Error
OpenFreq = False
Exit Function
End If
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -