frmpreview.frm

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

      End
      Begin VB.Menu mnu_first 
         Caption         =   "|← 跳转到最前页"
      End
      Begin VB.Menu mnu_previous 
         Caption         =   "←  跳转到上一页"
      End
      Begin VB.Menu mnu_next 
         Caption         =   "→  跳转到下一页"
      End
      Begin VB.Menu mnu_last 
         Caption         =   "→| 跳转到最后一页"
      End
      Begin VB.Menu ln4 
         Caption         =   "-"
      End
      Begin VB.Menu mnu_exit 
         Caption         =   "×  退出打印预览"
      End
   End
End
Attribute VB_Name = "frmPreview"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private sr As Single   '/缩放比例

Private hstep As Single     '/*横向步长
Private vstep As Single     '/*纵向步长

Private page As Integer     '/*当前页
Private cutpage As Integer  '/*当前分页

Private bDrop As Boolean    '/*比例设置是否为下拉


'Private Declare Function GetMenu Lib "user32" (ByVal hwnd As Long) As Long
'Private Declare Function GetSubMenu Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As Long
'Private Declare Function SetMenuItemBitmaps Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long, ByVal hBitmapUnchecked As Long, ByVal hBitmapChecked As Long) As Long
'Private Const MF_BYPOSITION = &H400&


Private Sub cmbScale_Click()
Dim wR As Single
Dim hR As Single
    If Not bDrop Then Exit Sub
    Select Case cmbScale.Text
        Case "整页"
            wR = (picBK.Width - 500) / Printer.Width
            hR = (picBK.height - 500) / Printer.height
            sr = wR
            If sr > hR Then sr = hR
        Case "页宽"
            sr = (picBK.Width - 500) / Printer.Width
            '/*判断此情况下是否会出现滚动条
            If picBK.height - 500 < Printer.height * sr Then
                sr = (picBK.Width - 500 - VScroll.Width) / Printer.Width
            End If
        Case Else
            sr = CSng(left(cmbScale.Text, Len(cmbScale.Text) - 1)) / 100
    End Select
    tbTool.Buttons("zoomin").Enabled = True
    tbTool.Buttons("zoomout").Enabled = True
    If sr <= 0.1 Then
        tbTool.Buttons("zoomout").Enabled = False
    End If
    If sr >= 3 Then
        tbTool.Buttons("zoomin").Enabled = False
    End If
    '/*复位
    picPaper.left = 250
    picPaper.top = 250
    HScroll.value = 0
    VScroll.value = 0
    Call FitPaper(sr)
    Call Scroll
    out page, cutpage
    bDrop = False
End Sub

Private Sub cmbScale_DropDown()
    bDrop = True '/*下拉
End Sub

Private Sub Form_Load()

'*****************************
    
'/********测试****************
    SetFont Me
    '/*是否锁定
    tbTool.Buttons("set").Enabled = Not ilocked
    If ilocked Then
        tbTool.Buttons("lock").Image = "key"
    Else
        tbTool.Buttons("lock").Image = "lock"
    End If
    'sr = 0.75
    page = 1
    cutpage = 1
    bDrop = True
    Me.Show
    cmbScale.Text = "页宽"
    'out 1, 1

End Sub

Private Sub out(page As Integer, cutpage As Integer)
    picPaper.Cls

    OutHead picPaper, page, sr              '/*输出表头
    OutFoot picPaper, page, sr               '/*输出表尾
    Call OutTitle(picPaper, sr)         '/*输出页头
    OutPageDate picPaper, page, cutpage, sr
    Call OutTail(picPaper, sr)          '/*输出页尾
    OutColHead picPaper, page, cutpage, sr         '/*输出列头
    OutContent picPaper, page, cutpage, sr         '/*输出正文
    OutBorder picPaper, page, cutpage, sr          '/*输出边框
    OutPic picPaper, page, cutpage, sr

End Sub

Private Sub Form_Resize()
    Call FitPaper(sr)
    
    Call Scroll
End Sub

Private Sub FitPaper(scalerate As Single)
'/*改变纸张,scalerate 为缩放比例
    picPaper.Width = Printer.Width * scalerate
    picPaper.height = Printer.height * scalerate
End Sub


Private Sub drawPage()
    picBK.Cls
    '/*画页面的线
    picBK.Line (picPaper.left - 10, picPaper.top - 10)-Step(picPaper.Width, -5), &H80000010, BF
    picBK.Line (picPaper.left - 10, picPaper.top - 10)-Step(-5, picPaper.height), &H80000010, BF
    picBK.Line (picPaper.left + 50, picPaper.top + picPaper.height)-Step(picPaper.Width, 50), vbBlack, BF
    picBK.Line (picPaper.left + picPaper.Width, picPaper.top + 50)-Step(50, picPaper.height), vbBlack, BF
End Sub



Private Sub Scroll()
    picBK.Width = Me.Width - 250
    picBK.height = Me.height - cbTool.height - 550
    drawPage
