frmqueryimg.frm

用vb6.0实现的一个可以通用的企业档案管理系统。

        txtSSSQ1.BackColor = &H8000000F
        txtSSSQ2.BackColor = &H8000000F
    End If
End Sub

Private Sub cmdExit_Click()
    Unload Me
End Sub

Private Sub cmdQuery_Click()

    Dim Msg As String
    
    If fQueryResult Is Nothing Then
        Set fQueryResult = New frmQueryResult
    End If

    If lstQY.ListCount = 0 Then
        If lstCase.ListCount = 0 Then
            Msg = MsgBox("您没有选择任何企业或文书,系统默认将查询所有企业的所有文书!" & vbCrLf & "该过程将会比较漫长,请耐心等待!", vbOKCancel + vbInformation)
            Select Case Msg
                Case vbOK
                    fQueryResult.bCaseIsEmpty = True
                    fQueryResult.bCompanyIsEmpty = True
                Case vbCancel
                    Exit Sub
            End Select
        Else
            Msg = MsgBox("您没有选择企业,系统默认将查询有选定文书的所有企业!", vbOKCancel + vbInformation)
            Select Case Msg
                Case vbOK
                    fQueryResult.bCompanyIsEmpty = True
                Case vbCancel
                    Exit Sub
            End Select
        End If
    Else
        If lstCase.ListCount = 0 Then
            Msg = MsgBox("您没有选择文书.系统默认将查询选定企业的所有文书!", vbInformation)
            Select Case Msg
                Case vbOK
                    fQueryResult.bCaseIsEmpty = True
                Case vbCancel
                    Exit Sub
            End Select
        End If
    End If
    
    '导入日期
    If chkDate.Value = vbChecked Then
        fQueryResult.dImportDate1 = Format(DTPDate1.Value, "Long Date")
        fQueryResult.dImportDate2 = Format(DTPDate2.Value, "Long Date")
    Else
        fQueryResult.dImportDate1 = vbNullString
        fQueryResult.dImportDate2 = vbNullString
    End If
    
    If chkSSSQ.Value = vbChecked Then
        '所属时期1
        If IsDate(Left(txtSSSQ1.Text, 4) & "/" & Right(txtSSSQ1.Text, 2) & "/" & "01") Then
            fQueryResult.strSSSQ1 = txtSSSQ1.Text
        Else
            MsgBox "所属时期无效,请重新输入!", vbExclamation
            txtSSSQ1.SetFocus
            SendKeys "{Home}+{End}"
            Exit Sub
        End If
        '所属时期2
        If IsDate(Left(txtSSSQ2.Text, 4) & "/" & Right(txtSSSQ2.Text, 2) & "/" & "01") Then
            fQueryResult.strSSSQ2 = txtSSSQ2.Text
        Else
            MsgBox "所属时期无效,请重新输入!", vbExclamation
            txtSSSQ2.SetFocus
            SendKeys "{Home}+{End}"
            Exit Sub
        End If
    Else
        fQueryResult.strSSSQ1 = vbNullString
        fQueryResult.strSSSQ2 = vbNullString
    End If
    
    fQueryResult.Show 0
    Unload Me
End Sub

Private Sub Form_Unload(Cancel As Integer)

    '清除原有数组元素
    ReDim CompanyCodeName(0)
    ReDim CaseCodeName(0)
    
    If UBound(CompanyCaseType) > 0 Then
        ReDim CompanyCaseType(0)
    End If
End Sub

Private Sub frmSplitter_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    With frmSplitter
        frmSplitter.Move .Left, .Top, .Width, .Height
    End With
    mbMoving = True
End Sub

Private Sub frmSplitter_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim sglPos As Single
    
    If mbMoving Then
        sglPos = X + frmSplitter.Left
        If sglPos < sglSplitLimit Then
            frmSplitter.Left = sglSplitLimit
        ElseIf sglPos > Me.Width - sglSplitLimit Then
            frmSplitter.Left = Me.Width - sglSplitLimit
        Else
            frmSplitter.Left = sglPos
        End If
    End If

End Sub

Private Sub frmSplitter_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    SizeControls frmSplitter.Left
    mbMoving = False
End Sub

Sub SizeControls(X As Single)
    On Error Resume Next
    
    '设置 x
    If X < sglSplitLimit Then X = sglSplitLimit
    If X > Me.Width - sglSplitLimit Then X = Me.Width - sglSplitLimit
        
    '设置控件的 Left属性
    frmSplitter.Left = X
    lstQY.Left = 180
    lstCase.Left = X + frmSplitter.Width - 10
    
    '设置控件的Width属性
    lstQY.Width = X - 115
    lstCase.Width = Me.Width - X - 370

End Sub

Private Sub Form_Load()
    
    On Error GoTo ErrorHandler
    
    '初始化日期
    chkDate.Value = vbChecked
    DTPDate1.Value = DateAdd("D", -1, Date)
    DTPDate2.Value = Date
    DTPDate1.Format = dtpLongDate
    DTPDate2.Format = dtpLongDate
    
    '初始化所属时期
    chkSSSQ.Value = vbChecked
    txtSSSQ1 = Year(DateAdd("M", -1, Date)) & Format(DatePart("M", DateAdd("M", -1, Date)), "0#")
    txtSSSQ2 = Year(Date) & Format(Month(Date), "0#")
    
    '在lstQY和lstCase中加入选定的项目
    Dim i As Integer
    For i = 0 To UBound(CompanyCodeName)
        If CompanyCodeName(i) <> vbNullString Then
            lstQY.AddItem CompanyCodeName(i)
        End If
    Next i
    For i = 0 To UBound(CaseCodeName)
        If CaseCodeName(i) <> vbNullString Then
            lstCase.AddItem Left(CaseCodeName(i), Len(CaseCodeName(i)) - 1)
        End If
    Next i
    
