frmoption.frm

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

         Appearance      =   1
         BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
            Name            =   "宋体"
            Size            =   9
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         NumItems        =   2
         BeginProperty ColumnHeader(1) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
            Text            =   "行号"
            Object.Width           =   882
         EndProperty
         BeginProperty ColumnHeader(2) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
            SubItemIndex    =   1
            Text            =   "高度（mm）"
            Object.Width           =   1587
         EndProperty
      End
   End
   Begin VB.Frame Frame2 
      Caption         =   "页尾打印区域设置："
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   1335
      Index           =   1
      Left            =   3900
      TabIndex        =   42
      Top             =   360
      Width           =   5895
      Begin MSComctlLib.ListView lvwLine 
         Height          =   975
         Index           =   1
         Left            =   1080
         TabIndex        =   43
         Top             =   240
         Width           =   1695
         _ExtentX        =   2990
         _ExtentY        =   1720
         View            =   3
         LabelEdit       =   1
         LabelWrap       =   -1  'True
         HideSelection   =   -1  'True
         FullRowSelect   =   -1  'True
         GridLines       =   -1  'True
         _Version        =   393217
         ForeColor       =   -2147483640
         BackColor       =   -2147483643
         Appearance      =   1
         BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
            Name            =   "宋体"
            Size            =   9
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         NumItems        =   2
         BeginProperty ColumnHeader(1) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
            Text            =   "行号"
            Object.Width           =   882
         EndProperty
         BeginProperty ColumnHeader(2) {BDD1F052-858B-11D1-B16A-00C0F0283628} 
            SubItemIndex    =   1
            Text            =   "高度（mm）"
            Object.Width           =   1587
         EndProperty
      End
   End
   Begin VB.Label page 
      AutoSize        =   -1  'True
      Height          =   195
      Left            =   4080
      TabIndex        =   44
      Top             =   6135
      Width           =   45
   End
End
Attribute VB_Name = "frmQueryOption"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'打印数据网格控件   黄敬东
Option Explicit
Dim liPrintTemp() As LabelInfo
Dim oldIndex As Integer

Private Sub ShowPrintInfo()
'装载打印属性
    Label1(0).Caption = "名称：" & Printer.DeviceName
    Label2(0).Caption = "位置：" & Printer.Port
    Label3.Caption = "宽度:" & Format(Printer.Width / UNIT / 10, "############0.00") & " cm"
    Label4(0).Caption = "高度:" & Format(Printer.Height / UNIT / 10, "############0.00") & " cm"
    Label5(0).Caption = "打印方向:" & IIf(Printer.Orientation = vbPRORLandscape, "横向", "竖向")
End Sub

Private Sub cmdClose_Click(Index As Integer)
    On Error Resume Next
    
    bIsChange = False
    If Index = 0 Then
        Dim i As Integer, iHL As Integer, iFL As Integer
        Dim clHead As New Collection        '页头每行的起始高度
        Dim clFoot As New Collection        '页尾每行的起始高度
        
        On Error GoTo ErrorHandle
        iHeadHeight = 0: iFootHeight = 0
        iHL = lvwLine(0).ListItems.Count
        For i = 1 To iHL
            iHeadHeight = iHeadHeight + CInt(lvwLine(0).ListItems(i).SubItems(1))
            If i = 1 Then
                clHead.Add 0
            Else
                clHead.Add clHead.Item(i - 1) + CInt(lvwLine(0).ListItems(i - 1).SubItems(1))
            End If
        Next i
        iFL = lvwLine(1).ListItems.Count
        For i = 1 To iFL
            iFootHeight = iFootHeight + CInt(lvwLine(1).ListItems(i).SubItems(1))
            If i = 1 Then
                clFoot.Add 0
            Else
                clFoot.Add clFoot.Item(i - 1) + CInt(lvwLine(1).ListItems(i - 1).SubItems(1))
            End If
        Next i
        For i = 0 To iCount - 1
            If liPrintTemp(i).band = "head" Then
                If liPrintTemp(i).LineNum > iHL Then
                    MsgBox "｛" & liPrintTemp(i).Name & "｝中的行号已经不存在，请检查！　", , MSGTEXT
                    Exit Sub
                Else
                    liPrintTemp(i).Height = CInt(lvwLine(0).ListItems(liPrintTemp(i).LineNum).SubItems(1))
                    liPrintTemp(i).curY = clHead.Item(liPrintTemp(i).LineNum)
                End If
            Else
                If liPrintTemp(i).LineNum > iFL Then
                    MsgBox "｛" & liPrintTemp(i).Name & "｝中的行号已经不存在，请检查！　", , MSGTEXT
                    Exit Sub
                Else
                    liPrintTemp(i).Height = CInt(lvwLine(1).ListItems(liPrintTemp(i).LineNum).SubItems(1))
                    liPrintTemp(i).curY = clFoot.Item(liPrintTemp(i).LineNum)
                End If
            End If
        Next i
        
'       记录下页边界的信息
        Call CopyliPrint(liPrintTemp, liPrint)
        rectMargin.Top = txtTop
        rectMargin.Bottom = txtBottom
        rectMargin.Left = txtLeft
        rectMargin.Right = txtRight
        bIsChange = True
        Set clHead = Nothing
        Set clFoot = Nothing
    End If
    Unload Me
    Exit Sub
ErrorHandle:
    MsgBox "保存设置失败,请检查后再试！", , MSGTEXT
    Set clHead = Nothing
    Set clFoot = Nothing
End Sub

Private Sub cmdOption_Click()
'   显示系统打印设置窗口
    dlg.Flags = cdlPDPrintSetup
    dlg.ShowPrinter
    ShowPrintInfo
End Sub

Private Sub cboBand_Click()
    Dim i, iLineCount As Integer
    cboNum.Clear
    If cboBand.Text = "页头" Then
        iLineCount = lvwLine(0).ListItems.Count
        For i = 1 To iLineCount
            cboNum.AddItem "第 " & lvwLine(0).ListItems(i).Text & " 行"
            cboNum.ItemData(cboNum.NewIndex) = CInt(lvwLine(0).ListItems(i).SubItems(1))
        Next i
    Else
        iLineCount = lvwLine(1).ListItems.Count
        For i = 1 To iLineCount
            cboNum.AddItem "第 " & lvwLine(1).ListItems(i).Text & " 行"
            cboNum.ItemData(cboNum.NewIndex) = CInt(lvwLine(1).ListItems(i).SubItems(1))
        Next i
    End If
End Sub

Private Sub cmdBand_Click(Index As Integer)
    Dim itemReturn As ListItem

    Select Case Index
        Case 0
            If txtHeight <> "" Then
                If optBand(0).Value Then
                    Set itemReturn = lvwLine(0).ListItems.Add(, , CStr(lvwLine(0).ListItems.Count + 1))
                Else
                    Set itemReturn = lvwLine(1).ListItems.Add(, , CStr(lvwLine(1).ListItems.Count + 1))
                End If
                itemReturn.SubItems(1) = txtHeight
            End If
        Case 1
            If txtHeight <> "" Then
                If optBand(0).Value Then
                    lvwLine(0).ListItems(lvwLine(0).SelectedItem.Index).SubItems(1) = Trim(txtHeight)
                Else
                    lvwLine(1).ListItems(lvwLine(1).SelectedItem.Index).SubItems(1) = Trim(txtHeight)
                End If
            End If
        Case 2
            txtHeight = ""
            If optBand(0).Value Then
                If lvwLine(0).ListItems.Count >= 0 Then lvwLine(0).ListItems.Remove lvwLine(0).ListItems.Count
            Else
                If lvwLine(1).ListItems.Count >= 0 Then lvwLine(1).ListItems.Remove lvwLine(1).ListItems.Count
            End If
    End Select
End Sub

Private Sub cmdDlg_Click()
    dlg.Flags = cdlCFBoth + cdlCFEffects
    dlg.CancelError = True
    Call CopyFontColor(txtFont, dlg, True)
    On Error GoTo Errhandle:
    dlg.ShowFont
    Call CopyFontColor(txtFont, dlg, False)
    txtFont = txtFont.Font.Name
Errhandle:
End Sub

Private Sub CopyFontColor(txt As TextBox, dlg As CommonDialog, Optional todlg As Boolean = True)
'/*拷贝字体和颜色,todlg=true则是传到字体对话框，否则是从对话框得到
    If todlg Then
        With dlg
            .FontName = txt.Font.Name
            .FontSize = txt.Font.Size
            .FontBold = txt.Font.Bold
            .FontItalic = txt.Font.Italic
            .FontStrikethru = txt.Font.Strikethrough
            .FontUnderline = txt.Font.Underline
            .Color = txt.ForeColor
        End With
    Else
        With txt
            .Font.Name = dlg.FontName
            .Font.Size = dlg.FontSize
            .Font.Bold = dlg.FontBold
            .Font.Italic = dlg.FontItalic
            .Font.Strikethrough = dlg.FontStrikethru
            .Font.Underline = dlg.FontUnderline
            .ForeColor = dlg.Color
        End With
    End If
End Sub

Private Sub CopyliPrint(liSrc() As LabelInfo, liDis() As LabelInfo)
    Dim i As Integer
    
    For i = 0 To iCount - 1
        With liDis(i)
            .band = liSrc(i).band
            .curY = liSrc(i).curY
            CopyFont liSrc(i).Font, .Font
            .ForeColor = liSrc(i).ForeColor
            .Height = liSrc(i).Height
            .LineAlign = liSrc(i).LineAlign
            .LineNum = liSrc(i).LineNum
            .Name = liSrc(i).Name
            .Text = liSrc(i).Text
            .Width = liSrc(i).Width
        End With
    Next i
End Sub

Private Sub cmdSave_Click()
    Call SetliPrintInfo(liPrintTemp, lstLabel.ListIndex, IIf(cboBand.ListIndex = 0, "head", "foot"), _
                    0, cboNum.ItemData(cboNum.ListIndex), cboAlign.ListIndex + 1, _
                    cboNum.ListIndex + 1, lstLabel.Text, txtText, txtFont.Font, txtFont.ForeColor)
End Sub

Private Sub Form_Load()
    Dim i As Integer
    Dim iHL As Integer, iFL As Integer '页头、页尾的行数
    Dim itemFind As ListItem
    
    ReDim liPrintTemp(iCount - 1)
    optBand(0).Value = True
    Frame2(0).Visible = True
    Frame2(1).Visible = False
    
    Call CopyliPrint(liPrint, liPrintTemp)
    
    iHL = 0: iFL = 0
    For i = 0 To iCount - 1
        lstLabel.AddItem liPrint(i).Name
        If (liPrint(i).band = "head") And (liPrint(i).LineNum > iHL) Then iHL = liPrint(i).LineNum
        If (liPrint(i).band = "foot") And (liPrint(i).LineNum > iFL) Then iFL = liPrint(i).LineNum
    Next i
    For i = 1 To iHL
        lvwLine(0).ListItems.Add , , CStr(i)
    Next i
    For i = 1 To iFL
        lvwLine(1).ListItems.Add , , CStr(i)
    Next i
    For i = 0 To iCount - 1
        If (liPrint(i).band = "head") Then
            Set itemFind = lvwLine(0).FindItem(CStr(liPrint(i).LineNum))
            If Not (itemFind Is Nothing) Then itemFind.SubItems(1) = CStr(liPrint(i).Height)
        Else
            Set itemFind = lvwLine(1).FindItem(CStr(liPrint(i).LineNum))
            If Not (itemFind Is Nothing) Then itemFind.SubItems(1) = CStr(liPrint(i).Height)
        End If
    Next i
    