'/*是否显示滚动条，显示哪个滚动条，步长为多少
    If picBK.Width < picPaper.Width + 500 Then
        HScroll.Visible = True
    Else
        HScroll.Visible = False
    End If
    If picBK.height < picPaper.height + 500 Then
        VScroll.Visible = True
    Else
        VScroll.Visible = False
    End If
    picBot.Visible = HScroll.Visible
    '/*滚动条定位
    picBot.left = 0
    picBot.Width = picBK.Width
    picBot.top = picBK.height - picBot.height
    HScroll.left = 0
    HScroll.top = picBK.height - HScroll.height - 70
    HScroll.Width = picBK.Width - 60 - IIf(VScroll.Visible, VScroll.Width, 0)
    VScroll.top = 0
    VScroll.left = picBK.Width - VScroll.Width - 70
    VScroll.height = picBK.height - 50 - IIf(HScroll.Visible, HScroll.height, 0)
    '/*确定步长
    '/*根据剩余部分占显示部分的比例来确实步长，如果一样，则使用10步长
    Dim rate As Single
    rate = (picPaper.Width + 500) / (picBK.Width + IIf(VScroll.Visible, VScroll.Width, 0)) - 1
    If rate > 0 Then
        HScroll.Max = 100 * (rate) + 1
        hstep = (picPaper.Width + 500 - picBK.Width + IIf(VScroll.Visible, VScroll.Width, 0)) / HScroll.Max
    End If
    rate = (picPaper.height + 500) / (picBK.height + IIf(HScroll.Visible, HScroll.height, 0)) - 1
    If rate > 0 Then
        VScroll.Max = 100 * (rate) + 1
        vstep = (picPaper.height + 500 - picBK.height + IIf(HScroll.Visible, HScroll.height, 0)) / VScroll.Max
    End If
End Sub


'/****************************

Private Sub HScroll_Scroll()
'/*横向移动
    picPaper.left = 250 - HScroll.value * hstep
    picPaper.SetFocus
    drawPage
End Sub

Private Sub mnu_exit_Click()
    Unload Me
End Sub

Private Sub mnu_first_Click()
    tbTool_ButtonClick tbTool.Buttons("first")
End Sub

Private Sub mnu_info_Click()
'/*作息显示
Dim str As String
    str = "  共 " & pgCnt & " 页/当前第 " & page & " 页"
    str = str & ";共 " & cutCnt & " 分页/当前第 " & cutpage & " 分页    " & vbCrLf & vbCrLf
    str = str & "  当前显示比例为 " & CInt(sr * 100) & "%" & vbCrLf & vbCrLf
    str = str & "  打印方向:" & IIf(Printer.Orientation = vbPRORLandscape, "横向", "竖向") & vbCrLf & vbCrLf
    str = str & "  纸张宽度:" & Format(Printer.Width / unit / 10, "############0.00") & " cm"
    str = str & ";纸张高度:" & Format(Printer.height / unit / 10, "############0.00") & " cm" & vbCrLf & vbCrLf
    str = str & "  锁定状态：" & IIf(ilocked, "已锁", "未锁") '& vbCrLf & vbCrLf
    'str = str & "               DllPrint by ..... 2001年11月"
    MsgBox str, vbOKOnly, "当前信息"
End Sub

Private Sub mnu_last_Click()
    tbTool_ButtonClick tbTool.Buttons("last")
End Sub

Private Sub mnu_next_Click()
    tbTool_ButtonClick tbTool.Buttons("next")
End Sub

Private Sub mnu_previous_Click()
    tbTool_ButtonClick tbTool.Buttons("previous")
End Sub

Private Sub mnu_print_Click()
    tbPrint_ButtonClick tbPrint.Buttons("print")
End Sub

Private Sub mnu_zoomactual_Click()
    bDrop = True
    cmbScale.Text = "100%"
End Sub

Private Sub mnu_zoombest_Click()
    bDrop = True
    cmbScale.Text = "页宽"
End Sub

Private Sub mnu_zoomin_Click()
    tbTool_ButtonClick tbTool.Buttons("zoomin")
End Sub

Private Sub mnu_zoomout_Click()
    tbTool_ButtonClick tbTool.Buttons("zoomout")
End Sub

Private Sub picPaper_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    If Button = 2 Then
        '/*使部分菜单失效
        '/*变比菜单
        mnu_zoomin.Enabled = tbTool.Buttons("zoomin").Enabled
        mnu_zoomout.Enabled = tbTool.Buttons("zoomout").Enabled
        '/*翻页菜单
        mnu_first.Enabled = tbTool.Buttons("first").Enabled
        mnu_previous.Enabled = tbTool.Buttons("previous").Enabled
        mnu_next.Enabled = tbTool.Buttons("next").Enabled
        mnu_last.Enabled = tbTool.Buttons("last").Enabled
        PopupMenu mnu_pop
    End If
End Sub

