📄 frmcmdcalculateproperties.frm
字号:
VERSION 5.00
Begin VB.Form frmCmdCalculateProperties
BorderStyle = 3 'Fixed Dialog
Caption = "Dialog Caption"
ClientHeight = 3396
ClientLeft = 2760
ClientTop = 3756
ClientWidth = 3288
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 3396
ScaleWidth = 3288
ShowInTaskbar = 0 'False
Begin VB.Frame fraRHSInputLine
BorderStyle = 0 'None
Height = 675
Left = 120
TabIndex = 8
Top = 2040
Width = 3015
Begin VB.TextBox txtRHSLength
Appearance = 0 'Flat
Height = 285
Left = 2520
TabIndex = 12
Text = "0"
Top = 60
Width = 495
End
Begin VB.TextBox txtRHSDelimiter
Appearance = 0 'Flat
Height = 285
Left = 2520
TabIndex = 11
Top = 60
Width = 495
End
Begin VB.CheckBox chkRHSDelimited
Appearance = 0 'Flat
Caption = "Values are delimited"
ForeColor = &H80000008&
Height = 195
Left = 0
TabIndex = 10
Top = 420
Width = 1935
End
Begin VB.TextBox txtRHSPosition
Appearance = 0 'Flat
Height = 285
Left = 1260
TabIndex = 9
Text = "0"
Top = 60
Width = 495
End
Begin VB.Label lblRHSLength
AutoSize = -1 'True
Caption = "Length"
Height = 195
Left = 1920
TabIndex = 15
Top = 60
Width = 495
End
Begin VB.Label Label8
AutoSize = -1 'True
Caption = "Value in position"
Height = 195
Left = 0
TabIndex = 14
Top = 60
Width = 1155
End
Begin VB.Label lblRHSDelimiter
AutoSize = -1 'True
Caption = "Delimiter"
Height = 195
Left = 1860
TabIndex = 13
Top = 60
Width = 600
End
End
Begin VB.ComboBox cboOperator
Appearance = 0 'Flat
Height = 315
ItemData = "frmCmdCalculateProperties.frx":0000
Left = 1680
List = "frmCmdCalculateProperties.frx":0002
Style = 2 'Dropdown List
TabIndex = 7
Top = 720
Width = 1455
End
Begin VB.ComboBox cboRHSCheckPoint
Appearance = 0 'Flat
Height = 315
ItemData = "frmCmdCalculateProperties.frx":0004
Left = 660
List = "frmCmdCalculateProperties.frx":0011
TabIndex = 6
Text = "cboRHSCheckPoint"
Top = 2040
Width = 2475
End
Begin VB.ComboBox cboRHSDataItem
Appearance = 0 'Flat
Height = 315
ItemData = "frmCmdCalculateProperties.frx":0041
Left = 660
List = "frmCmdCalculateProperties.frx":004E
TabIndex = 5
Text = "cboRHSDataItem"
Top = 2400
Width = 2475
End
Begin VB.ComboBox cboRHSType
Appearance = 0 'Flat
Height = 315
ItemData = "frmCmdCalculateProperties.frx":007E
Left = 105
List = "frmCmdCalculateProperties.frx":008B
Style = 2 'Dropdown List
TabIndex = 4
Top = 1560
Width = 3075
End
Begin VB.CommandButton Command1
Caption = "&Ok"
Default = -1 'True
Height = 375
Left = 1260
TabIndex = 1
Top = 2880
Width = 855
End
Begin VB.CommandButton Command2
Caption = "&Cancel"
Height = 375
Left = 2280
TabIndex = 0
Top = 2880
Width = 855
End
Begin VB.TextBox txtRHSConstant
Appearance = 0 'Flat
Height = 285
Left = 120
TabIndex = 3
Top = 2040
Width = 3015
End
Begin VB.Label Label2
AutoSize = -1 'True
Caption = "Right hand side of the equation"
Height = 195
Left = 120
TabIndex = 19
Top = 1200
Width = 2220
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "Operation to perform"
Height = 195
Left = 120
TabIndex = 18
Top = 780
Width = 1440
End
Begin VB.Label lblRHSDataItem
AutoSize = -1 'True
Caption = "Field"
Height = 195
Left = 120
TabIndex = 17
Top = 2400
Width = 330
End
Begin VB.Label lblRHSCheckPoint
AutoSize = -1 'True
Caption = "Record"
Height = 195
Left = 120
TabIndex = 16
Top = 2040
Width = 525
End
Begin VB.Label Label5
Caption = "Perform a mathematical calculation on this field value."
Height = 435
Left = 120
TabIndex = 2
Top = 120
Width = 3015
End
End
Attribute VB_Name = "frmCmdCalculateProperties"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
' DataMonkey Data Conversion Application. Written by Theodore L. Ward
' Copyright (C) 2002 AstroComma Incorporated.
'
' This program is free software; you can redistribute it and/or
' modify it under the terms of the GNU General Public License
' as published by the Free Software Foundation; either version 2
' of the License, or (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY; without even the implied warranty of
' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
' GNU General Public License for more details.
'
' You should have received a copy of the GNU General Public License
' along with this program; if not, write to the Free Software
' Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
' The author may be contacted at:
' TheodoreWard@Hotmail.com or TheodoreWard@Yahoo.com
Option Explicit
Option Compare Text
Private mCalcObj As CCmdCalculateValue
Private mImport As CImport
Private Sub cboOperator_Click()
DisplayExpression
End Sub
Private Sub cboRHSCheckPoint_Click()
FillDataItemCombo cboRHSDataItem, cboRHSCheckPoint.Text
DisplayExpression
End Sub
Private Sub cboRHSDataItem_Click()
DisplayExpression
End Sub
Private Sub FillCheckPointCombo(Cbo As ComboBox)
Dim cp As CInputRecord
Cbo.Clear
For Each cp In mImport.GetCheckPoints
Cbo.AddItem cp.name
Next cp
If Cbo.ListCount > 0 Then
Cbo.ListIndex = 0
End If
End Sub
Private Sub FillDataItemCombo(Cbo As ComboBox, cpName As String)
Dim cp As CInputRecord
Dim di As CInputField
Cbo.Clear
If Trim(cpName) = "" Then Exit Sub
Set cp = mImport.GetCheckPointByName(cpName)
For Each di In cp.GetDataPoints()
Cbo.AddItem di.name
Next di
If Cbo.ListCount > 0 Then
Cbo.ListIndex = 0
End If
End Sub
Private Sub cboRHSType_Click()
' Hide everything.
Me.txtRHSConstant.Visible = False
Me.cboRHSCheckPoint.Visible = False
Me.cboRHSDataItem.Visible = False
Me.lblRHSCheckPoint.Visible = False
Me.lblRHSDataItem.Visible = False
Me.fraRHSInputLine.Visible = False
Select Case left$(cboRHSType.Text, 5)
Case "Const"
Me.txtRHSConstant.Visible = True
Case "DataI"
Me.cboRHSCheckPoint.Visible = True
Me.cboRHSDataItem.Visible = True
Me.lblRHSCheckPoint.Visible = True
Me.lblRHSDataItem.Visible = True
Case "Check"
Me.cboRHSCheckPoint.Visible = True
Me.lblRHSCheckPoint.Visible = True
Case "Value"
Me.fraRHSInputLine.Visible = True
End Select
DisplayExpression
End Sub
Private Sub chkRHSDelimited_Click()
Me.lblRHSDelimiter.Visible = IIf(chkRHSDelimited.value = 1, True, False)
Me.txtRHSDelimiter.Visible = IIf(chkRHSDelimited.value = 1, True, False)
Me.lblRHSLength.Visible = Not IIf(chkRHSDelimited.value = 1, True, False)
Me.txtRHSLength.Visible = Not IIf(chkRHSDelimited.value = 1, True, False)
DisplayExpression
End Sub
Private Sub Command1_Click()
' Get a string representing the RHS of the equation.
If Me.cboRHSDataItem.Visible = True Then
mCalcObj.RHSType = eCmdValueTypes.cvtDataItem
mCalcObj.RHS = cboRHSCheckPoint.Text + "," _
+ cboRHSDataItem.Text
ElseIf Me.cboRHSCheckPoint.Visible = True Then
mCalcObj.RHSType = eCmdValueTypes.cvtCheckPoint
mCalcObj.RHS = Me.cboRHSCheckPoint.Text
ElseIf Me.txtRHSConstant.Visible = True Then
mCalcObj.RHSType = eCmdValueTypes.cvtConstant
mCalcObj.RHS = Me.txtRHSConstant.Text
ElseIf Me.fraRHSInputLine.Visible = True Then
mCalcObj.RHSType = eCmdValueTypes.cvtLineOfInput
mCalcObj.RHSDelimited = IIf(chkRHSDelimited = 1, True, False)
mCalcObj.RHSDelimiter = txtRHSDelimiter
mCalcObj.RHSLength = IIf(txtRHSLength = "", 0, txtRHSLength)
mCalcObj.RHSInputLinePosition = txtRHSPosition
Else
mCalcObj.RHSType = eCmdValueTypes.cvtNONE
mCalcObj.RHS = ""
End If
' Get the operator.
Select Case Me.cboOperator.ListIndex
Case 0
mCalcObj.Operator = "+"
Case 1
mCalcObj.Operator = "-"
Case 2
mCalcObj.Operator = "*"
Case 3
mCalcObj.Operator = "/"
End Select
GFormReturnValue = vbOK
Unload Me
End Sub
Private Sub Command2_Click()
GFormReturnValue = vbCancel
Unload Me
End Sub
Public Sub Initialize(theParent As CCmdCalculateValue, NameForCaption As String, Import As CImport)
' If no import object was passed in, use the global default.
If Import Is Nothing Then
Set mImport = GImport
Else
Set mImport = Import
End If
Set mCalcObj = theParent
FillCheckPointCombo Me.cboRHSCheckPoint
Select Case theParent.RHSType
Case eCmdValueTypes.cvtConstant
Me.cboRHSType.ListIndex = 0 'Constant
Me.txtRHSConstant.Text = theParent.RHS
Case eCmdValueTypes.cvtLineOfInput
Me.cboRHSType.ListIndex = 1 ' Line of input
Me.cboRHSCheckPoint.Text = theParent.RHS
Case eCmdValueTypes.cvtDataItem
Dim rec As String, fld As String
theParent.ParseDataItemName theParent.RHS, rec, fld
FillDataItemCombo cboRHSDataItem, rec
Me.cboRHSType.ListIndex = 2 'DataItem
Me.cboRHSCheckPoint = rec
Me.cboRHSDataItem = fld
Case Default
Me.cboRHSType.ListIndex = 0
End Select
Me.txtRHSDelimiter = theParent.RHSDelimiter
Me.chkRHSDelimited = IIf(theParent.RHSDelimited, 1, 0)
Me.txtRHSLength = theParent.RHSLength
Me.txtRHSPosition = theParent.RHSInputLinePosition
With Me.cboOperator
.AddItem "add"
.AddItem "subtract"
.AddItem "multiply"
.AddItem "divide"
Select Case mCalcObj.Operator
Case "+"
.ListIndex = 0
Case "-"
.ListIndex = 1
Case "*"
.ListIndex = 2
Case "/"
.ListIndex = 3
Case Else
.ListIndex = 0
End Select
End With
End Sub
Private Sub Form_Load()
' Set the default return value type.
GFormReturnValue = vbCancel
Me.left = (Screen.Width - Me.Width) / 2
Me.top = (Screen.Height - Me.Height) / 2
End Sub
Private Sub DisplayExpression()
End Sub
Private Sub Form_Unload(Cancel As Integer)
Set mImport = Nothing
End Sub
Private Sub txtRHSConstant_Change()
DisplayExpression
End Sub
Private Sub txtRHSLength_Change()
DisplayExpression
End Sub
Private Sub txtRHSLength_KeyPress(KeyAscii As Integer)
' Only allow numbers and backspace.
If (KeyAscii < 48 Or KeyAscii > 57) And KeyAscii <> 8 Then
KeyAscii = 0
End If
End Sub
Private Sub txtRHSPosition_Change()
DisplayExpression
End Sub
Private Sub txtRHSPosition_KeyPress(KeyAscii As Integer)
' Only allow numbers and backspace.
If (KeyAscii < 48 Or KeyAscii > 57) And KeyAscii <> 8 Then
KeyAscii = 0
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -