moduleform.bas

本公司开发得大请油田人事管理系统c/s结构

Attribute VB_Name = "ModuleForm"
Option Explicit

'建立 ComboList of Vsflexgrid(包含两个字段)
Public Function MakeComboListString4VSFlexTwo(ByRef form4This As VSFlexGrid, ByVal strTableName As String, ByVal strFieldNameOne As String, ByVal strFieldNameTwo As String, ByVal strIndexName As String, Optional ByVal strCond As String = "") As String
    
    Dim strSQL As String
    Dim oRs4This As New ADODB.Recordset
On Error GoTo Err:
    strSQL = "select * from " & strTableName & strCond
    If oRs4This.State = adStateOpen Then oRs4This.Close
    oRs4This.Open strSQL, g_oConnection4This, adOpenKeyset, adLockOptimistic
    If oRs4This.EOF = False Then
        strSQL = "if exists (select * from sysobjects where name = 'T_TEMP_VSTWO') drop table T_TEMP_VSTWO"
        g_oConnection4This.Execute strSQL
        
        strSQL = "create table T_TEMP_VSTWO(TEMP_NO int not null,TEMP_NAME Varchar(100) not null)"
        g_oConnection4This.Execute strSQL
            
        Do While oRs4This.EOF = False
            strSQL = "insert into T_TEMP_VSTWO(TEMP_NO,TEMP_NAME) values (" & oRs4This.Fields(strIndexName).Value & ",'" & oRs4This.Fields(strFieldNameOne).Value & "(" & oRs4This.Fields(strFieldNameTwo).Value & ")')"
            g_oConnection4This.Execute strSQL
            oRs4This.MoveNext
        Loop
    Else
        MakeComboListString4VSFlexTwo = " "
    End If
    strSQL = "select * from T_TEMP_VSTWO"
    If oRs4This.State = adStateOpen Then oRs4This.Close
    oRs4This.Open strSQL, g_oConnection4This, adOpenKeyset, adLockOptimistic
    If oRs4This.EOF = False Then
        MakeComboListString4VSFlexTwo = form4This.BuildComboList(oRs4This, "TEMP_NAME", "TEMP_NO", vbGreen)
    Else
        MakeComboListString4VSFlexTwo = " "
    End If
    oRs4This.Close
    Set oRs4This = Nothing
    Exit Function
Err:
    MakeComboListString4VSFlexTwo = " "
End Function
'建立 ComboList of Vsflexgrid
Public Function MakeComboListString4VSFlex(ByRef form4This As VSFlexGrid, ByVal strTableName As String, ByVal strFieldName As String, ByVal strIndexName As String, Optional ByVal strCond As String = "") As String
    
    Dim strSQL As String
    Dim oRs4This As New ADODB.Recordset
    
    strSQL = "select * from " & strTableName & strCond
    oRs4This.Open strSQL, g_oConnection4This, adOpenKeyset, adLockOptimistic
    
    MakeComboListString4VSFlex = form4This.BuildComboList(oRs4This, strFieldName, strIndexName, vbGreen)
    If MakeComboListString4VSFlex = "" Then MakeComboListString4VSFlex = " "
    oRs4This.Close
    Set oRs4This = Nothing
