frmgrid.frm

中专学校的学生操行分管理系统,包含了网络查询的功能

                bReportCalc = True
            Case "平均值"
                strCalc = strCalc & ",Round(Avg([" & adoReport.Recordset.Fields(i - 1).Name & "])," & CStr(iPlace) & ")"
                bReportCalc = True
        End Select
    Next i
    If bReportCalc Then
        ReDim varReportCalc(iCount - 1)
        strTable = LCase(strRecordSource)
        iPos = InStr(1, strTable, "order by")
        If iPos > 0 Then strTable = Mid$(strRecordSource, 1, iPos - 1)
        strCalc = "Select " & Mid$(strCalc, 2) & " From (" & strTable & ") As CalcTemp"
        adoCalc.ConnectionString = strConnectionString
        adoCalc.UserName = strUserName
        adoCalc.PassWord = strPassWord
        adoCalc.RecordSource = strCalc
        adoCalc.Refresh
        For i = 0 To iCount - 1
            varReportCalc(i) = adoCalc.Recordset(i).Value
        Next i
    End If
    
    Set rstReport = adoReport.Recordset
    Set objGrid = grdReport.Columns
    If optCol(0).Value Then
        intHeaderHeight = 8
    Else
        intHeaderHeight = 16
    End If
    intRowHeight = 7
    
    frmQueryPrint.Show vbModal, Me
    Me.MousePointer = 0
End Sub

Private Sub cmdSave_Click()
    If Not CheckColTree Then Exit Sub
    Me.MousePointer = 11
    SaveColTree strTreeFile, strName, strReportID
    Me.MousePointer = 0
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = vbKeyF1 Then frmQueryHelp.Show vbModal, Me
End Sub

Private Sub Form_Load()
    Dim i, intColCount As Integer
    Dim strCaption As String
    Dim r As Long
    Dim style As Long
    Dim hHeader As Long
    
    On Error Resume Next
    Me.MousePointer = 11
    
    hHeader = SendMessageLong(lvReport.hwnd, LVM_GETHEADER, 0, ByVal 0&)
    style = GetWindowLong(hHeader, GWL_STYLE)
    style = style Xor HDS_BUTTONS    'set the new style and redraw the listview
    If style Then
        r = SetWindowLong(hHeader, GWL_STYLE, style)
    End If
    SetParent cboCalc.hwnd, lvReport.hwnd
    SetParent cboPlace.hwnd, lvReport.hwnd
    cboPlace.AddItem "0"
    cboPlace.AddItem "1"
    cboPlace.AddItem "2"
    cboPlace.AddItem "3"
    cboPlace.AddItem "4"
    cboPlace.AddItem "5"
    cboPlace.AddItem ""
    
    frmQueryGrid.Caption = strName
    adoReport.ConnectionString = strConnectionString
    adoReport.UserName = strUserName
    adoReport.PassWord = strPassWord
    adoReport.RecordSource = strRecordSource
    adoReport.Refresh
    Set grdReport.DataSource = adoReport
    intColCount = grdReport.Columns.Count
    For i = 0 To intColCount - 1
        strCaption = grdReport.Columns(i).Caption
        If Mid$(strCaption, 1, 1) = "'" Then strCaption = Mid$(strCaption, 2)
        If Mid$(strCaption, Len(strCaption), 1) = "'" Then strCaption = Mid$(strCaption, 1, Len(strCaption) - 1)
        grdReport.Columns(i).Caption = strCaption
    Next
    RefreshTreeView 0
    strTreeFile = strPath & "\ColTree.xml"
    strWidthFile = strPath & "\ColWidth.xml"
    If Dir$(strTreeFile) = "" Then CreateXMLFile strTreeFile
    If Dir$(strWidthFile) = "" Then CreateXMLFile strWidthFile
    LoadColTree strTreeFile, strReportID
    RefreshListView
    LoadColWidth strWidthFile, strReportID
    
    Me.MousePointer = 0
End Sub

