其他数据库

开发平台：
Visual Basic

modCommFun.bas：源码内容
							Attribute VB_Name = "modCommFun"
Option Explicit
Global Const gFIXEDROWS = 1
Public Const gGridBackColor = &H80000018
Public Const gGridForeColor = &H0
Public Const gCellSelBackColor = &H80000001 '查询结果的背景色
Public Const gCellSelForeColor = vbWhite
Public Const gTRUE = -1
Public Const gFALSE = 0
Public Function EraseSpecialSign(ByVal Str As String) As String '过滤'"
Dim m_Ch As String
Dim i As Integer
    EraseSpecialSign = ""
    For i = 1 To Len(Str)
        m_Ch = Mid(Str, i, 1)
        If m_Ch <> "'" And Not (AscB(LeftB(m_Ch, 1)) = 34 And AscB(RightB(m_Ch, 1)) = 0) Then
            EraseSpecialSign = EraseSpecialSign & m_Ch
        End If
    Next i
End Function
Public Function CheckIsDigit(KeyAscii As Integer, Optional TempStr As String) As Integer
    If TempStr = "Price" Then
        If KeyAscii <> 46 And (KeyAscii < 48 Or KeyAscii > 57) Then
            CheckIsDigit = 0
        Else
            CheckIsDigit = KeyAscii
        End If
    Else
        If KeyAscii < 48 Or KeyAscii > 57 Then
            CheckIsDigit = 0
        Else
            CheckIsDigit = KeyAscii
        End If
    End If
End Function
Public Sub GotFocus(Text1 As TextBox)
    Text1.SelStart = 0
    Text1.SelLength = Len(Text1.Text)
End Sub
Public Sub SendKeyTab(KeyCode As Integer)
    If KeyCode = 13 Then
        SendKeys "{TAB}"
    End If
End Sub
Public Function GetTheVeryLen(m_Txt As String, m_Len As Integer) As String
    GetTheVeryLen = StrConv(Trim(m_Txt), vbNarrow)
    GetTheVeryLen = LeftB(GetTheVeryLen, m_Len)
End Function
Private Function DeleteLastPart(Str As String) As String
Dim i As String
    i = InStr(Str, "(")
    If i > 0 Then
        Str = Left(Str, i - 1)
    Else
        i = InStr(Str, "（")
        If i > 0 Then
            Str = Left(Str, i - 1)
        End If
    End If
    DeleteLastPart = Str
End Function
Public Function FixedLen(tempVar As Variant, ByVal tempLen As Long, Optional ByVal Opsition As Long = 0) As String
    Dim tempString As String
    Dim ByteLen As Long
    tempString = Trim(CStr(tempVar))
    
    If IsNumeric(tempString) Then
        tempString = Left(tempString, tempLen)
        ByteLen = Len(tempString)
    Else
        tempString = Left(tempString, Int(tempLen / 2))
        ByteLen = LenB(StrConv(tempString, vbFromUnicode))
    End If
    
    If Opsition = 0 Then '左对齐
        FixedLen = tempString & Space(tempLen - ByteLen)
    ElseIf Opsition = 1 Then '右对齐
        FixedLen = Space(tempLen - ByteLen) & tempString
    ElseIf Opsition = 2 Then '居中
        FixedLen = Space(Int((tempLen - ByteLen) / 2)) & tempString & Space(tempLen - ByteLen - Int((tempLen - ByteLen) / 2))
    End If
    
