frmpreview.frm

ktv场所的包房开房、迎宾、预定管理系统。

Attribute VB_Exposed = False

Option Explicit

Public WithEvents rpt   As report       '*需要传递进来的Report对象
Attribute rpt.VB_VarHelpID = -1

Private WithEvents HS   As cScrollBar   '*横向滚动条
Attribute HS.VB_VarHelpID = -1
Private WithEvents VS   As cScrollBar   '*纵向滚动条
Attribute VS.VB_VarHelpID = -1

Private m_HS            As cScrollBar   '*横向滚动条
Private m_VS            As cScrollBar   '*纵向滚动条

Private sRate           As Single       '*缩放比例
Private bMargin         As Boolean      '*显示页边距

Private pFrom           As Integer      '*要显示的页起始
Private pTo             As Integer      '*要显示的页终止

Private bInit           As Boolean      '*窗体resize时判定是否第一次打开，如果是，不需要设置显示

Private iPageCnt        As Integer      '*横向显示的页面张数

Private lstX            As Single       '*鼠标按下时X位置
Private lstY            As Single       '*鼠标按下时Y位置

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
'*键盘操作支持
    On Error Resume Next
    Select Case KeyCode
        Case vbKeyUp
            VS.Value = VS.Value - 3
        Case vbKeyDown
            VS.Value = VS.Value + 3
        Case vbKeyLeft
            HS.Value = HS.Value - 3
        Case vbKeyRight
            HS.Value = HS.Value + 3
        Case vbKeyPageUp
            VS.Value = VS.Value - 30
        Case vbKeyPageDown
            VS.Value = VS.Value + 30
        Case vbKeyHome
            VS.Value = 0
        Case vbKeyEnd
            VS.Value = VS.Max
        Case 123
            Call tbOperate_ButtonClick(tbOperate.Buttons("printer"))
        Case 27
            Unload Me
            Exit Sub
    End Select
    On Error GoTo 0
    ShowPage
End Sub

Private Sub Form_Load()
    '*窗体居中
    CenterForm Me
    '*设置滚动条
    Set m_HS = New cScrollBar
    Set m_HS.PictureBoxToUse = picHS
    Set HS = m_HS
    Set m_VS = New cScrollBar
    Set m_VS.PictureBoxToUse = picVS
    Set VS = m_VS
    VS.HorizontalScroll = False
    
    sRate = 1
    Init
    bInit = True
    Show
    bInit = False
    
    flatProgressBar1.Visible = True
    rpt.CalPage
    
    flatProgressBar1.Visible = False

    VS.Value = 0
    HS.Value = 0
    
    iPageCnt = 1
    
    
    ScrollSet
    ShowPage
    
    picBK.MouseIcon = LoadResPicture("ARROW", vbResCursor)
End Sub


'**************************************************************
'*名称：PrintIt
'*功能：输出一页到PictureBox
'*传入参数：
'*      pic             --PictureBox
'*      page            --页数
'*      cutpage         --分页数
'*      sRate           --比例
'*作者：progame
'*日期：2002-04-05 20:04:44
'***************************************************************
Private Sub PrintIt(pic As PictureBox, _
                    page As Integer, _
                    cutpage As Integer, _
                    sRate As Single)
                    
    '*改变PictureBox的大小
    pic.width = rpt.width * sRate
    pic.height = rpt.height * sRate
    pic.Cls
    
    '*输出
    rpt.PrintIt pic, page, cutpage, sRate
    pic.Line (pic.width - 30, 0)-Step(30, pic.height + 30), &H404040, BF
    pic.Line (0, pic.height - 30)-Step(pic.width + 30, 30), &H404040, BF
    If Not bMargin Then
        Exit Sub
    End If
    '*是否要绘制页边距
    With pic
        .ForeColor = &H80000003
        .DrawStyle = 1
        pic.Line (0, rpt.TopMargin * sRate)-Step(rpt.width * sRate, 0)
        pic.Line (rpt.LeftMargin * sRate, 0)-Step(0, rpt.height * sRate)
        pic.Line (0, (rpt.height - rpt.BottomMargin) * sRate)-Step(rpt.width * sRate, 0)
        pic.Line ((rpt.width - rpt.RightMargin) * sRate, 0)-Step(0, rpt.height * sRate)
        pic.DrawStyle = 0
    End With
End Sub

'**************************************************************
'*名称：Init
'*功能：初始化窗口界面
'*传入参数：
'*
'*作者：progame
'*日期：2002-04-08 13:40:40
'***************************************************************
Private Sub Init()

    Set tbOperate.ImageList = imgIcon
    With tbOperate
        .Left = 180
        .Top = 30
        Dim i       As Integer
        For i = 1 To .Buttons.count
            If .Buttons(i).Style <> tbrSeparator Then
                .Buttons(i).Image = .Buttons(i).key
            End If
        Next i
    End With
    
    picPage(0).Left = 100
    picPage(0).Top = 50
End Sub




'**************************************************************
'*名称：DrawTb
'*功能：绘制工具条的背景图片框
'*传入参数：
'*
'*作者：progame
'*日期：2002-04-08 14:32:57
'***************************************************************
Private Sub DrawTb()
On Error Resume Next
    picTb.Cls
    
    picTb.Top = 0
    picTb.Left = 0
    picTb.width = width - 150
    picTb.height = tbOperate.height + 60
    
    picTb.Line (60, 50)-Step(0, picTb.height - 120), vbWhite
    picTb.Line (90, 50)-Step(0, picTb.height - 120), &H808080
    picTb.Line (120, 50)-Step(0, picTb.height - 120), vbWhite
    picTb.Line (150, 50)-Step(0, picTb.height - 120), &H808080
    
    picTb.Line (0, 0)-Step(picTb.width - 20, 0), vbWhite
    picTb.Line (0, picTb.height - 20)-Step(picTb.width - 10, 0), &H808080
    picTb.Line (0, 10)-Step(0, picTb.height - 20), vbWhite
    picTb.Line (picTb.width - 20, 10)-Step(0, picTb.height - 10), &H808080
    
    'tbOperate.width = picTb.width - 200
    
    picTb.Line (0, picTb.height - 30)-Step(picTb.width, 5), &H808080, BF
    picTb.Line (0, picTb.height - 20)-Step(picTb.width, 0), vbBlack, BF
End Sub


'**************************************************************
'*名称：DrawBK
'*功能：绘制预览区
'*传入参数：
'*
'*作者：progame
'*日期：2002-04-08 15:43:50
'***************************************************************
Private Sub DrawBK()
On Error Resume Next
    picBK.Cls
    
    '*调整位置
    picBK.Top = picTb.Top + picTb.height
    picBK.Left = 0
    picBK.height = height - picBK.Top - 420 - 280
    picBK.width = width - 150 - 280
    
    '调整内部控件的位置
    picBot.Left = 15
    picBot.width = picBK.width - 20 + 280
    picBot.height = 250 + 30
    picBot.Top = picBK.Top + picBK.height
    
    picHS.Top = 0
    picHS.Left = 2000 + 50
    picHS.width = picBot.width - 2000 - 310
    picHS.height = 250
    
    labInfo.Left = 10
    
    labInfo.Top = 40
    labInfo.height = 200
    labInfo.width = 2000
    
    flatProgressBar1.Left = 30
    flatProgressBar1.Top = 40
    flatProgressBar1.height = 200
    flatProgressBar1.width = 2000
    
    picRight.Top = picBK.Top
    picRight.Left = picBK.width + 5
    picRight.height = picBK.height
    picRight.width = 280
    
    picVS.Top = 5
    picVS.Left = 0
    picVS.height = picRight.height
    picVS.width = 250
    
    '*绘制底部的边框
    picBot.Cls
    picBot.Line (0, 0)-Step(2050, 6), vbBlack, BF
    
    picBot.Line (0, picBot.height - 10)-Step(picBot.width, 0), vbWhite
    picBot.Line (0, picBot.height - 30)-Step(picBot.width, 0), &H808080
    picBot.Line (picBot.width - 10, 10)-Step(0, picBot.height - 20), vbWhite
    picBot.Line (picBot.width - 30, 10)-Step(0, picBot.height - 20), &H808080
    
    picRight.Line (picRight.width - 15, 0)-Step(0, picRight.height), vbWhite
    picRight.Line (picRight.width - 30, 0)-Step(0, picRight.height), &H808080
End Sub

Private Sub Form_Resize()
'限定缩放的最小范围

    If width < 6000 Then
        width = 6000
    End If
    If height < 4200 Then
        height = 4200
    End If
    DrawTb
    DrawBK
    If Not bInit Then
        ScrollSet
        ShowPage
    End If
End Sub

'**************************************************************
'*名称：ScrollSet
'*功能：设置滚动条
'*传入参数：
'*
'*作者：progame
'*日期：2002-04-08 20:33:11
'***************************************************************
Private Sub ScrollSet()
    
'*横向的处理
Dim aWidth      As Single
Dim uWidth      As Single
    
    '*页的宽度
    aWidth = rpt.width * sRate + 100
    uWidth = picBK.width
    
    '*首先判断可以横向显示几个页面
    iPageCnt = Fix(uWidth / aWidth)
    If iPageCnt = 0 Then iPageCnt = 1
    
    '*300作为一个大的change，而一个小的change为10
    If aWidth <= uWidth Or iPageCnt > 1 Then
        HS.Max = 0
    Else
        If CLng((aWidth - uWidth) / 10) <> (aWidth - uWidth) / 10 Then
            HS.Max = CLng((aWidth - uWidth) / 10 + 0.499999999)
        Else
            HS.Max = (aWidth - uWidth) / 10
        End If
    End If
    
    HS.SmallChange = 10