frmgrid.frm

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

      Top             =   120
      Width           =   11535
      _ExtentX        =   20346
      _ExtentY        =   6376
      _Version        =   393216
      AllowUpdate     =   0   'False
      HeadLines       =   1
      RowHeight       =   14
      BeginProperty HeadFont {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   9
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   9
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ColumnCount     =   2
      BeginProperty Column00 
         DataField       =   ""
         Caption         =   ""
         BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED} 
            Type            =   0
            Format          =   ""
            HaveTrueFalseNull=   0
            FirstDayOfWeek  =   0
            FirstWeekOfYear =   0
            LCID            =   2052
            SubFormatType   =   0
         EndProperty
      EndProperty
      BeginProperty Column01 
         DataField       =   ""
         Caption         =   ""
         BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED} 
            Type            =   0
            Format          =   ""
            HaveTrueFalseNull=   0
            FirstDayOfWeek  =   0
            FirstWeekOfYear =   0
            LCID            =   2052
            SubFormatType   =   0
         EndProperty
      EndProperty
      SplitCount      =   1
      BeginProperty Split0 
         BeginProperty Column00 
         EndProperty
         BeginProperty Column01 
         EndProperty
      EndProperty
   End
   Begin VB.Menu mnuColumn 
      Caption         =   "列名"
      Visible         =   0   'False
      Begin VB.Menu mnuAdd 
         Caption         =   "增加"
         Shortcut        =   {F5}
      End
      Begin VB.Menu mnuDelete 
         Caption         =   "删除"
         Shortcut        =   {F6}
      End
      Begin VB.Menu mnuEdit 
         Caption         =   "修改"
         Shortcut        =   {F7}
      End
   End
End
Attribute VB_Name = "frmQueryGrid"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'打印数据网格控件   黄敬东
Option Explicit

Dim strTreeFile As String
Dim strWidthFile As String

Private Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, _
    ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)

'*************************************************
'创建XML文件，保存列标头格式
'*************************************************
Private Sub CreateXMLFile(ByVal strFile As String)
    Open strFile For Output As #1
    Print #1, "<?xml version=""1.0"" encoding=""GB2312""?>"
    Print #1, "<myfile>"
    Print #1, "</myfile>"
    Close #1
End Sub

'*************************************************
'从XML文件中读取列宽度，在DATAGRID控件中显示
'*************************************************
Private Sub LoadColWidth(ByVal strFile As String, ByVal strID As String)
    Dim objXml As New DOMDocument
    Dim myReportList As IXMLDOMNodeList
    Dim myReport As IXMLDOMNode
    Dim myChildList As IXMLDOMNodeList
    Dim myChild As IXMLDOMNode
    Dim i, intCount As Integer
    Dim strSum As String
    
    On Error Resume Next
    objXml.async = False
    objXml.Load strFile
    Set myReportList = objXml.getElementsByTagName("myfile").Item(0).childNodes
    For Each myReport In myReportList
        If myReport.Attributes.Item(0).Text = strID Then
            intGridRowHeight = CInt(myReport.Attributes.Item(2).Text)
            grdReport.RowHeight = intGridRowHeight
            rectMargin.Left = CInt(myReport.Attributes.Item(3).Text)
            rectMargin.Top = CInt(myReport.Attributes.Item(4).Text)
            rectMargin.Right = CInt(myReport.Attributes.Item(5).Text)
            rectMargin.Bottom = CInt(myReport.Attributes.Item(6).Text)
            iHeadHeight = CInt(myReport.Attributes.Item(7).Text)
            iFootHeight = CInt(myReport.Attributes.Item(8).Text)
            Set myChildList = myReport.childNodes(0).childNodes
            intCount = myChildList.length
            For Each myChild In myChildList
                For i = 0 To intCount - 1
                    lvReport.ListItems("Col" & CStr(i)).Text = myChild.childNodes(i).Attributes(0).Text
                    lvReport.ListItems("Col" & CStr(i)).SubItems(1) = myChild.childNodes(i).Attributes(1).Text
                    lvReport.ListItems("Col" & CStr(i)).SubItems(2) = myChild.childNodes(i).Attributes(2).Text
                    grdReport.Columns(i).Width = CInt(myChild.childNodes(i).Text)
                    If myChild.childNodes(i).Attributes(0).Text <> "" Then
                        grdReport.Columns(i).Caption = myChild.childNodes(i).Attributes(0).Text
                    Else
                        lvReport.ListItems("Col" & CStr(i)).Text = grdReport.Columns(i).Caption
                    End If
                    lvReport.ListItems("Col" & CStr(i)).Checked = Not (CInt(grdReport.Columns(i).Width / 56.7) = 0)
                Next i
            Next myChild
            Set myChildList = myReport.childNodes(1).childNodes
            i = 0
            For Each myChild In myChildList
                With liPrint(i)
                    .band = myChild.Attributes(0).Text
                    .curY = myChild.Attributes(1).Text
                    .Font.Bold = myChild.Attributes(2).Text
                    .Font.Italic = myChild.Attributes(3).Text
                    .Font.Name = myChild.Attributes(4).Text
                    .Font.Size = myChild.Attributes(5).Text
                    .Font.Strikethrough = myChild.Attributes(6).Text
                    .Font.Underline = myChild.Attributes(7).Text
                    .ForeColor = myChild.Attributes(8).Text
                    .Height = myChild.Attributes(9).Text
                    .LineAlign = myChild.Attributes(10).Text
                    .LineNum = myChild.Attributes(11).Text
                    .Name = myChild.Attributes(12).Text
                    .Text = myChild.Attributes(13).Text
                    .Width = myChild.Attributes(14).Text
                End With
                i = i + 1
            Next myChild
        End If
    Next
    If intCount > 0 Then
        lvReport_ItemClick lvReport.ListItems(1)
    Else
        intCount = lvReport.ListItems.Count
        For i = 0 To intCount - 1
            lvReport.ListItems("Col" & CStr(i)).Checked = Not (CInt(grdReport.Columns(i).Width / 56.7) = 0)
        Next i
    End If
    Set objXml = Nothing