End Function
Public Sub EditGridTxt(msfGrid As MSFlexGrid, obj As Control, Optional aPosition As AlignmentConstants = vbLeftJustify)
    Dim i As Long
    With msfGrid
        If .row = 0 Then
            obj.Visible = False
            Exit Sub
        End If
        If TypeOf obj Is TextBox Or TypeOf obj Is ComboBox Then
            obj.Visible = False
            obj.Width = .CellWidth
            If TypeOf obj Is TextBox Then
                obj.Text = ""
                obj.Top = .Top + .CellTop
                obj.Left = .Left + .CellLeft
                obj.Height = .CellHeight
                obj.Left = .Left + .CellLeft
                obj.Alignment = aPosition
                obj.Text = .Text
                obj.SelStart = 0
                obj.SelLength = Len(obj)
            ElseIf TypeOf obj Is ComboBox Then
                obj.Top = .Top + .CellTop
                obj.Left = .Left + .CellLeft
                For i = 0 To obj.ListCount
                    If obj.List(i) = Trim(.Text) Then
                        If Trim(.Text) = Empty Then
                            If obj.ListCount > 0 Then
                                obj.ListIndex = 0
                            End If
                        Else
                            obj.ListIndex = i
                        End If
                        Exit For
                    End If
                Next
            End If
        
            obj.Visible = True
            obj.SetFocus
        End If
    End With
End Sub
Public Function GetMaxDayInAMonth(myYear As Integer, MyMonth As Integer) As Integer
If MyMonth = 2 Then
    If (myYear Mod 400) = 0 Then
        GetMaxDayInAMonth = 29
    ElseIf (myYear Mod 100) = 0 Then
        GetMaxDayInAMonth = 28
    ElseIf (myYear Mod 4) = 0 Then
        GetMaxDayInAMonth = 29
    Else
        GetMaxDayInAMonth = 28
    End If
Else
    If MyMonth < 8 Then
        GetMaxDayInAMonth = IIf((MyMonth Mod 2) = 0, 30, 31)
    Else
        GetMaxDayInAMonth = IIf((MyMonth Mod 2) = 0, 31, 30)
    End If
End If
End Function
Public Function ValiText(KeyIn As Integer, ValidateString As String, Editable As Boolean) As Integer
    Dim ValidateList As String
    Dim KeyOut As Integer
    If Editable = True Then
         ValidateList = UCase(ValidateString) & Chr(8)
    Else
         ValidateList = UCase(ValidateString)
    End If
    If InStr(1, ValidateList, UCase(Chr(KeyIn)), 1) > 0 Then
        KeyOut = KeyIn
    Else
        KeyOut = 0
        Beep
    End If
    ValiText = KeyOut
End Function
'Private Sub SetHandIco()
'    Dim picPath As String
'    picPath = App.Path + "pichand.ico"
'    If Dir(picPath) <> "" Then
'        Set gicoHand = LoadPicture(picPath)
'    End If
'End Sub
Public Sub SortGridByCol(myGrid As MSFlexGrid)
    With myGrid
        If .row = .FixedRows Then
            .Sort = 1
        End If
    End With
End Sub
Public Sub FillCbo(myCbo As ComboBox, myArray() As ItemStruc, Optional IniValue As Integer = 1) 'optional为所有类别准备
    Dim i As Integer
    With myCbo
        .Clear
        If UBound(myArray) >= 1 Then
            For i = IniValue To UBound(myArray)
                .AddItem myArray(i).Name
                .ItemData(.NewIndex) = myArray(i).ID
            Next
            If .ListCount > 0 Then
                .ListIndex = 0
            End If
        End If
    End With
End Sub
Public Sub LookForCbo(myCbo As ComboBox, intFind As Integer)
    Dim i As Integer
    With myCbo
        For i = 0 To .ListCount - 1
            If .ItemData(i) = intFind Then
                .ListIndex = i
                Exit For
            End If
        Next
    End With
End Sub
Public Sub LookForCboByStr(myCbo As ComboBox, strFind As String)
    Dim i As Integer
    With myCbo
        For i = 0 To .ListCount - 1
            If Trim(.List(i)) = strFind Then
                .ListIndex = i
                Exit For
            End If
        Next
    End With
End Sub
Public Sub getItemData(cboMycbo As ComboBox, myItem As Integer)
    With cboMycbo
        If .ListIndex = -1 Then
            myItem = .ItemData(0)
        Else
            myItem = .ItemData(.ListIndex)
        End If
    End With
