frmpreview.frm

地面测试仪

VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form frmPreview 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "打印预览"
   ClientHeight    =   4890
   ClientLeft      =   45
   ClientTop       =   375
   ClientWidth     =   9690
   Icon            =   "frmPreview.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   4890
   ScaleWidth      =   9690
   StartUpPosition =   3  '窗口缺省
   Begin MSComctlLib.TabStrip tabPreview 
      Height          =   315
      Left            =   180
      TabIndex        =   14
      Top             =   4260
      Width           =   5115
      _ExtentX        =   9022
      _ExtentY        =   556
      Style           =   1
      _Version        =   393216
      BeginProperty Tabs {1EFB6598-857C-11D1-B16A-00C0F0283628} 
         NumTabs         =   1
         BeginProperty Tab1 {1EFB659A-857C-11D1-B16A-00C0F0283628} 
            Caption         =   "第1页"
            ImageVarType    =   2
         EndProperty
      EndProperty
   End
   Begin VB.PictureBox picToolbar 
      Appearance      =   0  'Flat
      ForeColor       =   &H80000008&
      Height          =   495
      Left            =   0
      ScaleHeight     =   465
      ScaleWidth      =   9420
      TabIndex        =   4
      Top             =   0
      Width           =   9450
      Begin VB.CommandButton btnPreview 
         Appearance      =   0  'Flat
         Caption         =   "打印当前"
         Height          =   315
         Index           =   5
         Left            =   1200
         Style           =   1  'Graphical
         TabIndex        =   13
         Top             =   68
         Width           =   1155
      End
      Begin VB.CommandButton btnPreview 
         Appearance      =   0  'Flat
         Caption         =   "设置"
         Height          =   315
         Index           =   1
         Left            =   2370
         Style           =   1  'Graphical
         TabIndex        =   8
         Top             =   68
         Width           =   1155
      End
      Begin VB.CommandButton btnPreview 
         Appearance      =   0  'Flat
         Caption         =   "还原"
         Height          =   315
         Index           =   2
         Left            =   3525
         Style           =   1  'Graphical
         TabIndex        =   9
         Top             =   68
         Width           =   1155
      End
      Begin VB.CommandButton btnPreview 
         Appearance      =   0  'Flat
         Caption         =   "放大"
         Height          =   315
         Index           =   3
         Left            =   4680
         Style           =   1  'Graphical
         TabIndex        =   11
         Top             =   68
         Width           =   1155
      End
      Begin VB.CommandButton btnPreview 
         Appearance      =   0  'Flat
         Caption         =   "缩小"
         Height          =   315
         Index           =   4
         Left            =   5835
         Style           =   1  'Graphical
         TabIndex        =   12
         Top             =   68
         Width           =   1155
      End
      Begin VB.ComboBox cboPercent 
         Height          =   300
         Left            =   7020
         Style           =   2  'Dropdown List
         TabIndex        =   6
         Top             =   75
         Width           =   1155
      End
      Begin VB.CommandButton cmdClose 
         Caption         =   "返回"
         Height          =   315
         Left            =   8160
         TabIndex        =   5
         Top             =   68
         Width           =   1155
      End
      Begin VB.CommandButton btnPreview 
         Appearance      =   0  'Flat
         Caption         =   "打印"
         Height          =   315
         Index           =   0
         Left            =   60
         Style           =   1  'Graphical
         TabIndex        =   7
         Top             =   68
         Width           =   1155
      End
   End
   Begin VB.PictureBox picParent 
      AutoRedraw      =   -1  'True
      Height          =   2835
      Left            =   120
      ScaleHeight     =   2775
      ScaleWidth      =   6555
      TabIndex        =   0
      Top             =   600
      Width           =   6615
      Begin VB.PictureBox imgCorner 
         BorderStyle     =   0  'None
         ClipControls    =   0   'False
         Height          =   1320
         Left            =   0
         ScaleHeight     =   1320
         ScaleWidth      =   2400
         TabIndex        =   3
         Top             =   480
         Visible         =   0   'False
         Width           =   2400
      End
      Begin VB.HScrollBar hscPreview 
         Height          =   195
         LargeChange     =   2000
         Left            =   480
         SmallChange     =   500
         TabIndex        =   1
         Top             =   2400
         Width           =   2895
      End
      Begin VB.VScrollBar vscPreview 
         Height          =   2475
         LargeChange     =   2000
         Left            =   3720
         SmallChange     =   500
         TabIndex        =   2
         Top             =   120
         Width           =   195
      End
      Begin VB.PictureBox picPreview 
         AutoRedraw      =   -1  'True
         BackColor       =   &H80000005&
         BorderStyle     =   0  'None
         FontTransparent =   0   'False
         Height          =   1995
         IMEMode         =   1  'ON
         Index           =   1
         Left            =   3960
         ScaleHeight     =   1995
         ScaleWidth      =   2880
         TabIndex        =   10
         Top             =   240
         Visible         =   0   'False
         Width           =   2880
      End
      Begin VB.Image picChild 
         Height          =   1875
         Left            =   600
         Stretch         =   -1  'True
         Top             =   120
         Width           =   2655
      End
   End
End
Attribute VB_Name = "frmPreview"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Type CharRange
    cpMin As Long     ' First character of range (0 for start of doc)
    cpMax As Long     ' Last character of range (-1 for end of doc)
End Type
Private Type Rect
        Left As Long
        Top As Long
        Right As Long
        Bottom As Long
End Type

Private Type FormatRange
    hdc As Long       ' Actual DC to draw on
    hdcTarget As Long ' Target DC for determining text formatting
    rc As Rect        ' Region of the DC to draw to (in twips)
    rcPage As Rect    ' Region of the entire DC (page size) (in twips)
    chrg As CharRange ' Range of text to draw (see above declaration)
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 Const CB_FINDSTRINGEXACT = &H158
Private Const CB_FINDSTRING = &H14C
Private Const CB_ERR = (-1)


Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long
Private Const lBorder = 100
Private ScalePercent As Integer
Private bLoad As Boolean

Private Sub FillCboPercent()

    Dim iCount As Integer
    Dim strSearch As String
    
    With cboPercent
        For iCount = 200 To 30 Step -10
            .AddItem CStr(iCount) & "%"
        Next
        strSearch = "100%"
        .Text = strSearch
    End With
    
End Sub

Public Sub PictureShow(Optional Index As Integer = 1)
On Error GoTo ErrHandle

    With picChild
        .Top = 0
        .Left = 0
        .Height = (ScalePercent / 100) * picPreview(Index).Height
        .Width = (ScalePercent / 100) * picPreview(Index).Width
        ResizeScrollBars
    End With

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


Private Sub PreviewZoomIn()
On Error GoTo ErrHandle
    With cboPercent
        If .ListIndex - 1 >= 0 Then
            ScalePercent = ScalePercent + 10
            .ListIndex = .ListIndex - 1
        End If
    End With
    
    Exit Sub