End Function
'填充 ComboBox
Public Sub FillComboBox(Combo4Transfer As Object, ByVal strTableName As String, ByVal strIndex As String, ByVal strValue As String, Optional ByVal Mark As Integer = 0, Optional ByVal strCondition As String = "", Optional ByVal IsAddNull As Boolean = False, Optional ByVal IsNoNull As Boolean = False)
    Dim i As Long
    Dim strTemp As String
    Dim intCount As Long
    Dim oRs4This As New ADODB.Recordset
    Dim Combo4Para As Object
    
    Set Combo4Para = Combo4Transfer
    Combo4Para.Clear
    strTemp = "select distinct " & strValue & "," & strIndex & " from " & strTableName & " " & strCondition
    oRs4This.Open strTemp, g_oConnection4This, adOpenKeyset, adLockOptimistic
       
    If Not oRs4This.EOF Then
        intCount = CLng(oRs4This.RecordCount)
        For i = 0 To intCount - 1
            If IsNull(oRs4This.Fields(strValue).Value) Then
                Combo4Para.AddItem "", i
                Combo4Para.ItemData(i) = ""
            Else
                Combo4Para.AddItem Trim(oRs4This.Fields(strValue).Value), i
                If Mark = 0 Then
                    Combo4Para.ItemData(i) = oRs4This.Fields(strIndex).Value
                End If
            End If
            oRs4This.MoveNext
        Next
    End If
    If IsAddNull = True Then
        Combo4Para.AddItem "空", intCount
        Combo4Para.ItemData(intCount) = "null"
    End If
    If IsNoNull = False Then Combo4Para.AddItem ""
    Combo4Para.ListIndex = -1
    oRs4This.Close
    Set oRs4This = Nothing
End Sub
'使用双字段填充 ComboBox
Public Sub FillComboBoxTwoFields(Combo4Transfer As Object, ByVal strTableName As String, ByVal strIndex As String, ByVal strValueOne As String, ByVal strValueTwo As String, Optional ByVal Mark As Integer = 0, Optional ByVal strCondition As String = "", Optional ByVal IsAddNull As Boolean = False)
    Dim i As Long
    Dim strTemp As String
    Dim intCount As Long
    Dim oRs4This As New ADODB.Recordset
    Dim Combo4Para As Object
    
    Set Combo4Para = Combo4Transfer
    Combo4Para.Clear
    
    strTemp = "select " & strValueOne & "," & strValueTwo & "," & strIndex & " from " & strTableName & " " & strCondition
    
    oRs4This.Open strTemp, g_oConnection4This, adOpenKeyset, adLockOptimistic
    
    If Not oRs4This.EOF Then
        intCount = CLng(oRs4This.RecordCount)
        For i = 0 To intCount - 1
            If IsNull(oRs4This.Fields(strValueOne).Value) Then
                Combo4Para.AddItem "", i
                Combo4Para.ItemData(i) = ""
            Else
                Combo4Para.AddItem Trim(oRs4This.Fields(strValueOne).Value) & "(" & Trim(oRs4This.Fields(strValueTwo).Value) & ")", i
                If Mark = 0 Then
                    Combo4Para.ItemData(i) = oRs4This.Fields(strIndex).Value
                End If
            End If
            oRs4This.MoveNext
        Next
    End If
     If IsAddNull = True Then
        Combo4Para.AddItem "空", intCount
        Combo4Para.ItemData(intCount) = "null"
    End If
    Combo4Para.AddItem " "
    Combo4Para.ListIndex = -1
    oRs4This.Close
    Set oRs4This = Nothing
End Sub
'发现索引
Public Function FindIndex(ByVal strValue, Combo4Transfer As Object) As Long
    Dim i As Long
    Dim list As Object
    Set list = Combo4Transfer
    
    FindIndex = -1
    If list.ListCount > 0 Then
        For i = 0 To list.ListCount - 1
            If strValue = list.ItemData(i) Then
                FindIndex = i
                Exit Function
            End If
        Next
    End If
End Function
'add by lzg 显示与SScomboboxEx相关连的内容
Public Sub DisplayRelateItems(ByVal SScomboxEx4Temp As SSComboBoxEx)
    Dim i As Long
    With SScomboxEx4Temp
        .HistoryList.ListItems.Clear
        .HistoryList.MaxListItems = 30000
        For i = 0 To .ListCount - 1
            If UCase(.ListItems(i).text) Like UCase(.text) & "*" Then
                .HistoryList.ListItems.Add , , .ListItems(i).text
            End If
        Next i
    End With
End Sub
'add by lzg 检查输入SScomboboxEx的文本是否有效
Public Sub CheckValidate(ByVal SScomboxEx4Temp As SSComboBoxEx)
    Dim i As Long
'    If Trim(SScomboxEx4Temp.text) = "" Or SScomboxEx4Temp.ListIndex = -1 Then
    If Trim(SScomboxEx4Temp.text) = "" Then
        SScomboxEx4Temp.ListIndex = -1
        SScomboxEx4Temp.text = ""
        Exit Sub
    End If
    SScomboxEx4Temp.text = Trim(SScomboxEx4Temp.text)
    For i = 0 To SScomboxEx4Temp.ListCount - 1
        If UCase(SScomboxEx4Temp.text) = UCase(SScomboxEx4Temp.ListItems(i).text) Then
            SScomboxEx4Temp.text = SScomboxEx4Temp.ListItems(i).text
            Exit Sub
        End If
    Next i
    SScomboxEx4Temp.text = ""
End Sub
'有条件的filllist
Public Sub FillListBySql(Combo4Para As ComboBox, ByVal strTableName As String, ByVal strIndex As String, ByVal strValue As String, ByVal Sql4This As String)
    Dim i As Long
    Dim intCount As Long
    Dim oRs4This As New ADODB.Recordset
    
    Combo4Para.Clear
    
    oRs4This.Open Sql4This, g_oConnection4This, adOpenKeyset, adLockOptimistic
    
    If Not oRs4This.EOF Then
        intCount = CInt(oRs4This.RecordCount)
        For i = 0 To intCount - 1
    
            If IsNull(oRs4This.Fields(strValue).Value) Then
                Combo4Para.AddItem "", i
                Combo4Para.ItemData(i) = ""
                
            Else
                Combo4Para.AddItem oRs4This.Fields(strValue).Value, i
                Combo4Para.ItemData(i) = oRs4This.Fields(strIndex).Value
            End If
            oRs4This.MoveNext
            
        Next
    Else
        'Combo4Para.AddItem "", 0
    End If
    Combo4Para.ListIndex = -1
    oRs4This.Close
    Set oRs4This = Nothing

End Sub
'填充 ComboBox
Public Sub FillComboBoxByBxm(Combo4Transfer As Object, ByVal strTableName As String, ByVal strIndex As String, ByVal strValue As String, Optional ByVal Mark As Integer = 0, Optional ByVal strCondition As String = "", Optional ByVal IsAddNull As Boolean = False, Optional ByVal IsNoNull As Boolean = False)
    Dim i As Long
    Dim strTemp As String
    Dim intCount As Long
    Dim oRs4This As New ADODB.Recordset
    Dim Combo4Para As Object
    
    Set Combo4Para = Combo4Transfer
    Combo4Para.Clear
    'edit by bxm 2002-06-09
    If strIndex <> "" Then
        strTemp = "select distinct " & strValue & " from " & strTableName & " " & strCondition
        
    Else
        strTemp = "select distinct " & strValue & "," & strIndex & " from " & strTableName & " " & strCondition
    End If
    
    oRs4This.Open strTemp, g_oConnection4This, adOpenKeyset, adLockOptimistic
       
    If Not oRs4This.EOF Then
        intCount = CLng(oRs4This.RecordCount)
        For i = 0 To intCount - 1
            If IsNull(oRs4This.Fields(strValue).Value) Then
                Combo4Para.AddItem "", i
                Combo4Para.ItemData(i) = ""
            Else
                
                Combo4Para.AddItem Trim(oRs4This.Fields(strValue).Value), i
                If Mark = 0 Then
                    Combo4Para.ItemData(i) = oRs4This.Fields(strIndex).Value
                End If
            End If
            oRs4This.MoveNext
        Next
    End If
    If IsAddNull = True Then
        Combo4Para.AddItem "空", intCount
        Combo4Para.ItemData(intCount) = "null"
    End If
    If IsNoNull = False Then Combo4Para.AddItem " "
    Combo4Para.ListIndex = -1
    oRs4This.Close
    Set oRs4This = Nothing
End Sub