frm_billpreview.frm

套打程序

VERSION 5.00
Begin VB.Form frm_BillPreView 
   Caption         =   "打印预览"
   ClientHeight    =   6915
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   10215
   Icon            =   "frm_BillPreView.frx":0000
   LinkTopic       =   "Form2"
   LockControls    =   -1  'True
   ScaleHeight     =   6915
   ScaleWidth      =   10215
   StartUpPosition =   1  '所有者中心
   WindowState     =   2  'Maximized
   Begin VB.CommandButton cmdPageFirst 
      Height          =   330
      Left            =   2655
      Picture         =   "frm_BillPreView.frx":0742
      Style           =   1  'Graphical
      TabIndex        =   10
      ToolTipText     =   "第一页"
      Top             =   45
      Width           =   735
   End
   Begin VB.CommandButton cmdPageLast 
      Height          =   330
      Left            =   3420
      Picture         =   "frm_BillPreView.frx":0A85
      Style           =   1  'Graphical
      TabIndex        =   9
      ToolTipText     =   "最后一页"
      Top             =   45
      Width           =   735
   End
   Begin VB.CommandButton cmdPageDown 
      Height          =   330
      Left            =   4185
      Picture         =   "frm_BillPreView.frx":0DC8
      Style           =   1  'Graphical
      TabIndex        =   8
      ToolTipText     =   "后一页"
      Top             =   45
      Width           =   735
   End
   Begin VB.CommandButton cmdPageUp 
      Height          =   330
      Left            =   1890
      Picture         =   "frm_BillPreView.frx":110B
      Style           =   1  'Graphical
      TabIndex        =   7
      ToolTipText     =   "前一页"
      Top             =   45
      Width           =   735
   End
   Begin VB.CommandButton cmdPrint 
      Height          =   330
      Left            =   90
      Picture         =   "frm_BillPreView.frx":144E
      Style           =   1  'Graphical
      TabIndex        =   5
      ToolTipText     =   "打印"
      Top             =   45
      Width           =   735
   End
   Begin VB.CommandButton cmdClose 
      Height          =   330
      Left            =   900
      Picture         =   "frm_BillPreView.frx":1791
      Style           =   1  'Graphical
      TabIndex        =   4
      ToolTipText     =   "关闭"
      Top             =   45
      Width           =   735
   End
   Begin VB.PictureBox pictView 
      BackColor       =   &H8000000C&
      BorderStyle     =   0  'None
      Height          =   3390
      Left            =   45
      ScaleHeight     =   3390
      ScaleWidth      =   8565
      TabIndex        =   0
      Top             =   450
      Width           =   8565
      Begin VB.HScrollBar HS 
         Height          =   285
         LargeChange     =   1000
         Left            =   0
         SmallChange     =   100
         TabIndex        =   3
         Top             =   2925
         Width           =   8250
      End
      Begin VB.VScrollBar VS 
         Height          =   3165
         LargeChange     =   1000
         Left            =   8235
         SmallChange     =   100
         TabIndex        =   2
         Top             =   0
         Width           =   285
      End
      Begin VB.PictureBox pictMain 
         AutoRedraw      =   -1  'True
         BackColor       =   &H80000005&
         BorderStyle     =   0  'None
         Height          =   2355
         Left            =   630
         MouseIcon       =   "frm_BillPreView.frx":1AD3
         MousePointer    =   99  'Custom
         ScaleHeight     =   2355
         ScaleWidth      =   4920
         TabIndex        =   1
         Top             =   225
         Width           =   4920
      End
   End
   Begin VB.Label labPage 
      AutoSize        =   -1  'True
      BackStyle       =   0  'Transparent
      Caption         =   "第 1 页 共 1 页"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H8000000D&
      Height          =   180
      Left            =   5130
      TabIndex        =   6
      Top             =   120
      Width           =   1530
   End
End
Attribute VB_Name = "frm_BillPreView"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Const PictSet = 100

'页面高宽
Dim mHeight As Double, mWidth As Double

'页边距
Dim mSLeft As Double, mSRight As Double, mSUp As Double, mSDown As Double

'True = 放大显示，False = 缩小显示
Dim ViewMod As Boolean

'观察点
Dim ViewX As Double, ViewY   As Double

'比例
Dim mHWScal As Double

Dim mPage As Integer, mPages As Integer

Private Sub cmdClose_Click()
    Unload Me
End Sub

Private Sub cmdPageDown_Click()
    If mPage < mPages Then mPage = mPage + 1: Call PViewRep
End Sub

Private Sub cmdPageFirst_Click()
    mPage = 1: Call PViewRep