'   初始化数据和控件
    udTop = rectMargin.Top
    udBottom = rectMargin.Bottom
    udLeft = rectMargin.Left
    udRight = rectMargin.Right
    ShowPrintInfo
    bIsChange = False
    oldIndex = -1
    lstLabel.ListIndex = 0
End Sub

Private Sub lstLabel_Click()
    If oldIndex <> lstLabel.ListIndex Then
        If oldIndex <> -1 Then  'oldIndex=-1表示是第一次选择，不需要保存
            Call SetliPrintInfo(liPrintTemp, oldIndex, IIf(cboBand.ListIndex = 0, "head", "foot"), _
                        0, cboNum.ItemData(cboNum.ListIndex), cboAlign.ListIndex + 1, _
                        cboNum.ListIndex + 1, lstLabel.Text, txtText, txtFont.Font, txtFont.ForeColor)
        End If
        oldIndex = lstLabel.ListIndex
        txtText = liPrintTemp(lstLabel.ListIndex).Text
        Call CopyFont(liPrintTemp(lstLabel.ListIndex).Font, txtFont.Font)
        txtFont = liPrintTemp(lstLabel.ListIndex).Font.Name
        txtFont.ForeColor = liPrintTemp(lstLabel.ListIndex).ForeColor
        cboBand.ListIndex = IIf(liPrintTemp(lstLabel.ListIndex).band = "head", 0, 1)
        If liPrintTemp(lstLabel.ListIndex).LineNum <= cboNum.ListCount Then
            cboNum.ListIndex = CStr(liPrintTemp(lstLabel.ListIndex).LineNum - 1)
        Else
            MsgBox "当前文本的所在行不存在，可能已经被删除！", , MSGTEXT
            cboNum.ListIndex = cboNum.ListCount - 1
        End If
        cboAlign.ListIndex = liPrintTemp(lstLabel.ListIndex).LineAlign - 1
    End If
End Sub

Private Sub lvwLine_ItemClick(Index As Integer, ByVal Item As MSComctlLib.ListItem)
    txtHeight.Text = Item.SubItems(1)
End Sub

Private Sub optBand_Click(Index As Integer)
    If optBand(0).Value Then
        Frame2(0).Visible = True
        Frame2(1).Visible = False
    Else
        Frame2(0).Visible = False
        Frame2(1).Visible = True
    End If
End Sub

'*****************************************************************
'   在文本框中只能输入数字及按空格键
'*****************************************************************
Private Sub txtTop_KeyPress(KeyAscii As Integer)
    If (Chr(KeyAscii) < "0" Or Chr(KeyAscii) > "9") And KeyAscii <> 8 Then KeyAscii = 0
End Sub

Private Sub txtBottom_KeyPress(KeyAscii As Integer)
    If (Chr(KeyAscii) < "0" Or Chr(KeyAscii) > "9") And KeyAscii <> 8 Then KeyAscii = 0
End Sub

Private Sub txtLeft_KeyPress(KeyAscii As Integer)
    If (Chr(KeyAscii) < "0" Or Chr(KeyAscii) > "9") And KeyAscii <> 8 Then KeyAscii = 0
End Sub

Private Sub txtRight_KeyPress(KeyAscii As Integer)
    If (Chr(KeyAscii) < "0" Or Chr(KeyAscii) > "9") And KeyAscii <> 8 Then KeyAscii = 0
End Sub

Private Sub txtStart_KeyPress(KeyAscii As Integer)
    If (Chr(KeyAscii) < "0" Or Chr(KeyAscii) > "9") And KeyAscii <> 8 Then KeyAscii = 0
End Sub

Private Sub txtEnd_KeyPress(KeyAscii As Integer)
    If (Chr(KeyAscii) < "0" Or Chr(KeyAscii) > "9") And KeyAscii <> 8 Then KeyAscii = 0
End Sub

Private Sub txtHeight_KeyPress(KeyAscii As Integer)
    If (Chr(KeyAscii) < "0" Or Chr(KeyAscii) > "9") And KeyAscii <> 8 Then KeyAscii = 0
End Sub