frmmultipgpreview_withchart.frm

打印预览程序

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)
    HScroll1.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
        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 3
        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 3
        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
            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
        VScroll1.Value = 0
        HScroll1.Value = 0
        Call DisplayPages
    End Select
End Sub

Private Sub Picture1_Click()
    picPrintOptions.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
            ElseIf nTop > .Max Then
               nTop = .Max
            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
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 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)
    VScroll1.SetFocus
    On Local Error GoTo 0
End Sub


Private Sub DisplayPages()
    Label1 = CStr(ViewPage + 1) & vbNewLine & "-- 至 --" & 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

    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
        VScroll1.Value = 0
        HScroll1.Value = 0
        Call DisplayPages
    End Select
End Sub