Exit Sub
ErrorHandler:
    If Err Then
        If Err.Number = 9 Then
            Err.Clear
        Else
            MsgBox Err.Description & "  " & Err.Number, vbCritical
            Err.Clear
        End If
    End If
End Sub

Private Function MakeQueryString() As String
'****************************************************
'功能：生成查询SQL语句，用于查询文书
'调用：本窗体的cmdQuery_click
'****************************************************
On Error Resume Next

Dim nComp As Integer
Dim nCase As Integer
Dim strTemp As String

Dim strQYBM As String
Dim strCase As String

strQYBM = " QYBM='"
strCase = " Img_Case_Code='"

'查询所有企业的选定类型的文书
If lstQY.ListCount = 0 And lstCase.ListCount > 0 Then
    For nCase = 0 To UBound(CaseCodeName)
        If nCase = 0 Then
            strTemp = strTemp & strCase & Left(CaseCodeName(nCase), 4) & "'"
        Else
            strTemp = strTemp & " OR " & strCase & Left(CaseCodeName(nCase), 4) & "'"
        End If
    Next nCase
End If

'查询选定类型文书所具有的企业
If lstQY.ListCount > 0 And lstCase.ListCount = 0 Then
    For nComp = 0 To UBound(CompanyCodeName)
        If nComp = 0 Then
            strTemp = strTemp & strQYBM & Left(CompanyCodeName(nComp), QYBMLength) & "'"
        Else
            strTemp = strTemp & " OR " & strQYBM & Left(CompanyCodeName(nComp), QYBMLength) & "'"
        End If
    Next nComp
End If

'查询选定企业的选定文书
If lstQY.ListCount > 0 And lstCase.ListCount > 0 Then
    For nComp = 0 To UBound(CompanyCodeName)
        strTemp = strTemp & "( " & strQYBM & Left(CompanyCodeName(nComp), QYBMLength) & "'"
        strTemp = strTemp & " AND ( "
        For nCase = 0 To UBound(CaseCodeName)
            If nCase = 0 Then
                strTemp = strTemp & strCase & Left(CaseCodeName(nCase), 4) & "'"
            Else
                strTemp = strTemp & " OR " & strCase & Left(CaseCodeName(nCase), 4) & "'"
            End If
        Next nCase
        strTemp = strTemp & ")"
        If chkDate.Value = 1 Then
            strTemp = strTemp & " AND" & " Img_Import_Date>='" & DTPDate1.Value & "' AND Img_Import_Date<='" & DTPDate2.Value & "'"
        End If
        If chkSSSQ.Value = 1 Then
            strTemp = strTemp & " AND" & " Img_SSSQ>='" & txtSSSQ1.Text & "' AND Img_SSSQ<='" & txtSSSQ2.Text & "'"
        End If
        strTemp = strTemp & ") "
        If nComp < UBound(CompanyCodeName) Then
            strTemp = strTemp & " OR "
        End If
    Next nComp
End If

MsgBox strTemp
MakeQueryString = strTemp

Exit Function
ErrorHandler:
    If Err Then
        MsgBox Err.Description, vbCritical
        Err.Clear
        MakeQueryString = vbNullString
    End If
End Function

Private Sub UpDown1_DownClick()
    Dim tmpDate As String
    
    tmpDate = DateValue(Left(txtSSSQ1, 4) & "/" & Right(txtSSSQ1, 2) & "/01")
    txtSSSQ1.Text = Year(DateAdd("M", -1, tmpDate)) & Format(Month(DateAdd("M", -1, tmpDate)), "0#")
End Sub

Private Sub UpDown1_UpClick()
    Dim tmpDate As String
    
    tmpDate = DateValue(Left(txtSSSQ1, 4) & "/" & Right(txtSSSQ1, 2) & "/01")
    txtSSSQ1.Text = Year(DateAdd("M", 1, tmpDate)) & Format(Month(DateAdd("M", 1, tmpDate)), "0#")
End Sub

Private Sub UpDown2_DownClick()
    Dim tmpDate As String
    
    tmpDate = DateValue(Left(txtSSSQ2, 4) & "/" & Right(txtSSSQ2, 2) & "/01")
    txtSSSQ2.Text = Year(DateAdd("M", -1, tmpDate)) & Format(Month(DateAdd("M", -1, tmpDate)), "0#")
End Sub

Private Sub UpDown2_UpClick()
    Dim tmpDate As String
    
    tmpDate = DateValue(Left(txtSSSQ2, 4) & "/" & Right(txtSSSQ2, 2) & "/01")
    txtSSSQ2.Text = Year(DateAdd("M", 1, tmpDate)) & Format(Month(DateAdd("M", 1, tmpDate)), "0#")
End Sub