frmmultipgpreview_withchart.frm

打印预览程序

         Width           =   1965
      End
   End
   Begin VB.PictureBox Picture1 
      Appearance      =   0  'Flat
      AutoRedraw      =   -1  'True
      BackColor       =   &H00FFFFFF&
      BeginProperty Font 
         Name            =   "Times New Roman"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H80000008&
      Height          =   4845
      Left            =   0
      ScaleHeight     =   321
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   249
      TabIndex        =   12
      TabStop         =   0   'False
      Top             =   0
      Width           =   3765
   End
   Begin VB.PictureBox PictChart 
      Appearance      =   0  'Flat
      AutoRedraw      =   -1  'True
      BorderStyle     =   0  'None
      ForeColor       =   &H80000008&
      Height          =   900
      Left            =   3570
      ScaleHeight     =   900
      ScaleWidth      =   1305
      TabIndex        =   21
      Top             =   5085
      Visible         =   0   'False
      Width           =   1305
      Begin MSChart20Lib.MSChart Chart1 
         Height          =   750
         Left            =   0
         OleObjectBlob   =   "frmMultiPgPreview_WithChart.frx":0BE6
         TabIndex        =   22
         Top             =   0
         Width           =   1095
      End
   End
   Begin VB.Image optArt 
      Appearance      =   0  'Flat
      Height          =   225
      Index           =   1
      Left            =   0
      Picture         =   "frmMultiPgPreview_WithChart.frx":2F3C
      Top             =   4860
      Visible         =   0   'False
      Width           =   300
   End
   Begin VB.Image optArt 
      Appearance      =   0  'Flat
      Height          =   225
      Index           =   0
      Left            =   555
      Picture         =   "frmMultiPgPreview_WithChart.frx":2FE9
      Top             =   4875
      Visible         =   0   'False
      Width           =   300
   End
End
Attribute VB_Name = "frmMultiPgPreview"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'****************************************************************************
'人人为我，我为人人
'枕善居汉化收藏整理
'发布日期：05/05/13
'描  述：打印预览源码示例---MsChart
'网  站：http://www.mndsoft.com/
'e-mail：[e-mail]
'OICQ  : 88382850
'****************************************************************************'/*************************************/
'/* Author: Morgan Haueisen
'/*         [e-mail]
'/* Copyright (c) 1999-2003
'/*************************************/
'Legal:
'        This is intended for and was uploaded to www.planetsourcecode.com
'
'        Redistribution of this code, whole or in part, as source code or in binary form, alone or
'        as part of a larger distribution or product, is forbidden for any commercial or for-profit
'        use without the author's explicit written permission.
'
'        Redistribution of this code, as source code or in binary form, with or without
'        modification, is permitted provided that the following conditions are met:
'
'        Redistributions of source code must include this list of conditions, and the following
'        acknowledgment:
'
'        This code was developed by Morgan Haueisen.  <[e-mail]>
'        Source code, written in Visual Basic, is freely available for non-commercial,
'        non-profit use at www.planetsourcecode.com.
'
'        Redistributions in binary form, as part of a larger project, must include the above
'        acknowledgment in the end-user documentation.  Alternatively, the above acknowledgment
'        may appear in the software itself, if and wherever such third-party acknowledgments
'        normally appear.

Option Explicit

'/* Used for Manifest files (Win XP)
Private Declare Function InitCommonControls Lib "Comctl32.dll" () As Long

Public PageNumber As Integer
Private ViewPage As Integer
Private TempDir As String
Private OptionV As Integer

Private Type PanState
   x As Long
   y As Long
End Type
Dim PanSet As PanState

Private Declare Function StretchBlt Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, _
    ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, _
    ByVal xSrc As Long, ByVal ySrc As Long, ByVal nSrcWidth As Long, ByVal nSrcHeight As Long, _
    ByVal dwRop As Long) As Long

Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" _
    (lpVersionInformation As OSVersionInfo) As Long

