frmmultipgpreview_bmpjpg3.frm

打印预览程序

            Call Command1_Click(1)
        Else
            HScroll1.Value = HScroll1.Value + HScroll1.SmallChange
        End If
    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 cmdNewFolder_Click()
  Dim NewFolderName As String
  Dim Security As SECURITY_ATTRIBUTES
  
    NewFolderName = InputBox("Enter Folder Name", , "New Folder")
    NewFolderName = Trim(NewFolderName)
    If NewFolderName > vbNullString Then
        CreateDirectory Dir1.Path & "\" & NewFolderName, Security
        NewFolderName = Dir1.Path & "\" & NewFolderName
        Dir1.Refresh
        Dir1.Path = NewFolderName
    End If
        
End Sub

Private Sub cmdOpen_Click()
  Dim FolderName As String
  Dim ReportTitle As String
  Dim i As Integer, FileExt As String
  
    FolderName = Dir1.Path & "\"
    picGetFolder.Visible = False
    
    picPrintOptions.Visible = True
    picPrintOptions.Enabled = False
    lblPrintingPg.Visible = True
    cmdPrint.Visible = False
    
    On Local Error GoTo CopyError:

    DoEvents
    ReportTitle = Trim(cPrint.ReportTitle)
    If ReportTitle = vbNullString Or InStr(ReportTitle, "\") Then
        ReportTitle = "PPview"
    End If
    
    If OptFileType(0).Value Then FileExt = ".jpg" Else FileExt = ".gif"
    Set gdip = New cGdiPlus
    For i = 0 To PageNumber
       lblPrintingPg.Caption = "Copying page " & i + 1
       lblPrintingPg.Refresh
       
       Picture1.Picture = LoadPicture(TempDir & "PPview" & CStr(i) & ".bmp")
       gdip.PictureBoxToFile Picture1, FolderName & ReportTitle & CStr(i + 1) & FileExt
       
       'DIBmpToJpg TempDir & "PPview" & CStr(i) & ".bmp", FolderName & ReportTitle & CStr(i + 1) & ".jpg", 100, 1
    Next
        
    '/* Restore normal view
    picPrintOptions.Enabled = True
    cmdPrint.Visible = True
    picPrintOptions.Visible = False
    lblPrintingPg.Visible = False
    
    Picture1.Picture = LoadPicture(TempDir & "PPview" & CStr(ViewPage) & ".bmp")
    Set gdip = Nothing

Exit Sub

CopyError:
    If Err.Number = 76 Then
        ReportTitle = "PPview"
        Resume
    End If
End Sub

Private Sub cmdQuit_Click()
    picGetFolder.Visible = False
    '/* Restore normal view
    picPrintOptions.Enabled = True
    cmdPrint.Visible = True
    picPrintOptions.Visible = False
    lblPrintingPg.Visible = False
End Sub

Private Sub cmdUpOne_Click()
    Dir1.Path = Dir1.List(-2)
End Sub

Private Sub Dir1_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    Dir1.Path = Dir1.List(Dir1.ListIndex)
End Sub

Private Sub Drive1_Change()
    Dir1.Path = Drive1.Drive
End Sub

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

Private Sub Picture1_KeyUp(KeyCode As Integer, Shift As Integer)
    Call Decode_KeyUp(KeyCode, Shift)
End Sub

Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
   On Local Error Resume Next
   If Button = vbLeftButton And Shift = 0 Then
      PanSet.x = x
      PanSet.y = y
      MousePointer = vbSizePointer
   End If
End Sub

Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
   Dim nTop As Integer, nLeft As Integer

   On Local Error Resume Next

   
   If Button = vbLeftButton And Shift = 0 Then

      '/* new coordinates?
      With Picture1
         nTop = -(.Top + (y - PanSet.y))
         nLeft = -(.Left + (x - PanSet.x))
      End With

      '/* Check limits
      With VScroll1
         If .Visible Then
            If nTop < .Min Then
               nTop = .Min
               'MousePageChange = 1
            ElseIf nTop > .Max Then
               nTop = .Max
               'MousePageChange = 2
            Else
               'MousePageChange = 0
            End If
         Else
            nTop = -Picture1.Top
         End If
      End With

      With HScroll1
         If .Visible Then
            If nLeft < .Min Then
               nLeft = .Min
            ElseIf nLeft > .Max Then
               nLeft = .Max
            End If
         Else
            nLeft = -Picture1.Left
         End If
      End With

      Picture1.Move -nLeft, -nTop

   End If

End Sub

Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
   On Local Error Resume Next
   If Button = vbLeftButton And Shift = 0 Then
      If VScroll1.Visible Then VScroll1.Value = -(Picture1.Top)
      If HScroll1.Visible Then HScroll1.Value = -(Picture1.Left)
   End If
   MousePointer = vbDefault
   'If MousePageChange > 0 Then Command1_Click (MousePageChange - 1)
End Sub

Private Sub txtFrom_Change()
    If Val(txtFrom) < 1 Then txtFrom = 1
    If Val(txtFrom) > Val(txtTo) Then txtFrom = txtTo
End Sub

Private Sub txtFrom_GotFocus()
    txtFrom.SelStart = 0
    txtFrom.SelLength = Len(txtFrom)
End Sub

Private Sub txtFrom_KeyDown(KeyCode As Integer, Shift As Integer)
    Select Case KeyCode
    Case 38  '/* "+"
        txtFrom = txtFrom + 1
        KeyCode = False
    Case 40  '/* "-"
        txtFrom = txtFrom - 1
        KeyCode = False
    End Select
End Sub

Private Sub txtFrom_KeyPress(KeyAscii As Integer)
    IsNumber txtFrom, KeyAscii, False, False
End Sub

Private Sub txtGoto_Change()
    If Val(txtGoto) > PageNumber + 1 Then txtGoto = PageNumber + 1
End Sub

Private Sub txtGoto_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        KeyAscii = 0
        cmdGotoOK_Click
    ElseIf (KeyAscii < 48 Or KeyAscii > 57) And KeyAscii <> 8 Then
        KeyAscii = 0
    End If
End Sub


Private Sub txtTo_Change()
    If Val(txtTo) > PageNumber + 1 Then txtTo = PageNumber + 1
    If Val(txtTo) < Val(txtFrom) Then txtTo = txtFrom
End Sub

Private Sub txtTo_GotFocus()
    txtTo.SelStart = 0
    txtTo.SelLength = Len(txtTo)
End Sub

Private Sub txtTo_KeyDown(KeyCode As Integer, Shift As Integer)
    Select Case KeyCode
    Case 38  '/* "+"
        txtTo = txtTo + 1
        KeyCode = False
    Case 40  '/* "-"
        txtTo = txtTo - 1
        KeyCode = False
    End Select
End Sub

Private Sub txtTo_KeyPress(KeyAscii As Integer)
    IsNumber txtTo, KeyAscii, False, False
End Sub

Private Sub VScroll1_Change()
    On Local Error Resume Next
    Picture1.Top = -(VScroll1.Value)
    Picture1.SetFocus
    On Local Error GoTo 0
End Sub

Private Sub DisplayPages()
    Label1 = CStr(ViewPage + 1) & vbNewLine & "-- of --" & vbNewLine & CStr(PageNumber + 1)
    
    If Picture1.Width > Me.Width - Picture2.Width Then
        picHScroll.Visible = True
    Else
        picHScroll.Visible = False
    End If

    If Picture1.Height >= Me.Height Then
        VScroll1.Visible = True
    Else
        VScroll1.Visible = False
    End If
    
    If picFullPage.Visible Then cmdFullPage_Click
    
End Sub
Private Sub PrintPictureBox(pBox As PictureBox, _
                           Optional ScaleToFit As Boolean = True, _
                           Optional MaintainRatio As Boolean = True)
 
 Dim xmin As Single
 Dim ymin As Single
 Dim wid As Single
 Dim hgt As Single
 Dim aspect As Single
 
    Screen.MousePointer = vbHourglass
    
    If Not ScaleToFit Then
        wid = Printer.ScaleX(pBox.ScaleWidth, pBox.ScaleMode, Printer.ScaleMode)
        hgt = Printer.ScaleY(pBox.ScaleHeight, pBox.ScaleMode, Printer.ScaleMode)
        xmin = (Printer.ScaleWidth - wid) / 2
        ymin = (Printer.ScaleHeight - hgt) / 2
    Else
        aspect = pBox.ScaleHeight / pBox.ScaleWidth
        wid = Printer.ScaleWidth
        hgt = Printer.ScaleHeight
        
        If MaintainRatio Then
            If hgt / wid > aspect Then
                hgt = aspect * wid
                xmin = Printer.ScaleLeft
                ymin = (Printer.ScaleHeight - hgt) / 2
            Else
                wid = hgt / aspect
                xmin = (Printer.ScaleWidth - wid) / 2
                ymin = Printer.ScaleTop
            End If
        End If
    End If
    
    Printer.PaintPicture pBox.Picture, xmin, ymin, wid, hgt, , , , , vbSrcCopy
    Printer.EndDoc
    
    Printer.Orientation = cPrint.Orientation

    Screen.MousePointer = vbDefault

End Sub

Private Sub VScroll1_KeyUp(KeyCode As Integer, Shift As Integer)
   On Local Error Resume Next
    Select Case KeyCode
    Case 37, 33 '/* Arrow left, PageUp
        If HScroll1.Visible = False Then
            Call Command1_Click(0)
        Else
            HScroll1.Value = HScroll1.Value - HScroll1.SmallChange
        End If
    Case 39, 34 '/* Arrow right, PageDown
        If HScroll1.Visible = False Then
            Call Command1_Click(1)
        Else
            HScroll1.Value = HScroll1.Value + HScroll1.SmallChange
        End If
    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