End Sub

'*************************************************
'保存DATAGRID中的列宽度到XML文件中
'*************************************************
Private Sub SaveColWidth(ByVal strFile As String, ByVal strReport As String, ByVal strID As String)
    Dim objXml As New DOMDocument
    Dim myReportList As IXMLDOMNodeList
    Dim myReport As IXMLDOMNode
    Dim newNode As IXMLDOMNode
    Dim myNode As IXMLDOMNode
    Dim myCol As IXMLDOMNode
    Dim myName As IXMLDOMAttribute
    Dim i, intCount As Integer
    Dim bIsExist As Boolean
    
    bIsExist = False
    objXml.Load strFile
    Set newNode = objXml.createNode(NODE_ELEMENT, "report", "")
    Set myName = objXml.createAttribute("ID")
    myName.Text = strID
    newNode.Attributes.setNamedItem myName
    Set myName = objXml.createAttribute("name")
    myName.Text = strReport
    newNode.Attributes.setNamedItem myName
    Set myName = objXml.createAttribute("rowheight")
    myName.Text = CStr(grdReport.RowHeight)
    newNode.Attributes.setNamedItem myName
    
    Set myName = objXml.createAttribute("left")
    myName.Text = rectMargin.Left
    newNode.Attributes.setNamedItem myName
    Set myName = objXml.createAttribute("top")
    myName.Text = rectMargin.Top
    newNode.Attributes.setNamedItem myName
    Set myName = objXml.createAttribute("right")
    myName.Text = rectMargin.Right
    newNode.Attributes.setNamedItem myName
    Set myName = objXml.createAttribute("bottom")
    myName.Text = rectMargin.Bottom
    newNode.Attributes.setNamedItem myName
    
    Set myName = objXml.createAttribute("headheight")
    myName.Text = iHeadHeight
    newNode.Attributes.setNamedItem myName
    Set myName = objXml.createAttribute("footheight")
    myName.Text = iFootHeight
    newNode.Attributes.setNamedItem myName
    
    Set myCol = objXml.createNode(NODE_ELEMENT, "colwidth", "")
    intCount = grdReport.Columns.Count
    For i = 0 To intCount - 1
        Set myNode = objXml.createNode(NODE_ELEMENT, "width", "")
        myNode.Text = CStr(grdReport.Columns(i).Width)
        Set myName = objXml.createAttribute("caption")
        myName.Text = lvReport.ListItems("Col" & CStr(i)).Text
        myNode.Attributes.setNamedItem myName
        Set myName = objXml.createAttribute("reportsum")
        myName.Text = lvReport.ListItems("Col" & CStr(i)).SubItems(1)
        myNode.Attributes.setNamedItem myName
        Set myName = objXml.createAttribute("decimalplaces")
        myName.Text = lvReport.ListItems("Col" & CStr(i)).SubItems(2)
        myNode.Attributes.setNamedItem myName
        myCol.appendChild myNode
    Next i
    newNode.appendChild myCol
    
    Set myCol = objXml.createNode(NODE_ELEMENT, "printlabel", "")
    intCount = iCount
    For i = 0 To intCount - 1
        With liPrint(i)
            Set myNode = objXml.createNode(NODE_ELEMENT, "label", "")
            Call SetPrintLabelToXml(myNode, objXml, .band, .curY, .Font.Bold, .Font.Italic, _
                .Font.Name, .Font.Size, .Font.Strikethrough, .Font.Underline, .ForeColor, _
                .Height, .LineAlign, .LineNum, .Name, .Text, .Width)
            myCol.appendChild myNode
        End With
    Next i
    newNode.appendChild myCol
    
    Set myReportList = objXml.getElementsByTagName("myfile").Item(0).childNodes
    For Each myReport In myReportList
        If myReport.Attributes.Item(0).Text = strID Then
            bIsExist = True
            objXml.getElementsByTagName("myfile").Item(0).replaceChild newNode, myReport
        End If
    Next
    If Not bIsExist Then objXml.getElementsByTagName("myfile").Item(0).appendChild newNode
            
    objXml.Save strFile
    Set objXml = Nothing