Private Sub Form_Resize()
    Dim intMode As Integer
    Dim intHeight As Integer

    intMode = Me.ScaleMode
    Me.ScaleMode = 1
    
    intHeight = Me.Height - (375 + 800 + 240)
    If intHeight <= 0 Then Exit Sub
    With grdReport
        .Top = 120
        .Left = 120
        .Width = Me.Width - 360
        .Height = intHeight * 2 / 3
    End With

    With tvReport
        .Top = 120 + grdReport.Height + 120
        .Left = 120
        .Width = (Me.Width - 360) / 2
        .Height = intHeight / 3
    End With
    
    With lvReport
        .Top = 120 + grdReport.Height + 120
        .Left = Me.Width / 2
        .Width = (Me.Width - 360) / 2
        .Height = intHeight / 3
    End With
    
    With cmdPrint
        .Top = intHeight + 440
        .Left = Me.Width - (240 + 1455 + 30 + 1455 + 30 + 1455)
    End With

    With cmdHelp
        .Top = intHeight + 440
        .Left = Me.Width - (240 + 1455 + 30 + 1455)
    End With
    
    With cmdClose
        .Top = intHeight + 440
        .Left = Me.Width - (240 + 1455)
    End With
    
    With Frame1
        .Top = intHeight + 360
        .Left = 120
    End With

    With cmdSave
        .Top = intHeight + 470
        .Left = 120 + Frame1.Width + 240
    End With

    Me.ScaleMode = intMode
End Sub

Private Sub grdReport_ColResize(ByVal ColIndex As Integer, Cancel As Integer)
    If grdReport.Columns(ColIndex).Width < 30 Then lvReport.ListItems("Col" & CStr(ColIndex)).Checked = False
End Sub

Private Sub lvReport_AfterLabelEdit(Cancel As Integer, NewString As String)
    If IsNull(NewString) Then Exit Sub
    Dim i As Integer
    On Error Resume Next
    
    i = CInt(Mid(lvReport.SelectedItem.Key, 4))
    grdReport.Columns(i).Caption = NewString
End Sub

Private Sub lvReport_ItemCheck(ByVal Item As MSComctlLib.ListItem)
    Dim i As Integer
    On Error Resume Next
    
    i = CInt(Mid(Item.Key, 4))
    grdReport.Columns(i).Width = IIf(Item.Checked, 2000, 0)
    grdReport.SetFocus
    If Item.Checked Then
        grdReport.Col = i
        grdReport.row = 0
        SendKeys "{RIGHT}"
        SendKeys "{LEFT}"
    End If
End Sub

Private Sub lvReport_ItemClick(ByVal Item As MSComctlLib.ListItem)
    Dim tRC As RECT
    Dim i As Integer, iCount As Integer, iSelCount As Integer
    
    iSelCount = 0
    iCount = lvReport.ListItems.Count
    For i = 1 To iCount
        If lvReport.ListItems(i).Selected Then iSelCount = iSelCount + 1
    Next i
    If iSelCount > 1 Then Exit Sub
    
    SendMessageAny lvReport.hwnd, LVM_GETSUBITEMRECT, Item.Index - 1, tRC
    With tRC
        .Top = (.Top * Screen.TwipsPerPixelY)
        .Left = (.Left * Screen.TwipsPerPixelX) + lvReport.ColumnHeaders(1).Width
        .Bottom = (.Bottom * Screen.TwipsPerPixelY) - .Top  'Height
        .Right = (.Right * Screen.TwipsPerPixelX) - .Left   'Width
        .Top = .Top + (.Bottom - cboCalc.Height) \ 2
    End With
       
    With cboCalc
        .Move tRC.Left, tRC.Top, tRC.Right - lvReport.ColumnHeaders(3).Width
        .Visible = True
    End With
    With cboPlace
        .Move tRC.Left + lvReport.ColumnHeaders(2).Width, tRC.Top, tRC.Right - lvReport.ColumnHeaders(2).Width
        .Visible = True
    End With
    
    i = CInt(Mid$(Item.Key, 4))
    cboCalc.Clear
    cboCalc.AddItem ""
    cboCalc.AddItem "计数"
    cboCalc.AddItem "最大值"
    cboCalc.AddItem "最小值"
    Select Case adoReport.Recordset.Fields(i).Type
        Case 2, 3, 4, 5, 6, 14, 16, 17, 18, 19, 20, 21, 131
            cboCalc.AddItem "求和"
            cboCalc.AddItem "平均值"
            If Item.SubItems(2) = "" Then
                cboPlace.ListIndex = 6
            Else
                cboPlace.ListIndex = CInt(Item.SubItems(2))
            End If
        Case Else
    End Select
    Select Case Item.SubItems(1)
        Case ""
            cboCalc.ListIndex = 0
        Case "计数"
            cboCalc.ListIndex = 1
        Case "最大值"
            cboCalc.ListIndex = 2
        Case "最小值"
            cboCalc.ListIndex = 3
        Case "求和"
            cboCalc.ListIndex = 4
        Case "平均值"
            cboCalc.ListIndex = 5
    End Select
