modannex.bas

一个VB编写的

        Case "<=", "=<" '嵟戝偑埲忋偱嵟彫偑埲壓偱偁傞-----
            If param <= Min Or param >= Max Then
                RET = MsgBox(Name + " " + Format(Str(Min), UGNG) + " 乣 " + Format(Str(Max), UGNG) + "", 48, "Over Range!")
                oForm.Show
                oKomoku.SetFocus
                GoTo Par_Err000
            End If
        Case Else       '嵟戝偑埲忋偱嵟彫偑傛傝壓偱偁傞-----
            If param < Min Or param >= Max Then
                RET = MsgBox(Name + " " + Format(Str(Min), UGNG) + " 乣 " + Format(Str(Max), UGNG) + "", 48, "Over Range!")
                oForm.Show
                oKomoku.SetFocus
                GoTo Par_Err000
            End If
        End Select
    Case Else           '嵟戝偑傛傝忋偱偁傞-----
        Select Case nCmp
        Case "<=", "=<" '嵟戝偑傛傝忋偱嵟彫偑埲壓偱偁傞-----
            If param <= Min Or param > Max Then
                RET = MsgBox(Name + " " + Format(Str(Min), UGNG) + " 乣 " + Format(Str(Max), UGNG) + "", 48, "Over Range!")
                oForm.Show
                oKomoku.SetFocus
                GoTo Par_Err000
            End If
        Case Else       '嵟戝偑傛傝忋偱嵟彫偑傛傝壓偱偁傞-----
            If param < Min Or param > Max Then
                RET = MsgBox(Name + " " + Format(Str(Min), UGNG) + " 乣 " + Format(Str(Max), UGNG) + "", 48, "Over Range!")
                oForm.Show
                oKomoku.SetFocus
                GoTo Par_Err000
            End If
        End Select
    End Select
    
    GoTo Par_Err001

Par_Err000: '堎忢
    ufTextErrSearch = False
Par_Err001:

End Function

'**********************************************
'*           巊梡僼傽僀儖偺妋擣
'*  僷僗偺桳柍(True:懚嵼偡傞 False:懚嵼偟側偄)
'**********************************************
Public Function DataFileConfirm(ByVal Name As String) As Boolean
    Dim TempAttr As Integer
    Dim RET As Integer
    
    If (Len(Name) = 0) Or (InStr(Name, "*") > 0) Or (InStr(Name, "?") > 0) Then
        DataFileConfirm = False
        Exit Function
    End If
    On Error GoTo ErrorFileExist
    ' 僼傽僀儖偺懏惈傪摼傞
    TempAttr = GetAttr(Name)
    ' 僨傿儗僋僩儕偱偁傞偐偳偆偐挷傋傞
    DataFileConfirm = ((TempAttr And vbDirectory) = 0)
    GoTo ExitFileExist
ErrorFileExist:
    RET = MsgBox(Name + "偺僨乕僞儀乕僗僼傽僀儖傪嶌惉偟傑偡丅", vbOKOnly, "怴婯僨乕僞儀乕僗僼傽僀儖嶌惉")
    DataFileConfirm = False
    Resume ExitFileExist
ExitFileExist:
    On Error GoTo 0
End Function

'***********************************
'*       儕僞乕儞側傜俿俙俛
'***********************************
Public Sub ufKeySelect(ByVal mKeyCode As Integer)
    
    If mKeyCode = 13 Then
        SendKeys "{TAB}"
    End If

End Sub


'***********************************
'*  丂丂 暥帤悢帤寘崌傢偣
'*  varParam:Par_Test.XXXXX(悢帤)
'*  varParam:Par_Test.XXXXX(暥帤)
'*  objText :Par_XXXXX.Text
'*  strPlac :Plc.XXXXX
'***********************************
Public Sub ufTextAjust(ByRef varParam As Variant, ByRef objText As Object, _
                       ByVal strPlac As String, mFlag As Integer)
    Dim varWK As Variant, cWK As String
     
    If TypeName(varParam) = "String" Then
        '暥帤愝掕-----
        If mFlag = 0 Then
            cWK = objText.Text
            Call ufTextChkFName(cWK)
            varParam = plcFormat(cWK, strPlac, Val(strPlac))
            If cWK = "" Then varParam = ""
        End If
        objText.Text = varParam
    Else
        '悢帤愝掕-----
        If mFlag = 0 Then
            Select Case TypeName(varParam)
            Case Is = "Integer"
                varWK = Val(objText.Text)
                If varWK < -32768 Then varWK = 0
                If varWK > 32767 Then varWK = 0
                varParam = Format(varWK, strPlac)
            Case Else
                varWK = Val(objText.Text)
                If varWK < -99999.9 Then varWK = 0
                If varWK > 999999.9 Then varWK = 0
                varParam = Format(varWK, strPlac)
            End Select
        End If
        objText.Text = plcFormat(varParam, strPlac, 8)
    End If
    
End Sub


