frmpreview.frm

地面测试仪

    
ErrHandle:
    Select Case Err.Number
        Case Else
            MsgBox Err.Number & " " & Err.Description, , "Preview - PreviewZoomIn"
            Resume Next
    End Select

End Sub

Private Sub PreviewZoomOut()
On Error GoTo ErrHandle
    With cboPercent
        If .ListIndex + 1 < .ListCount Then
            ScalePercent = ScalePercent - 10
            .ListIndex = .ListIndex + 1
        End If
    End With
    
    Exit Sub
    
ErrHandle:
    Select Case Err.Number
        Case Else
            MsgBox Err.Number & " " & Err.Description, , "Preview - PreviewZoomOut"
            Resume Next
    End Select

End Sub

Private Sub ResizeScrollBars()
On Error Resume Next
' Check if scrollbars need to be added
    With vscPreview
'Determine if the Vertical scrollbar needs to be displayed
        If picChild.Height > picParent.Height Then
            .Visible = True
            .Max = picChild.Height - picParent.ScaleHeight
            .Min = 0
            .LargeChange = picChild.Height - picParent.Height
            imgCorner.Visible = True
        Else
            .Visible = False
            imgCorner.Visible = False
        End If
    End With
    
    With hscPreview
'Determine if the Horizontal scrollbar needs to be displayed
        If picChild.Width > picParent.Width Then
            .Visible = True
            .Max = picChild.Width - picParent.ScaleWidth
            .Min = 0
            .LargeChange = picChild.Width - picParent.ScaleWidth
            imgCorner.Visible = True
        Else
            .Visible = False
            imgCorner.Visible = False
        End If
    End With

End Sub

Public Sub SizePreview(lWidth As Long, lHeight As Long)

    Dim iCount As Integer
   
        With picPreview(1)
            .Left = 0
            .Top = 0
            .Width = lWidth
            .Height = lHeight
        End With
   
    picChild.Move 0, 0, lWidth, lHeight
    
End Sub

Private Sub btnPreview_Click(Index As Integer)
Dim i As Integer
    Select Case Index
        Case 0  '打印
           On Error GoTo errhandler
'            frmWork.printReport Printer
            For i = 1 To picPreview.Count
                If i <> 1 Then
                    Printer.NewPage
                End If
                Printer.PaintPicture picPreview(i).Image, 0, 0, picPreview(i).Width, picPreview(i).Height ', 0, 0, Printer.Width, Printer.Height
                
            Next
            Printer.EndDoc
            
            MsgBox "打印完毕！！！"
        Case 1 '设置
               On Error GoTo errhandler
'                Printer.PaperSize = vbPRPSB5
                mDialog.Flags = cdlPDPrintSetup
                mDialog.PrinterDefault = True
                mDialog.ShowPrinter
                Printer.Orientation = mDialog.Orientation
           
                Form_Activate
                DoEvents

        Case 2 '还原
            ScalePercent = 100
            cboPercent.Text = "100%"
            Me.PictureShow tabPreview.SelectedItem.Index
        Case 3  '缩小
            PreviewZoomIn
        Case 4  '放大
            PreviewZoomOut
        Case 5  '打印当前页
        On Error GoTo errhandler
            i = tabPreview.SelectedItem.Index
            Printer.PaintPicture picPreview(i).Image, 0, 0, picPreview(i).Width, picPreview(i).Height
            Printer.EndDoc
            MsgBox "打印完毕！！！"
    End Select
errhandler:
                
                Exit Sub
End Sub

Private Sub cboPercent_Change()

    If bLoad = False Then
        With cboPercent
            ScalePercent = CInt(Left(.list(.ListIndex), Len(.list(.ListIndex)) - 1))
        End With
        PictureShow tabPreview.SelectedItem.Index
    End If
    
End Sub

Private Sub cboPercent_Click()

    If bLoad = False Then
        With cboPercent
            ScalePercent = CInt(Left(.list(.ListIndex), Len(.list(.ListIndex)) - 1))
        End With
        PictureShow tabPreview.SelectedItem.Index
    End If

End Sub

Private Sub cmdClose_Click()

    Unload Me
    
End Sub




Private Sub Form_Activate()

     Printer.Orientation = 2 '横向
    '--------------------------------
    SizePreview Printer.Width, Printer.Height
    DoEvents
    drawPic

    picChild.Move 0, 0, picPreview(1).Width, picPreview(1).Height
    picChild.Picture = LoadPicture()

    tabPreview_Click

     
End Sub

Private Sub Form_Load()

        bLoad = True
        FillCboPercent
        ScalePercent = 100
        WindowState = vbMaximized
        bLoad = False
'        Printer.Orientation = 1
    
End Sub

Private Sub Form_Resize()

    On Error Resume Next
    
    If WindowState = vbMinimized Then Exit Sub
    
    picToolbar.Move 0, 0, Width
    With tabPreview
        .Move lBorder, ScaleHeight - .Height - lBorder, ScaleWidth - (2 * lBorder)
        picParent.Move lBorder, lBorder + picToolbar.Height, ScaleWidth - (2 * lBorder), ScaleHeight - .Height - picToolbar.Height - (2 * lBorder)
    End With
    
End Sub

Private Sub hscPreview_Change()
    picChild.Left = (-hscPreview.Value)
End Sub

Private Sub hscPreview_Scroll()
    picChild.Left = (-hscPreview.Value)
End Sub

Private Sub picParent_Resize()
    
    Dim iCount As Integer
    
    With picParent
'Set up the Vertical Scroll Bar
        vscPreview.Move .ScaleLeft + .ScaleWidth - vscPreview.Width, .ScaleTop, vscPreview.Width, .ScaleHeight - hscPreview.Height

'Set up the Horizontal Scroll Bar
        hscPreview.Move 0, .ScaleHeight - hscPreview.Height, .ScaleWidth - vscPreview.Width

        imgCorner.Move vscPreview.Left, hscPreview.Top
    End With
    ResizeScrollBars
    
End Sub


Private Sub tabPreview_Click()

'Display the selected page
   
    With picPreview(tabPreview.SelectedItem.Index)
    
        .Picture = .Image
        picChild.Picture = .Picture
        PictureShow tabPreview.SelectedItem.Index
    End With

End Sub

Private Sub vscPreview_Change()
    picChild.Top = (-vscPreview.Value)
End Sub

Private Sub vscPreview_Scroll()
    picChild.Top = (-vscPreview.Value)
End Sub
Public Sub AddPage(PageNumber As Integer)

    If PageNumber > 1 Then
        Load picPreview(PageNumber)
        Set picPreview(PageNumber) = Nothing
        tabPreview.Tabs.Add PageNumber, , "第 " & PageNumber & "页"
    End If
    
End Sub


Sub drawPic()
Dim i As Integer

    Select Case PicFlag
    Case 1, 4 '液面套压
        drawReport picPreview(1)
        AddPage 2
        drawDataReport picPreview(2)
        AddPage 3
        drawYt picPreview(3), , True
    Case 2 '静液面
        drawJp picPreview(1), True
    Case 3 '动液面
        For i = 1 To UBound(TempDmyData.dmyHL) \ TempDmyData.HLRowPiont
            drawFrequency picPreview(1), (i - 1) * TempDmyData.HLRowPiont + 1, False
        Next
    Case 5 '检定报表
        drawJianDingBaoBiao picPreview(1)
    Case 6 '液面检定报表
        drawJianDingYeMianBaoBiao picPreview(1)
    
    End Select
End Sub