Private Type OSVersionInfo
    OSVSize As Long
    dwVerMajor As Long
    dwVerMinor As Long
    dwBuildNumber As Long
    PlatformID As Long
    szCSDVersion As String * 128
End Type
Private UseStretchBit As Boolean

Private Sub cmdFullPage_Click()
  Dim xmin As Single
  Dim ymin As Single
  Dim wid As Single
  Dim hgt As Single
  Dim aspect As Single
 
    '/* If already here then restore original
    If cmdFullPage.Value = 0 Then
        Picture1.Visible = True
        Picture1.SetFocus
        picFullPage.Visible = False
        Set picFullPage.Picture = Nothing
        Exit Sub
    End If
    
    Screen.MousePointer = vbHourglass
    DoEvents
    
    '/* Clear any picture and set the size and loaction
    Set picFullPage.Picture = Nothing
    If Not picHScroll.Visible Then
        picFullPage.Height = Me.Height - 100
        picFullPage.Width = picFullPage.Height * 0.773
        picFullPage.Move ((Me.Width - Picture2.Width) - picFullPage.Width) \ 2, 0
    Else
        picFullPage.Top = 50
        picFullPage.Left = 50
        picFullPage.Width = Me.Width - Picture2.Width - 100
        picFullPage.Height = picFullPage.Width * 0.773
    End If
        
    '/* Get the scale values
    aspect = Picture1.ScaleHeight / Picture1.ScaleWidth
    wid = picFullPage.ScaleWidth
    hgt = picFullPage.ScaleHeight
    
    '/* MaintainRatio
    If hgt / wid > aspect Then
        hgt = aspect * wid
        xmin = picFullPage.ScaleLeft
        ymin = (picFullPage.ScaleHeight - hgt) / 2
    Else
        wid = hgt / aspect
        xmin = (picFullPage.ScaleWidth - wid) / 2
        ymin = picFullPage.ScaleTop
    End If
    
    If UseStretchBit Then '/* NT platform
        StretchBlt picFullPage.hdc, _
            xmin, ymin, wid, hgt, _
            Picture1.hdc, _
            0, 0, Picture1.ScaleWidth, Picture1.ScaleHeight, vbSrcCopy
    Else
        picFullPage.PaintPicture Picture1.Picture, _
          xmin, ymin, wid, hgt, _
          0, 0, Picture1.ScaleWidth, Picture1.ScaleHeight, vbSrcCopy
    End If


    Picture1.Visible = False
    picFullPage.Visible = True
    picFullPage.SetFocus
    
    Screen.MousePointer = vbDefault
    
End Sub

Private Sub cmd_print_Click()
    txtTo.Text = PageNumber + 1
    OptionV = 3
    Call optText_Click(OptionV)
    picPrintOptions.Left = Me.Width - (Picture2.Width + picPrintOptions.Width + 50)
    picPrintOptions.Visible = True
End Sub

Private Function IsNumber(ByVal CheckString As String, Optional KeyAscii As Integer = 0, Optional AllowDecPoint As Boolean = False, Optional AllowNegative As Boolean = False) As Boolean
    If KeyAscii > 0 And KeyAscii <> 8 Then
        If Not AllowNegative And KeyAscii = 45 Then KeyAscii = 0
        If Not AllowDecPoint And KeyAscii = 46 Then KeyAscii = 0
        If Not IsNumeric(CheckString & Chr(KeyAscii)) Then
            KeyAscii = False
            IsNumber = False
        Else
            IsNumber = True
        End If
    Else
        IsNumber = IsNumeric(CheckString)
    End If
End Function

Private Sub cmd_quit_Click()
    cPrint.SendToPrinter = False
    Unload Me
End Sub