End Sub
Public Sub SetGridColor(myGrid As MSFlexGrid)
    With myGrid
        .RowHeight(.FixedRows - 1) = 300
        .BackColor = gGridBackColor '&H80000018  '&HC0FFFF '&HC0FFC0
        .BackColorFixed = &HC0C0C0  '&HC0FFC0
        .ForeColorFixed = &HC00000  ' &H0&      '&HFF00FF  '&HC0&    &HFF0000   '  '&H80000002 '&HC00000   '
        .ForeColor = gGridForeColor ' &H0
        .BackColorSel = &H8000000D '&HC00000
        .GridColor = &HC0C0C0
        .GridColorFixed = &H0&      ' &H808080  ' &HC0C0C0
        '.ForeColorFixed =
        .BackColorBkg = &H80000018 ' &HFFFFFF ''&HC0FFFF
        .AllowUserResizing = flexResizeColumns
        .ScrollBars = flexScrollBarBoth
        .Rows = gFIXEDROWS
    End With
End Sub
Public Sub ToDeleteFromGrid(myGrid As MSFlexGrid, intKeyRow As Integer, strMsg As String, strMyDataBase As Database, strTableName As String, strDeleteField As String)
    If Trim(strMsg) <> Empty Then
        If MsgBox(strMsg, _
            vbQuestion + vbYesNo + vbDefaultButton2, _
            gTitle) = vbNo Then Exit Sub
    End If
    Dim strKey As String
    With myGrid
        strKey = Trim(.TextMatrix(.row, intKeyRow))
        SetDelFlagForTable Trim(strKey), strMyDataBase, strTableName, strDeleteField, True
        If .Rows = .FixedRows + 1 Then
            .Rows = .FixedRows
        Else
            .RemoveItem .row
        End If
    End With
End Sub
Public Sub SetDelFlagForTable(varKey As Variant, strMyDataBase As Database, strTableName As String, strDeleteField As String, Optional isStr As Boolean = True)
    Dim Sql As String
    Sql = "update " & strTableName _
            & " set F_DelFlag=" & gTRUE _
            & " where " & strDeleteField & "="
    If isStr Then
        Sql = Sql & "'" & varKey & "'"
    Else
        Sql = Sql & varKey
    End If
    strMyDataBase.Execute Sql
End Sub
Public Sub DeleteFromDataBase(varKey As Variant, strMyDataBase As Database, strTableName As String, strDeleteField As String, Optional isStr As Boolean = True)
    Dim Sql As String
    Sql = "delete * from " & strTableName _
            & " where " & strDeleteField & "="
    If isStr Then
        Sql = Sql & "'" & varKey & "'"
    Else
        Sql = Sql & varKey
    End If
    strMyDataBase.Execute Sql
End Sub
Public Function IsExist(strMyDataBase As Database, strTableName As String, strFindField As String, varFindValue As Variant, Optional isStr As Boolean = True) As Boolean
    Dim Rst As Recordset
    Dim Sql As String
    Sql = "select * from " & strTableName & _
        " where " & strFindField & "=" '& strFindValue & "'"
    If isStr Then
        Sql = Sql & "'" & varFindValue & "'"
    Else
        Sql = Sql & varFindValue
    End If
    Set Rst = strMyDataBase.OpenRecordset(Sql, dbOpenSnapshot)
    If Rst.RecordCount > 0 Then
        IsExist = True
    Else
        IsExist = False
    End If
    Rst.Close
    Set Rst = Nothing
End Function
Public Sub CloseColor(msfGrid As MSFlexGrid)
    Dim i As Integer
    Dim J As Integer
    With msfGrid
        If .Redraw Then .Redraw = False
        For i = .FixedRows To .Rows - 1
            .row = i
            .col = 0
            If .CellBackColor = gCellSelBackColor Then
                For J = 0 To .Cols - 1
                    .col = J
                    .CellBackColor = gGridBackColor
                    .CellForeColor = gGridForeColor
                Next
            End If
        Next
        .Redraw = True
    End With