End Sub

Private Sub cmdPageLast_Click()
    mPage = mPages: Call PViewRep
End Sub

Private Sub cmdPageUp_Click()
    If mPage > 1 Then mPage = mPage - 1: Call PViewRep
End Sub

Private Sub cmdPrint_Click()
    ViewMod = True
    Call BillPrint
End Sub

Public Sub PageSetup()
    Dim i As Integer

    pictMain.Cls

    '设置页面参数
    If mLandScape = 1 Then
        mHeight = mPageWidth: mWidth = mPageHeight
    Else
        mHeight = mPageHeight: mWidth = mPageWidth
    End If

    '设置页面边距
    mSLeft = mPageLeft: mSRight = mPageRight: mSUp = mPageUp: mSDown = mPageDown
    
    '页面高宽比例
    mHWScal = mHeight / mWidth
    
    pictMain.Left = PictSet: pictMain.Top = PictSet

    ViewX = 0: ViewY = 0

    mPage = 1: mPages = mTotalPage

    ViewMod = True: Call PViewRep

End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    Set frm_BillPreView = Nothing
End Sub

Private Sub Form_Resize()
    On Error Resume Next
    pictView.Move pictView.Left, pictView.Top, Me.Width - 2 * pictView.Left - 100, Me.Height - pictView.Top - pictView.Left - 400
End Sub

Private Sub Form_Unload(Cancel As Integer)
'    Set mrecBill = Nothing
'    Set mrecPrint = Nothing
'    Set mrecLine = Nothing
'    Set mrecText = Nothing

End Sub

Private Sub HS_Change()
    pictMain.Move PictSet - HS.Value
End Sub

Private Sub pictMain_Click()
    ViewMod = Not ViewMod: Call PViewRep
End Sub

Private Sub pictMain_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    ViewX = X: ViewY = Y
End Sub

Private Sub VS_Change()
    pictMain.Move pictMain.Left, PictSet - VS.Value
End Sub

Private Sub pictView_Resize()
    Dim mX, mY As Single
    
    On Error Resume Next
    
    HS.Move 0, pictView.Height - HS.Height, pictView.Width - VS.Width
    VS.Move pictView.Width - VS.Width, 0, VS.Width, pictView.Height - HS.Height

    If pictMain.Width > pictView.Width Then

        pictMain.Left = PictSet

        HS.Min = 0: HS.Max = pictMain.Width - VS.Left + 2 * PictSet

        mX = ViewX - pictView.Width / 2
        If mX < HS.Min Then mX = HS.Min
        If mX > HS.Max Then mX = HS.Max

        HS.Value = 0: HS.Value = mX
        HS.Visible = True

    Else
        pictMain.Left = (pictView.Width - pictMain.Width) / 2
        HS.Visible = False
    End If

    If pictMain.Height > pictView.Height Then

        pictMain.Top = PictSet

        VS.Min = 0: VS.Max = pictMain.Height - HS.Top + 2 * PictSet

        mY = ViewY - pictView.Height / 2
        If mY < VS.Min Then mY = VS.Min
        If mY > VS.Max Then mY = VS.Max

        VS.Value = 0: VS.Value = mY
        VS.Visible = True

    Else
        pictMain.Top = (pictView.Height - pictMain.Height) / 2
        VS.Visible = False
    End If

End Sub

'设置页面
Private Function PViewPage()
    Dim CHeight, CWidth As Long

    If ViewMod = True Then
        '实际大小显示
        CHeight = mHeight: CWidth = mWidth
    Else
        '适应窗口显示
        If (pictView.Height - 2 * PictSet) / (pictView.Width - 2 * PictSet) < mHWScal Then
            '限制高度
            CHeight = pictView.Height - 2 * PictSet: CWidth = CHeight / mHWScal
        Else
            '限制宽度
            CWidth = pictView.Width - 2 * PictSet: CHeight = CWidth * mHWScal
        End If
    End If

    pictMain.Height = CHeight: pictMain.Width = CWidth

    '映射坐标到真实大小
    pictMain.ScaleHeight = mHeight: pictMain.ScaleWidth = mWidth
    
    '重画
    Call pictView_Resize

    '缩放比例
    mPageScale = pictMain.Height / pictMain.ScaleHeight
    
End Function

'显示一页
Private Function PViewRep()
        
    labPage = "第 " & mPage & " 页/共 " & mPages & " 页"
    Me.MousePointer = vbHourglass
    pictMain.Cls
    Call PViewPage
    Call ShowBillData(mPage)
    pictMain.Visible = True
    Me.MousePointer = vbDefault

End Function