preview.frm

文档编程软件,类似WORD的一个编辑工具.

VERSION 5.00
Object = "{4932CEF1-2CAA-11D2-A165-0060081C43D9}#2.0#0"; "ACTBAR2.OCX"
Begin VB.Form frmPreview 
   Caption         =   "打印预览"
   ClientHeight    =   4440
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   5145
   LinkTopic       =   "Form1"
   MDIChild        =   -1  'True
   MinButton       =   0   'False
   ScaleHeight     =   4440
   ScaleWidth      =   5145
   WindowState     =   2  'Maximized
   Begin ActiveBar2LibraryCtl.ActiveBar2 abPreview 
      Align           =   1  'Align Top
      Height          =   4440
      Left            =   0
      TabIndex        =   0
      Top             =   0
      Width           =   5145
      _LayoutVersion  =   1
      _ExtentX        =   9075
      _ExtentY        =   7832
      _DataPath       =   ""
      Bands           =   "Preview.frx":0000
      Begin VB.PictureBox picParent 
         Height          =   2835
         Left            =   150
         ScaleHeight     =   2775
         ScaleWidth      =   4035
         TabIndex        =   1
         Top             =   750
         Width           =   4095
         Begin VB.PictureBox picPreview 
            AutoRedraw      =   -1  'True
            BackColor       =   &H00FFFFFF&
            BorderStyle     =   0  'None
            Height          =   2055
            Index           =   0
            Left            =   60
            ScaleHeight     =   2055
            ScaleWidth      =   3075
            TabIndex        =   5
            Top             =   0
            Visible         =   0   'False
            Width           =   3075
         End
         Begin VB.VScrollBar vscPreview 
            Height          =   2475
            LargeChange     =   2000
            Left            =   3720
            SmallChange     =   500
            TabIndex        =   4
            Top             =   120
            Width           =   195
         End
         Begin VB.HScrollBar hscPreview 
            Height          =   195
            LargeChange     =   2000
            Left            =   300
            SmallChange     =   500
            TabIndex        =   3
            Top             =   2280
            Width           =   2895
         End
         Begin VB.PictureBox imgCorner 
            BorderStyle     =   0  'None
            ClipControls    =   0   'False
            Height          =   240
            Left            =   3360
            ScaleHeight     =   240
            ScaleWidth      =   240
            TabIndex        =   2
            Top             =   2340
            Visible         =   0   'False
            Width           =   240
         End
         Begin VB.Image picChild 
            Height          =   1875
            Left            =   720
            Stretch         =   -1  'True
            Top             =   360
            Width           =   2655
         End
      End
   End
End
Attribute VB_Name = "frmPreview"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'版权所有(C) Gelowitz - http://www.visual-statement.com/vb
'------HHZealot 翻译([e-mail])-----
Option Explicit

Private Type Rect
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Private Type CharRange
    cpMin As Long     '范围的第一个字符(从 0 到文档结束)
    cpMax As Long     '范围的最后一个字符(从 -1 到文档结束)
End Type

Private Type FormatRange
    hdc As Long       '实际用来绘制的设备描述体的句柄
    hdcTarget As Long '决定文字格式的目标的设备描述体的句柄
    rc As Rect        '用于绘制的设备描述体的句柄的区域(单位为“缇”)
    rcPage As Rect    '整个设备描述体的句柄的范围(页大小)(单位为“缇”)
    chrg As CharRange '用于绘制文字的范围(参见以下声明)
End Type

Private Const WM_USER As Long = &H400
Private Const EM_FORMATRANGE As Long = WM_USER + 57
Private Const EM_SETTARGETDEVICE As Long = WM_USER + 72
Private Const PHYSICALOFFSETX As Long = 112
Private Const PHYSICALOFFSETY As Long = 113

Private Declare Function GetDeviceCaps Lib "gdi32" ( _
    ByVal hdc As Long, ByVal nIndex As Long) As Long

'删除这些在页底的注释，你就可以在 frmPreview 窗体上使用 SendMessage 函数
Private Declare Function SendMessage Lib "USER32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal msg As Long, ByVal wp As Long, _
    lp As Any) As Long

Private Declare Function CreateDC Lib "gdi32" Alias "CreateDCA" _
    (ByVal lpDriverName As String, ByVal lpDeviceName As String, _
    ByVal lpOutput As Long, ByVal lpInitData As Long) As Long
    
