?? frmmultipgpreview.frm
字號:
ScaleWidth = 249
TabIndex = 0
TabStop = 0 'False
Top = 0
Width = 3765
End
Begin VB.PictureBox picGetFolder
Appearance = 0 'Flat
ForeColor = &H80000008&
Height = 4440
Left = 1245
ScaleHeight = 4410
ScaleWidth = 6375
TabIndex = 26
Top = 615
Visible = 0 'False
Width = 6405
Begin VB.DriveListBox Drive1
Height = 315
Left = 1530
TabIndex = 32
Top = 45
Width = 3930
End
Begin VB.DirListBox Dir1
Height = 3465
Left = 30
TabIndex = 31
Top = 450
Width = 6315
End
Begin VB.CommandButton cmdNewFolder
Height = 345
Left = 5955
MaskColor = &H00FFFFFF&
Picture = "frmMultiPgPreview.frx":1F1D
Style = 1 'Graphical
TabIndex = 30
ToolTipText = "New Folder"
Top = 30
UseMaskColor = -1 'True
Width = 375
End
Begin VB.CommandButton cmdUpOne
Height = 345
Left = 5520
MaskColor = &H00FFFFFF&
Picture = "frmMultiPgPreview.frx":226B
Style = 1 'Graphical
TabIndex = 29
ToolTipText = "Back Up"
Top = 30
UseMaskColor = -1 'True
Width = 375
End
Begin VB.CommandButton cmdOpen
Caption = "Ok"
Height = 375
Left = 4830
TabIndex = 28
Top = 3975
Width = 1470
End
Begin VB.CommandButton cmdQuit
Caption = "Cancel"
Height = 375
Left = 3255
TabIndex = 27
Top = 3975
Width = 1470
End
Begin VB.Label Label4
AutoSize = -1 'True
Caption = " Select a Directory: "
Height = 195
Left = 75
TabIndex = 33
Top = 90
Width = 1395
End
End
Begin VB.Image imgFit
Height = 240
Index = 1
Left = 420
Picture = "frmMultiPgPreview.frx":251D
Top = 5205
Visible = 0 'False
Width = 240
End
Begin VB.Image imgFit
Height = 240
Index = 0
Left = 60
Picture = "frmMultiPgPreview.frx":2AA7
Top = 5190
Visible = 0 'False
Width = 240
End
Begin VB.Image optArt
Appearance = 0 'Flat
Height = 225
Index = 1
Left = 0
Picture = "frmMultiPgPreview.frx":3031
Top = 4860
Visible = 0 'False
Width = 300
End
Begin VB.Image optArt
Appearance = 0 'Flat
Height = 225
Index = 0
Left = 555
Picture = "frmMultiPgPreview.frx":30DE
Top = 4875
Visible = 0 'False
Width = 300
End
End
Attribute VB_Name = "frmMultiPgPreview"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'/*************************************/
'/* Author: Morgan Haueisen
'/* morganh@hartcom.net
'/* Copyright (c) 1999-2003
'/*************************************/
'Legal:
' This is intended for and was uploaded to www.planetsourcecode.com
'
' Redistribution of this code, whole or in part, as source code or in binary form, alone or
' as part of a larger distribution or product, is forbidden for any commercial or for-profit
' use without the author's explicit written permission.
'
' Redistribution of this code, as source code or in binary form, with or without
' modification, is permitted provided that the following conditions are met:
'
' Redistributions of source code must include this list of conditions, and the following
' acknowledgment:
'
' This code was developed by Morgan Haueisen. <morganh@hartcom.net>
' Source code, written in Visual Basic, is freely available for non-commercial,
' non-profit use at www.planetsourcecode.com.
'
' Redistributions in binary form, as part of a larger project, must include the above
' acknowledgment in the end-user documentation. Alternatively, the above acknowledgment
' may appear in the software itself, if and wherever such third-party acknowledgments
' normally appear.
Option Explicit
'/* Used for Manifest files (Win XP)
Private Declare Function InitCommonControls Lib "Comctl32.dll" () As Long
Public PageNumber As Integer
Private ViewPage As Integer
Private TempDir As String
Private OptionV As Integer
Private FitToPage As Boolean
Private Type PanState
X As Long
Y As Long
End Type
Dim PanSet As PanState
Private Declare Function StretchBlt Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, _
ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, _
ByVal xSrc As Long, ByVal ySrc As Long, ByVal nSrcWidth As Long, ByVal nSrcHeight As Long, _
ByVal dwRop As Long) As Long
Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" _
(lpVersionInformation As OSVersionInfo) As Long
Private Declare Function CreateDirectory Lib "kernel32.dll" Alias "CreateDirectoryA" (ByVal lpPathName As String, lpSecurityAttributes As SECURITY_ATTRIBUTES) As Long
Private Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Long
End Type
Private Type OSVersionInfo
OSVSize As Long
dwVerMajor As Long
dwVerMinor As Long
dwBuildNumber As Long
PlatformID As Long
szCSDVersion As String * 128
End Type
Private UseStretchBit As Boolean
Private Sub cmd_print_Click()
txtTo.Text = PageNumber + 1
OptionV = 3
Call optText_Click(OptionV)
picPrintOptions.Left = Me.Width - (Picture2.Width + picPrintOptions.Width + 50)
picPrintOptions.Top = cmd_print.Top
picGetFolder.Left = Me.Width - (Picture2.Width + picGetFolder.Width + 50)
picGetFolder.Top = cmd_print.Top
picPrintOptions.Visible = True
picGoto.Visible = False
End Sub
Private Function IsNumber(ByVal CheckString As String, Optional KeyAscii As Integer = 0, Optional AllowDecPoint As Boolean = False, Optional AllowNegative As Boolean = False) As Boolean
If KeyAscii > 0 And KeyAscii <> 8 Then
If Not AllowNegative And KeyAscii = 45 Then KeyAscii = 0
If Not AllowDecPoint And KeyAscii = 46 Then KeyAscii = 0
If Not IsNumeric(CheckString & Chr(KeyAscii)) Then
KeyAscii = False
IsNumber = False
Else
IsNumber = True
End If
Else
IsNumber = IsNumeric(CheckString)
End If
End Function
Private Sub cmd_quit_Click()
cPrint.SendToPrinter = False
Unload Me
End Sub
Private Sub cmdFullPage_Click()
Dim xmin As Single
Dim ymin As Single
Dim wid As Single
Dim hgt As Single
Dim aspect As Single
'/* If already here then restore original
If cmdFullPage.Value = 0 Then
Picture1.Visible = True
Picture1.SetFocus
picFullPage.Visible = False
cmdFullPage.Picture = imgFit(0).Picture
Exit Sub
End If
Screen.MousePointer = vbHourglass
DoEvents
cmdFullPage.Picture = imgFit(1).Picture
'/* Clear any picture and set the size and loaction
Set picFullPage.Picture = Nothing
If Not picHScroll.Visible Then
picFullPage.Height = Me.Height - 100
picFullPage.Width = picFullPage.Height * 0.773
picFullPage.Move ((Me.Width - Picture2.Width) - picFullPage.Width) \ 2, 0
Else
picFullPage.Top = 50
picFullPage.Left = 50
picFullPage.Width = Me.Width - Picture2.Width - 100
picFullPage.Height = picFullPage.Width * 0.773
End If
'/* Get the scale values
aspect = Picture1.ScaleHeight / Picture1.ScaleWidth
wid = picFullPage.ScaleWidth
hgt = picFullPage.ScaleHeight
'/* MaintainRatio
If hgt / wid > aspect Then
hgt = aspect * wid
xmin = picFullPage.ScaleLeft
ymin = (picFullPage.ScaleHeight - hgt) / 2
Else
wid = hgt / aspect
xmin = (picFullPage.ScaleWidth - wid) / 2
ymin = picFullPage.ScaleTop
End If
If UseStretchBit Then '/* NT platform
StretchBlt picFullPage.hdc, _
xmin, ymin, wid, hgt, _
Picture1.hdc, _
0, 0, Picture1.ScaleWidth, Picture1.ScaleHeight, vbSrcCopy
Else
picFullPage.PaintPicture Picture1.Picture, _
xmin, ymin, wid, hgt, _
0, 0, Picture1.ScaleWidth, Picture1.ScaleHeight, vbSrcCopy
End If
Picture1.Visible = False
picFullPage.Visible = True
picFullPage.SetFocus
picGoto.Visible = False
Screen.MousePointer = vbDefault
End Sub
Private Sub cmdGoTo_Click()
picGoto.Top = cmdGoTo.Top
picGoto.Left = Me.Width - (Picture2.Width + picGoto.Width + 50)
picGoto.Visible = True
picGoto.ZOrder
txtGoto = CStr(ViewPage + 1)
txtGoto.SelStart = 0
txtGoto.SelLength = Len(txtGoto)
txtGoto.SetFocus
End Sub
Private Sub cmdGotoOK_Click()
Dim NewPageNo As Integer
On Local Error Resume Next
txtGoto.SetFocus
NewPageNo = Val(txtGoto)
If NewPageNo = 0 Then Exit Sub
NewPageNo = NewPageNo - 1
If NewPageNo > PageNumber Then NewPageNo = PageNumber
ViewPage = NewPageNo
Picture1.SetFocus
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 Sub
Private Sub cmdPrint_Click()
Dim i As Integer
'/* Prevent printing again until done
picPrintOptions.Enabled = False
lblPrintingPg.Visible = True
cmdPrint.Visible = False
Select Case OptionV
Case 0 '/* Copy to clipboard
Clipboard.Clear
Clipboard.SetData Picture1.Picture, vbCFBitmap
Case 1 '/* Print current page
lblPrintingPg.Caption = "頁面打印中 " & ViewPage + 1
lblPrintingPg.Refresh
Call PrintPictureBox(Picture1, True, False)
Case 2 '/* Print range
For i = Val(txtFrom) - 1 To Val(txtTo) - 1
lblPrintingPg.Caption = "頁面打印中 " & CStr(i + 1) & " of " & txtTo
lblPrintingPg.Refresh
Picture1.Picture = LoadPicture(TempDir & "PPview" & CStr(i) & ".bmp")
Call PrintPictureBox(Picture1, True, False)
Next i
Picture1.Picture = LoadPicture(TempDir & "PPview" & CStr(ViewPage) & ".bmp")
Case 4
picGetFolder.Visible = True
picGetFolder.ZOrder
Case Else '/* Print all
cPrint.SendToPrinter = True '/* Send to Printer */
Unload Me
End Select
'/* Restore normal view
picPrintOptions.Enabled = True
cmdPrint.Visible = True
picPrintOptions.Visible = False
lblPrintingPg.Visible = False
End Sub
Private Sub Command1_Click(Index As Integer)
On Local Error Resume Next
If Index = 0 Then
ViewPage = ViewPage - 1
If ViewPage < 0 Then ViewPage = 0
Picture1.Picture = LoadPicture(TempDir & "PPview" & CStr(ViewPage) & ".bmp")
Else
ViewPage = ViewPage + 1
If ViewPage > PageNumber Then ViewPage = PageNumber
Picture1.Picture = LoadPicture(TempDir & "PPview" & CStr(ViewPage) & ".bmp")
End If
Picture1.Top = 0
picPrintOptions.Visible = False
picGoto.Visible = False
VScroll1.Value = 0
HScroll1.Value = 0
Call DisplayPages
End Sub
Private Sub Form_Activate()
Screen.MousePointer = vbDefault
Call DisplayPages
If Picture1.Width < Me.Width - Picture2.Width Then
Picture1.Move ((Me.Width - Picture2.Width) - Picture1.Width) \ 2, 0
End If
cmdFullPage.Picture = imgFit(0).Picture
Label5 = "跳轉頁面" & vbCrLf & "(1 to " & CStr(PageNumber + 1) & ")"
Picture1.SetFocus
End Sub
Private Sub Form_Click()
picPrintOptions.Visible = False
picGetFolder.Visible = False
picGoto.Visible = False
End Sub
Private Sub Form_Initialize()
'/* Used for Manifest files (Win XP)
Call InitCommonControls
'MakeXPButton cmd_quit
'MakeXPButton cmd_print
'MakeXPButton cmdFullPage
'MakeXPButton cmdGoTo
'MakeXPButton Command1(0)
'MakeXPButton Command1(1)
End Sub
Private Sub Form_KeyPress(KeyAscii As Integer)
If KeyAscii = 71 Or KeyAscii = 103 Then cmdGoTo_Click
End Sub
Private Sub Form_Load()
Dim OSV As OSVersionInfo
Const VER_PLATFORM_WIN32_NT = 2
OSV.OSVSize = Len(OSV)
If GetVersionEx(OSV) = 1 Then
If OSV.PlatformID = VER_PLATFORM_WIN32_NT Then
UseStretchBit = True
Else
UseStretchBit = False
End If
End If
Me.Move 0, 0, Screen.Width, Screen.Height
Picture1.Move 0, 0
VScroll1.Height = Me.Height - cmdGoTo.Top - cmdGoTo.Height - 500
HScroll1.Width = Me.Width - Picture2.Width - 500
TempDir = Environ("TEMP") & "\"
End Sub
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -