wholemodule.bas

水电费收费管理系统

Attribute VB_Name = "wholemodule"
Public a As String
Public bookmarklogin As Variant
Public config As clsConfig
Public Const WS_THICKFRAME = &H40000
Public Const GWL_STYLE = (-16)
Public oper1 As String
Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, _
        ByVal nIndex As Long) As Long
        
Declare Sub SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, _
        ByVal nIndex As Long, ByVal dwNewLong As Long)




Sub Main()
    Dim cnCfg As New ADODB.Connection
    Dim rst As New ADODB.Recordset
    Dim strsql As String
    Dim oper1 As String
    cnCfg.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\zdxconfig.mdb;Persist Security Info=False"
    cnCfg.Open
    strsql = "select * from dbconfig"
    rst.Open strsql, cnCfg, adOpenStatic, adLockReadOnly
    If Not rst.EOF Then
        Set config = New clsConfig
        config.FilePath = rst("dbPath")
        config.FileName = rst("dbname")
        config.cnZdx.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\" & config.FileName & ";Persist Security Info=False"
        config.cnZdx.Open
        
    Else
        MsgBox "there are errors in startup"
    End If
    rst.Close
  
    
    frmbackup.Show vbNormal
    
    login.Show vbNormal
    
End Sub




















Public Sub Fillcomb(comb1 As ComboBox, strsql As String, STR2 As String)
   
    Dim rst As New ADODB.Recordset

rst.Open strsql, config.cnZdx, adOpenStatic, adLockReadOnly
Do While Not rst.EOF
     
comb1.AddItem "" & rst(STR2)

       rst.MoveNext
    Loop
    rst.Close
  Set rst = Nothing
  comb1.ListIndex = 0
End Sub
Public Function changedata(str1 As Single) As Single
Dim TEMP As Single

 TEMP = str1 - Int(str1)


If TEMP > 0 Then
TEMP = 1
End If
changedata = TEMP + Int(str1)


End Function
Public Function CHECSTR(str1 As String) As Boolean
If Mid(str1, 1, 1) = "南" Or Mid(str1, 1, 1) = "北" Then

  On Error GoTo e:
 If VAL(Mid(str1, 2, InStr(1, str1, "-") - 1)) > 0 And VAL(Mid(str1, 2, InStr(1, str1, "-") - 1)) < 999 Then
  
   If VAL(Mid(str1, InStr(1, str1, "-") + 1)) > 0 And VAL(Mid(str1, InStr(1, str1, "-") + 1)) < 999 Then
   CHECSTR = True
   Else
   GoTo e:
   End If
Else
GoTo e:
End If
Else
GoTo e:
End If
Exit Function

e: CHECSTR = False
 

End Function
Function sLowerToUpper(iValue As Integer) As String
    Select Case iValue
        Case 0
            sLowerToUpper = "零"
        Case 1
            sLowerToUpper = "壹"
        Case 2
            sLowerToUpper = "贰"
        Case 3
            sLowerToUpper = "叁"
        Case 4
            sLowerToUpper = "肆"
        Case 5
            sLowerToUpper = "伍"
        Case 6
            sLowerToUpper = "陆"
        Case 7
            sLowerToUpper = "柒"
        Case 8
            sLowerToUpper = "捌"
        Case 9
            sLowerToUpper = "玖"
    End Select
End Function

Function test(iValue As String, iType As Integer) As String
    Dim iLen As Integer, I As Integer
    iLen = Len(iValue)
    If iType = 1 Then
        test = ""
    Else
        test = ""
    End If
    For I = 1 To iLen
        If iType = 1 Then
            test = test & sLowerToUpper(VAL(Right(Left(iValue, I), 1))) & test1(iLen - I + 1)
        ElseIf iType = 2 Then
            test = test & sLowerToUpper(VAL(Right(Left(iValue, I), 1))) & "  "
        End If
    Next
End Function

Function test1(iSit As Integer) As String
    Select Case iSit
        Case 0
            test1 = "整"
        Case 1
            test1 = "分"
        Case 2
            test1 = "角"
        Case 3
            test1 = "元"
        Case 4, 8, 12
            test1 = "拾"
        Case 5, 9, 13
            test1 = "百"
        Case 6, 10, 14
            test1 = "仟"
        Case 7
            test1 = "万"
        Case 11
            test1 = "亿"
    End Select
End Function
Function chcdata(str1 As String) As Boolean

On Error GoTo e:
If Mid(str1, 1, InStr(1, str1, ".") - 1) >= 0 And Mid(str1, 1, InStr(1, str1, ".") - 1) < 999999 Then

If Mid(str1, InStr(1, str1, ".") + 1) >= 0 And Mid(str1, InStr(1, str1, ".") + 1) < 999999 Then

chcdata = True
Else
GoTo e:

End If
Else
GoTo e:
End If
Exit Function
e:
If VAL(str1) >= 0 Then
 On Error GoTo g
chcdata = True
Else
g: chcdata = False
End If
End Function