Private Sub cmdGoTo_Click()
  Dim NewPageNo As Variant
    On Local Error Resume Next
    
    
    cmd_print.SetFocus
    
    NewPageNo = InputBox("输入跳转到的页码", "页码", 1)
    NewPageNo = Val(NewPageNo)
    
    If NewPageNo = 0 Then Exit Sub
    
    NewPageNo = NewPageNo - 1
    If NewPageNo > PageNumber Then NewPageNo = PageNumber
    ViewPage = NewPageNo
        
    Picture1.Picture = LoadPicture(TempDir & "PPview" & CStr(ViewPage) & ".bmp")
    
    picPrintOptions.Visible = False
    VScroll1.Value = 0
    HScroll1.Value = 0
    Call DisplayPages

End Sub

Private Sub cmdPrint_Click()
  Dim i As Integer
  
    '/* Prevent printing again until done
    cmd_print.SetFocus
    picPrintOptions.Enabled = False
    lblPrintingPg.Visible = True
    cmdPrint.Visible = False
    
    Select Case OptionV
    Case 0 '/* Copy to clipboard
        Clipboard.Clear
        Clipboard.SetData Picture1.Picture, vbCFBitmap
    Case 1 '/* Print current page
        lblPrintingPg.Caption = "Printing page " & ViewPage + 1
        lblPrintingPg.Refresh
        Call PrintPictureBox(Picture1, True, False)
    Case 2 '/* Print range
        For i = Val(txtFrom) - 1 To Val(txtTo) - 1
            lblPrintingPg.Caption = "Printing page " & CStr(i + 1) & " of " & txtTo
            lblPrintingPg.Refresh
            Picture1.Picture = LoadPicture(TempDir & "PPview" & CStr(i) & ".bmp")
            Call PrintPictureBox(Picture1, True, False)
        Next i
        Picture1.Picture = LoadPicture(TempDir & "PPview" & CStr(ViewPage) & ".bmp")
    Case Else '/* Print all
        cPrint.SendToPrinter = True '/* Send to Printer */
        Unload Me
    End Select
    
    '/* Restore normal view
    picPrintOptions.Enabled = True
    cmdPrint.Visible = True
    picPrintOptions.Visible = False
    lblPrintingPg.Visible = False

End Sub

Private Sub Command1_Click(Index As Integer)
    On Local Error Resume Next
    If Index = 0 Then
        ViewPage = ViewPage - 1
        If ViewPage < 0 Then ViewPage = 0
        Picture1.Picture = LoadPicture(TempDir & "PPview" & CStr(ViewPage) & ".bmp")
    Else
        ViewPage = ViewPage + 1
        If ViewPage > PageNumber Then ViewPage = PageNumber
        Picture1.Picture = LoadPicture(TempDir & "PPview" & CStr(ViewPage) & ".bmp")
    End If
    
    Picture1.Top = 0
    'Picture1.Refresh
    picPrintOptions.Visible = False
    VScroll1.Value = 0
    HScroll1.Value = 0
    Call DisplayPages
    
End Sub

Private Sub Form_Activate()
    Screen.MousePointer = vbDefault
    Call DisplayPages
    If Picture1.Width < Me.Width - Picture2.Width Then
        Picture1.Move ((Me.Width - Picture2.Width) - Picture1.Width) \ 2, 0
    End If
End Sub

Private Sub Form_Click()
    picPrintOptions.Visible = False
End Sub


Private Sub Form_Initialize()
    '/* Used for Manifest files (Win XP)
    Call InitCommonControls
End Sub

Private Sub Form_Load()
  Dim OSV As OSVersionInfo
  Const VER_PLATFORM_WIN32_NT = 2
    
    OSV.OSVSize = Len(OSV)
    If GetVersionEx(OSV) = 1 Then
        If OSV.PlatformID = VER_PLATFORM_WIN32_NT Then
            UseStretchBit = True
        Else
            UseStretchBit = False
        End If
    End If

    Me.Move 0, 0, Screen.Width, Screen.Height
    Picture1.Move 0, 0

    VScroll1.Height = Me.Height - cmdGoTo.Top - cmdGoTo.Height - 500
    HScroll1.Width = Me.Width - Picture2.Width - 500
    
    TempDir = Environ("TEMP") & "\"