End Sub

Private Sub SetPrintLabelToXml(nd As IXMLDOMNode, objXml As DOMDocument26, ByVal aBand As String, _
    ByVal acurY As Integer, ByVal afBold As Boolean, ByVal afItalic As Boolean, ByVal afName As String, _
    ByVal afSize As Integer, ByVal afStrike As Boolean, ByVal afUnderline As Boolean, ByVal aforeColor As Long, _
    ByVal aHeight As Integer, ByVal alAlign As PrintAlign, ByVal alNum As Integer, ByVal aName As String, _
    ByVal aText As String, ByVal aWidth As Integer)
    
    Dim abShare As IXMLDOMAttribute
    Set abShare = objXml.createAttribute("band")
    abShare.Text = aBand
    nd.Attributes.setNamedItem abShare
    Set abShare = objXml.createAttribute("curY")
    abShare.Text = acurY
    nd.Attributes.setNamedItem abShare
    Set abShare = objXml.createAttribute("fontBold")
    abShare.Text = afBold
    nd.Attributes.setNamedItem abShare
    Set abShare = objXml.createAttribute("fontItalic")
    abShare.Text = afItalic
    nd.Attributes.setNamedItem abShare
    Set abShare = objXml.createAttribute("fontName")
    abShare.Text = afName
    nd.Attributes.setNamedItem abShare
    Set abShare = objXml.createAttribute("fontSize")
    abShare.Text = afSize
    nd.Attributes.setNamedItem abShare
    Set abShare = objXml.createAttribute("fontStrikethrough")
    abShare.Text = afStrike
    nd.Attributes.setNamedItem abShare
    Set abShare = objXml.createAttribute("fontUnderline")
    abShare.Text = afUnderline
    nd.Attributes.setNamedItem abShare
    Set abShare = objXml.createAttribute("foreColor")
    abShare.Text = aforeColor
    nd.Attributes.setNamedItem abShare
    Set abShare = objXml.createAttribute("height")
    abShare.Text = aHeight
    nd.Attributes.setNamedItem abShare
    Set abShare = objXml.createAttribute("lineAlign")
    abShare.Text = alAlign
    nd.Attributes.setNamedItem abShare
    Set abShare = objXml.createAttribute("lineNum")
    abShare.Text = alNum
    nd.Attributes.setNamedItem abShare
    Set abShare = objXml.createAttribute("name")
    abShare.Text = aName
    nd.Attributes.setNamedItem abShare
    Set abShare = objXml.createAttribute("text")
    abShare.Text = aText
    nd.Attributes.setNamedItem abShare
    Set abShare = objXml.createAttribute("width")
    abShare.Text = aWidth
    nd.Attributes.setNamedItem abShare
End Sub

'*************************************************
'从XML文件中读取列头结构，在TREEVIEW控件中显示
'*************************************************
Private Sub LoadColTree(ByVal strFile As String, ByVal strID As String)
    Dim objXml As New DOMDocument
    Dim myReportList As IXMLDOMNodeList
    Dim myReport As IXMLDOMNode
    Dim myColList As IXMLDOMNodeList
    Dim myCol As IXMLDOMNode
    Dim myNodeList As IXMLDOMNodeList
    Dim myNode As IXMLDOMNode
    Dim strName As String
    Dim strKey As String
    Dim strColName As String
    Dim strColKey As String
    Dim i, intCount As Integer

    objXml.async = False
    objXml.Load strFile
    Set myReportList = objXml.getElementsByTagName("myfile").Item(0).childNodes
    For Each myReport In myReportList
        If myReport.Attributes.Item(0).Text = strID Then