End Sub
Public Sub SetTxtPosition(tmpGrid As MSFlexGrid, tmpTxt As TextBox)
    With tmpGrid
        tmpTxt.Top = .Top + .CellTop
        tmpTxt.Left = .Left + .CellLeft
        tmpTxt.Width = .CellWidth
        tmpTxt.Height = .CellHeight
        tmpTxt = .Text
        tmpTxt.Visible = True
        tmpTxt.SetFocus
    End With
End Sub
Public Function JoinSqlStr(varToLook As Variant, WhereFlag As Boolean, strFindField As String, Optional isStr As Boolean = True) As String
    Dim Sql As String
    If isStr Then
        If varToLook = Empty Then
            JoinSqlStr = Empty
            Exit Function
        End If
    Else
        If varToLook = 0 Then
            JoinSqlStr = Empty
            Exit Function
        End If
    End If
    
    If WhereFlag Then
        Sql = Sql & " and "
    Else
        Sql = Sql & " Where "
        WhereFlag = True
    End If
    Sql = Sql & " InStr(1," & strFindField & ",'" & varToLook & "',0)>0 "
    JoinSqlStr = Sql
End Function
Public Sub SaveRegister()
    Dim AppSet As String
    Dim StrSet As String
    AppSet = "OutProd"
    StrSet = "Setting"
    SaveSetting AppSet, StrSet, "OwnName", gOwnName
    SaveSetting AppSet, StrSet, "OwnAddress", gOwnAddress
    SaveSetting AppSet, StrSet, "OwnPhone", gOwnPhone
    SaveSetting AppSet, StrSet, "OwnFax", gOwnFax
    SaveSetting AppSet, StrSet, "OwnPost", gOwnPost
    SaveSetting AppSet, StrSet, "OwnOwner", gOwnOwner
End Sub
Public Sub GetRegister()
    Dim AppSet As String
    Dim StrSet As String
    AppSet = "OutProd"
    StrSet = "Setting"
    Const DEFAULTNAME = "温州现代集团"
    Const DEFAULTADDRESS = "温州市金丝桥路20号"
    Const DEFAULTPHONE = "(86-577)8848030"
    Const DEFAULTFAX = "(86-577)8845711"
    Const DEFAULTPOST = "325000"
    Const DEFAULTOWNER = ""
    Const DEFAULTLOGINNAME = "默认用户"
    Const DEFAULTLOGINPASS = ""
    gLoginName = GetSetting(AppSet, StrSet, "LoginName", DEFAULTLOGINNAME)
    gOwnName = GetSetting(AppSet, StrSet, "OwnName", DEFAULTNAME)
    gOwnAddress = GetSetting(AppSet, StrSet, "OwnAddress", DEFAULTADDRESS)
    gOwnPhone = GetSetting(AppSet, StrSet, "OwnPhone", DEFAULTPHONE)
    gOwnFax = GetSetting(AppSet, StrSet, "OwnFax", DEFAULTFAX)
    gOwnPost = GetSetting(AppSet, StrSet, "OwnPost", DEFAULTPOST)
    gOwnOwner = GetSetting(AppSet, StrSet, "OwnOwner", DEFAULTOWNER)
End Sub
Public Sub KeyDownByUpDown(tmpGrid As MSFlexGrid, KeyCode As Integer)
    Dim sRow, SCol As Integer
    With tmpGrid
        Select Case KeyCode
            Case vbKeyDown
                sRow = .row + 1
                If sRow = .Rows Then
                    sRow = .FixedRows + 1
                End If
            Case vbKeyUp
                sRow = .row - 1
                If sRow = 0 Then
                    sRow = .Rows - 1
                End If
        End Select
        SCol = .col
        .row = sRow
        .col = SCol
        .RowSel = sRow
    End With
End Sub

						