frmmultipgpreview_bmpjpg3.frm

打印预览程序

    dwBuildNumber As Long
    PlatformID As Long
    szCSDVersion As String * 128
End Type
Private UseStretchBit As Boolean

Private Sub cmd_print_Click()
    txtTo.Text = PageNumber + 1
    OptionV = 3
    Call optText_Click(OptionV)
    picGoto.Visible = False
    
    picPrintOptions.Left = Me.Width - (Picture2.Width + picPrintOptions.Width + 50)
    picPrintOptions.Top = cmd_print.Top
    
    picGetFolder.Left = Me.Width - (Picture2.Width + picGetFolder.Width + 50)
    picGetFolder.Top = cmd_print.Top
    
    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 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
        cmdFullPage.Picture = imgFit(0).Picture
        Exit Sub
    End If
    
    Screen.MousePointer = vbHourglass
    DoEvents
    cmdFullPage.Picture = imgFit(1).Picture
    
    '/* 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

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

Private Sub cmdGoTo_Click()
    picGoto.Top = cmdGoTo.Top
    picGoto.Left = Me.Width - (Picture2.Width + picGoto.Width + 50)
    picGoto.Visible = True
    picGoto.ZOrder
    txtGoto = CStr(ViewPage + 1)
    txtGoto.SelStart = 0
    txtGoto.SelLength = Len(txtGoto)
    txtGoto.SetFocus
End Sub

Private Sub cmdGotoOK_Click()
  Dim NewPageNo As Integer
    
    On Local Error Resume Next
    
    txtGoto.SetFocus
    NewPageNo = Val(txtGoto)
    If NewPageNo = 0 Then Exit Sub
    
    NewPageNo = NewPageNo - 1
    If NewPageNo > PageNumber Then NewPageNo = PageNumber
    ViewPage = NewPageNo
        
    Picture1.SetFocus
    Picture1.Picture = LoadPicture(TempDir & "PPview" & CStr(ViewPage) & ".bmp")
    
    picPrintOptions.Visible = False
    picGetFolder.Visible = False
    picGoto.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
    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 4
        picGetFolder.Visible = True
        picGetFolder.ZOrder
    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
    picPrintOptions.Visible = False
    picGoto.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
    cmdFullPage.Picture = imgFit(0).Picture
    Label5 = "Goto Page#" & vbCrLf & "(1 to " & CStr(PageNumber + 1) & ")"
    Picture1.SetFocus
End Sub

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


Private Sub Form_Initialize()
    '/* Used for Manifest files (Win XP)
    Call InitCommonControls
    'MakeXPButton cmd_quit
    'MakeXPButton cmd_print
    'MakeXPButton cmdFullPage
    'MakeXPButton cmdGoTo
    'MakeXPButton Command1(0)
    'MakeXPButton Command1(1)
End Sub

Private Sub Form_KeyPress(KeyAscii As Integer)
    If KeyAscii = 71 Or KeyAscii = 103 Then cmdGoTo_Click
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") & "\"
 
End Sub

Private Sub Form_Unload(Cancel As Integer)
  Dim tFilename As String
    
    '/* Remove preview pages
    tFilename = Dir(TempDir & "PPview*.bmp")
    If tFilename > vbNullString Then
        Do
            Kill TempDir & tFilename
            tFilename = Dir(TempDir & "PPview*.bmp")
        Loop Until tFilename = vbNullString
    End If
    
    PageNumber = 0
    ViewPage = 0
    Set frmMultiPgPreview = Nothing
End Sub

Private Sub HScroll1_Change()
    On Local Error Resume Next
    Picture1.Left = -(HScroll1.Value)
    Picture1.SetFocus
    On Local Error GoTo 0
End Sub

Private Sub HScroll1_KeyUp(KeyCode As Integer, Shift As Integer)
   On Local Error Resume Next
    Select Case KeyCode
    Case 38 '/* Arrow up
        VScroll1.Value = VScroll1.Value - VScroll1.SmallChange
    Case 40 '/* Arrow down
        VScroll1.Value = VScroll1.Value + VScroll1.SmallChange
    Case 33 '/* PageUp
        Call Command1_Click(0)
    Case 34 '/* PageDown
        Call Command1_Click(1)
    Case 71 '/* G
        Call cmdGoTo_Click
    Case 35, 36 '/* Home, End
      Dim NewPageNo As Long
        If KeyCode = 36 Then
            NewPageNo = 0
        Else
            NewPageNo = PageNumber
        End If
        ViewPage = NewPageNo
        Picture1.Picture = LoadPicture(TempDir & "PPview" & CStr(ViewPage) & ".bmp")
        picPrintOptions.Visible = False
        picGetFolder.Visible = False
        picGoto.Visible = False
        VScroll1.Value = 0
        HScroll1.Value = 0
        Call DisplayPages
    End Select

End Sub

Private Sub optPrint_Click(Index As Integer)
  Dim i As Byte
    OptionV = Index
    For i = 0 To 4
        If Index = i Then
            optPrint(i).Picture = optArt(1).Picture
        Else
            optPrint(i).Picture = optArt(0).Picture
        End If
    Next i

End Sub

Private Sub optText_Click(Index As Integer)
  Dim i As Byte
    OptionV = Index
    For i = 0 To 4
        If Index = i Then
            optPrint(i).Picture = optArt(1).Picture
        Else
            optPrint(i).Picture = optArt(0).Picture
        End If
    Next i

End Sub

Private Sub picFullPage_KeyUp(KeyCode As Integer, Shift As Integer)
    Call Decode_KeyUp(KeyCode, Shift)
End Sub
Private Sub Decode_KeyUp(KeyCode As Integer, Shift As Integer)
   On Local Error Resume Next
    Select Case KeyCode
    Case 38 '/* Arrow up
        VScroll1.Value = VScroll1.Value - VScroll1.SmallChange
    Case 40 '/* Arrow down
        VScroll1.Value = VScroll1.Value + VScroll1.SmallChange
    Case 37 '/* Arrow left
        If HScroll1.Visible = False Then
            Call Command1_Click(0)
        Else
            HScroll1.Value = HScroll1.Value - HScroll1.SmallChange
        End If
    Case 39 '/* Arrow right
        If HScroll1.Visible = False Then