'***********************************
'*  丂丂 嬛巭暥帤敳偒庢傝
'***********************************
Public Sub ufTextChkFName(ByRef Name As String)

    Dim A As Integer, J As Integer
    Dim B(256) As String
    
    A = Len(Name)
    For J = 1 To A
        B(J) = Mid(Name, J, 1)
    Next J
    Name = ""
    For J = 1 To A
        If (B(J) = " ") And (J = 1) Then GoTo T0001 '1暥帤栚偩偗-----
        If (B(J) = " ") And (B(J - 1) = " ") And (J > 1) Then GoTo T0001 '1暥帤栚埲崀
        If B(J) = " " Then GoTo T0001
        If B(J) = "/" Then GoTo T0001
        If B(J) = "\" Then GoTo T0001
        If B(J) = "<" Then GoTo T0001
        If B(J) = ">" Then GoTo T0001
        If B(J) = "*" Then GoTo T0001
        If B(J) = "?" Then GoTo T0001
        If B(J) = Chr$(&H22) Then GoTo T0001
        If B(J) = "|" Then GoTo T0001
        If B(J) = ":" Then GoTo T0001
        If B(J) = ";" Then GoTo T0001

        Name = Name + B(J)

T0001:
    Next J

End Sub

'***********************************
'*  丂丂 慖戰暥帤斀揮昞帵
'***********************************
Public Sub ufTextSelect(ByRef txt As TextBox)

    With txt
        .SelStart = 0
        .SelLength = Len(.Text)
    End With

End Sub

'***************************************
'*   丂丂丂寘悢忣曬傪撉傒崬傓
'***************************************
Public Sub DeciPlaceS_Load(mSW As Integer, mDgt() As String)
    
    Dim gJ As Integer, gmxWK As Long
    
    gmxWK = UBound(mDgt)
    Select Case mSW
    Case 0
    For gJ = 1 To gmxWK
        mDgt(gJ) = ReadIniString(iniFile$, "昞帵扨埵(N)", CStr(gJ))
    Next gJ
    Case 1
    For gJ = 1 To gmxWK
        mDgt(gJ) = ReadIniString(iniFile$, "昞帵扨埵(kg)", CStr(gJ))
    Next gJ
    End Select
End Sub

'***************************************
'*   丂丂丂寘悢忣曬傪彂偒崬傓
'***************************************
Public Sub DeciPlaceS_Save(mSW As Integer, mDgt() As String)
    
    Dim gRET As Long
    Dim gJ As Integer, gmxWK As Long
    
    gmxWK = UBound(mDgt)
    Select Case mSW
    Case 0
        For gJ = 1 To gmxWK
            gRET = WriteIniString(iniFile$, "昞帵扨埵(N)", CStr(gJ), mDgt(gJ))
        Next gJ
    Case 1
        For gJ = 1 To gmxWK
            gRET = WriteIniString(iniFile$, "昞帵扨埵(kg)", CStr(gJ), mDgt(gJ))
        Next gJ
    End Select
End Sub

'***************************************
'* 丂 寘悢忣曬傪撉傒崬傓(帋尡忦審)
'***************************************
Public Sub DeciPlaceS_Par_Load(mDgt() As String)
    
    Dim gJ As Integer, gmxWK As Long
    
    gmxWK = UBound(mDgt)
    
    For gJ = 1 To gmxWK
        mDgt(gJ) = ReadIniString(iniFile$, "帋尡忦審寘", CStr(gJ))
    Next gJ

End Sub

'***************************************
'*    寘悢忣曬傪彂偒崬傓(帋尡忦審)
'***************************************
Public Sub DeciPlaceS_Par_Save(mDgt() As String)
    
    Dim gRET As Long
    Dim gJ As Integer, gmxWK As Long
    
    gmxWK = UBound(mDgt)
        
    For gJ = 1 To gmxWK
        gRET = WriteIniString(iniFile$, "帋尡忦審寘", CStr(gJ), mDgt(gJ))
    Next gJ

End Sub

'***************************************
'*     僆僼僙僢僩忣曬傪撉傒崬傓
'***************************************
Public Sub Wicked_Offset_Load(mDgt() As String)
    
    Dim gJ As Integer, gmxWK As Long
    
    gmxWK = UBound(mDgt)
    
    For gJ = 1 To gmxWK
        mDgt(gJ) = ReadIniString(iniFile$, "僆僼僙僢僩", CStr(gJ))
    Next gJ

End Sub

'***************************************
'*     僆僼僙僢僩忣曬傪撉傒崬傓
'***************************************
Public Sub Wicked_Offset_Save(mDgt() As String)
    
    Dim gRET As Long
    Dim gJ As Integer, gmxWK As Long
    
    gmxWK = UBound(mDgt)
        
    For gJ = 1 To gmxWK
        gRET = WriteIniString(iniFile$, "僆僼僙僢僩", CStr(gJ), mDgt(gJ))
    Next gJ

End Sub