Private Sub tbButton_ButtonClick(ByVal Button As MSComctlLib.Button)
    Select Case Button.Key
        Case "help"
            Dim str As String
            str = "       DllPrint by progame 2001/11 " & vbCrLf & vbCrLf
            str = str & "  Home Page:http://progame.longcity.net  " & vbCrLf & vbCrLf
            str = str & "  Email:[e-mail]  OR [e-mail]  "
            MsgBox str, vbOKOnly, "关于"
        Case "quit"
            Unload Me
    End Select
End Sub

Private Sub tbPrint_ButtonClick(ByVal Button As MSComctlLib.Button)
    '/*使用自己的对话框打印，气死它
    Select Case Button.Key
        Case "print"
            frmPrint.Show 1, Me
        Case "export"
            '/*导出数据到其它地方
            frmExport.Show 1, Me
    End Select
End Sub

Private Sub tbTool_ButtonClick(ByVal Button As MSComctlLib.Button)
Dim i As Integer
    Select Case Button.Key
        Case "set"  '/*设置
            frmSet.Show 1, Me
            'Call CalPage    '/*分页
            frmWait.Show 1
        Case "first"
            If page <> 1 Or cutpage <> 1 Then
                page = 1
                cutpage = 1
                tbTool.Buttons("previous").Enabled = False
                tbTool.Buttons("next").Enabled = True
            End If
        Case "previous"
            If page = 1 And cutpage = 1 Then Exit Sub
            If cutpage = 1 Then
                page = page - 1
                cutpage = cutCnt
            Else
                cutpage = cutpage - 1
            End If
            tbTool.Buttons("next").Enabled = True
            If page = 1 And cutpage = 1 Then
                tbTool.Buttons("previous").Enabled = False
            End If
        Case "next"
            If page = pgCnt And cutpage = cutCnt Then Exit Sub
            If cutpage = cutCnt Then
                page = page + 1
                cutpage = 1
            Else
                cutpage = cutpage + 1
            End If
            tbTool.Buttons("previous").Enabled = True
            If page = pgCnt And cutpage = cutCnt Then
                tbTool.Buttons("next").Enabled = False
            End If
        Case "last"
            If page <> pgCnt Or cutpage <> cutCnt Then
                page = pgCnt
                cutpage = cutCnt
                tbTool.Buttons("previous").Enabled = True
                tbTool.Buttons("next").Enabled = False
            End If
        Case "zoomout"
            i = 7
            Do While (sr > CSng(left(cmbScale.List(i), Len(cmbScale.List(i)) - 1)) / 100)
                i = i - 1
            Loop
            bDrop = True
            cmbScale.Text = cmbScale.List(i + 1)
        Case "zoomin"
            i = 0
            Do While (sr < CSng(left(cmbScale.List(i), Len(cmbScale.List(i)) - 1)) / 100)
                i = i + 1
            Loop
            bDrop = True
            cmbScale.Text = cmbScale.List(i - 1)
        Case "lock"
            If ilocked Then
                Button.Image = "lock"
            Else
                Button.Image = "key"
                Button.ToolTipText = "开锁(可以继续进行设置)"
            End If
            ilocked = Not ilocked
            tbTool.Buttons("set").Enabled = Not ilocked
    End Select
    txtPage.Text = page
    out page, cutpage
End Sub

Private Sub txtPage_KeyPress(KeyAscii As Integer)
    If KeyAscii <> 13 Then Exit Sub
    '/*校验，是否为数字，是否超出范围，是否不为当前页
    On Error GoTo err_proc
    If Not IsNumeric(txtPage.Text) Then
        txtPage.Text = page
        Exit Sub
    End If
    If CLng(txtPage.Text) < 1 Or CLng(txtPage.Text) > pgCnt Then
        txtPage.Text = page
        Exit Sub
    End If
    If CLng(txtPage.Text) <> page Then
        txtPage.Text = CLng(txtPage.Text)
        page = CLng(txtPage.Text)
        out CLng(txtPage.Text), 1
        Exit Sub
    End If
err_proc:
    txtPage.Text = page
    Exit Sub
End Sub

Private Sub VScroll_Scroll()
'/*纵向移动
    picPaper.top = 250 - VScroll.value * vstep
    picPaper.SetFocus
    drawPage
End Sub
'
'Private Sub AddMenuIcon()
''/*给菜单加上图标
'Dim hMnuMain As Long
'Dim hSubMenu As Long
'Dim L As Long
'    hMnuMain = GetMenu(hwnd)
'    hSubMenu = GetSubMenu(hMnuMain, 0)
'    L = SetMenuItemBitmaps(hSubMenu, 2, MF_BYPOSITION, _
'        picZoomin.Picture, picZoomin.Picture)
'    L = SetMenuItemBitmaps(hSubMenu, 3, MF_BYPOSITION, _
'        picZoomOut.Picture, picZoomOut.Picture)
'
'End Sub

'/*****************动态生成控件支持多页*****************