End Sub

Private Sub lvReport_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = vbKeyRight Then cboCalc.SetFocus
End Sub

Private Sub lvReport_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
    If optCol(0).Value Then Exit Sub
    If Button = vbLeftButton Then
        lvReport.Drag vbBeginDrag
    End If
End Sub

Private Sub mnuAdd_Click()
    Dim i As Integer
    Dim strColName As String
    
    i = tvReport.Nodes(1).children
    strColName = InputBox("请输入列名", "输入", "列标头" & CStr(i))
    If strColName <> "" Then tvReport.Nodes.Add "Report1", tvwChild, "Item" & CStr(i), strColName
    tvReport.Nodes(1).Expanded = True
End Sub

Private Sub mnuColumn_Click()
    mnuAdd.Enabled = True
    mnuDelete.Enabled = True
    mnuEdit.Enabled = True
    If tvReport.SelectedItem.Key = "Report1" Then mnuDelete.Enabled = False
    If Mid$(tvReport.SelectedItem.Key, 1, 4) <> "Item" Then mnuEdit.Enabled = False
    If tvReport.SelectedItem.Key <> "Report1" Then mnuAdd.Enabled = False
End Sub

Private Sub mnuDelete_Click()
    If MsgBox("确定要删除吗？", vbOKCancel + vbQuestion, "提示") = vbOK Then tvReport.Nodes.Remove tvReport.SelectedItem.Index
End Sub

Private Sub mnuEdit_Click()
    Dim strColName As String
    strColName = InputBox("请输入列名", "输入", tvReport.SelectedItem.Text)
    If strColName <> "" Then tvReport.SelectedItem.Text = strColName
End Sub

Private Sub optCol_Click(Index As Integer)
    RefreshTreeView Index
    cmdSave.Enabled = IIf(Index = 0, False, True)
    If Index = 1 Then LoadColTree strTreeFile, strName
End Sub

Private Sub tvReport_DragDrop(source As Control, x As Single, y As Single)
    Dim i, intCount As Integer
    On Error GoTo ErrorHandle
    
'    If Not tvReport.DropHighlight Is Nothing Then
'        tvReport.Nodes.Add tvReport.DropHighlight.Key, tvwChild, lvReport.SelectedItem.Key, lvReport.SelectedItem.Text
'        tvReport.DropHighlight.Expanded = True
'        Set tvReport.DropHighlight = Nothing
'    End If
    If Not tvReport.DropHighlight Is Nothing Then
        intCount = lvReport.ListItems.Count
        For i = 1 To intCount
            If lvReport.ListItems(i).Selected Then
                tvReport.Nodes.Add tvReport.DropHighlight.Key, tvwChild, lvReport.ListItems(i).Key, lvReport.ListItems(i).Text
            End If
        Next
        tvReport.DropHighlight.Expanded = True
        Set tvReport.DropHighlight = Nothing
    End If

    Exit Sub
ErrorHandle:
    MsgBox "拖动出错，请检查！", vbOKOnly + vbInformation, "提示"
End Sub

Private Sub tvReport_DragOver(source As Control, x As Single, y As Single, State As Integer)
    If tvReport.HitTest(x, y) Is Nothing Then Exit Sub
    If Mid$(tvReport.HitTest(x, y).Key, 1, 3) = "Col" Then Exit Sub
    Set tvReport.DropHighlight = tvReport.HitTest(x, y)
End Sub

Private Sub tvReport_KeyDown(KeyCode As Integer, Shift As Integer)
    Select Case KeyCode
        Case vbKeyF5
            If tvReport.SelectedItem.Key = "Report1" Then mnuAdd_Click
        Case vbKeyF6
            If tvReport.SelectedItem.Key <> "Report1" Then mnuDelete_Click
        Case vbKeyF7
            If Mid$(tvReport.SelectedItem.Key, 1, 4) = "Item" Then mnuEdit_Click
    End Select
End Sub

Private Sub tvReport_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    If Button = 2 Then
        mouse_event &H2, 0, 0, 0, 0
        mouse_event &H4, 0, 0, 0, 0
        If optCol(0).Value Then Exit Sub
        If tvReport.SelectedItem Is Nothing Then Exit Sub
        PopupMenu mnuColumn, vbPopupMenuRightButton
    End If
End Sub