Private Const lBorder = 100
Private ScalePercent As Integer
Private bLoad As Boolean

Private m_ab As ActiveBar2LibraryCtl.ActiveBar2
Implements IMDIDocument

Public Sub AddPage(PageNumber As Integer)

    If PageNumber > 1 Then
        Load picPreview(PageNumber - 1)
        Set picPreview(PageNumber - 1) = Nothing
    End If
    abPreview.Bands("sb").Tools.Insert abPreview.Bands("sb").Tools.Count, abPreview.Tools("miPage")
    abPreview.Bands("sb").Tools(abPreview.Bands("sb").Tools.Count - 1).Caption = "页 " & PageNumber
    abPreview.Bands("sb").Tools(abPreview.Bands("sb").Tools.Count - 1).TagVariant = PageNumber
End Sub

Private Sub FillCboPercent()

    Dim iCount As Integer
    Dim iIdx As Integer
    With abPreview.Bands("barPreview").Tools("miZoom")
        .CBClear
        For iCount = 200 To 30 Step -10
            .CBAddItem CStr(iCount) & "%"
            If iCount < 100 Then iIdx = iIdx + 1
        Next
        .CBListIndex = iIdx
    End With
    
End Sub

Public Sub PictureShow()
    
    Screen.MousePointer = vbHourglass
    With picChild
        .Height = (ScalePercent / 100) * picPreview(0).Height
        .Width = (ScalePercent / 100) * picPreview(0).Width
        ResizeScrollBars
    End With
    Screen.MousePointer = vbDefault

End Sub

Private Sub PreviewPrint()

    Dim iCount, iPicCount As Integer
    
    On Error GoTo ErrHandle
    
'设置打印图片框
    For iCount = 0 To picPreview.Count - 1
        picPreview(iCount).Picture = picPreview(iCount).Image
    Next
                
    If Printer.Copies > 0 Then
        For iCount = 1 To Printer.Copies
            Printer.Print
            For iPicCount = 0 To picPreview.Count - 1
                Printer.PaintPicture picPreview(iPicCount).Picture, 0, 0
                If iPicCount < picPreview.Count - 1 Then _
                    Printer.NewPage
            Next
            Printer.EndDoc
        Next
    End If
    
    Exit Sub
    
ErrHandle:
    Select Case Err.Number
        Case 482    '打印错误
            MsgBox "确定你已经有一个已经安装好的打印机。如果一个打印机已" & _
            "经安装好，请在“设置”页面设置打印机属性，并且确定 ICM 检查" & _
            "框已经被选中，然后再试一次。", , "打印机错误"

            Exit Sub
        Case 32755  '用户按下“取消”按钮
            Exit Sub
        Case Else
            MsgBox Err.Number & " " & Err.Description, , "预览 - 打印"
            Resume Next
    End Select
    
End Sub

Private Sub PreviewZoomIn()
    
    With abPreview.Bands("barPreview").Tools("miZoom")
        If .CBListIndex - 1 >= 0 Then
            ScalePercent = ScalePercent + 10
            .CBListIndex = .CBListIndex - 1
        End If
    End With
    
    Exit Sub
    
ErrHandle:
    Select Case Err.Number
        Case Else
            MsgBox Err.Number & " " & Err.Description, , "预览 - 打印"
            Resume Next
    End Select

End Sub

Private Sub PreviewZoomOut()

    With abPreview.Bands("barPreview").Tools("miZoom")
        If .CBListIndex + 1 < .CBListCount Then
            ScalePercent = ScalePercent - 10
            .CBListIndex = .CBListIndex + 1
        End If
    End With
    
    Exit Sub
    
ErrHandle:
    Select Case Err.Number
        Case Else
            MsgBox Err.Number & " " & Err.Description, , "预览 - 打印"
            Resume Next
    End Select

End Sub

Private Sub ResizeScrollBars()

'检查滚动条是否需要被添加
    With vscPreview
'决定垂直滚动条是否需要显示
        If picChild.Height > picParent.Height Then
            .Visible = True
            .Max = picChild.Height - picParent.ScaleHeight
            .Min = 0
            .LargeChange = picChild.Height - picParent.Height
            imgCorner.Visible = True