?? frmmultipgpreview.frm
字號:
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
Picture1.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
picGetFolder.Visible = False
picGoto.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 4
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 4
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
picGetFolder.Visible = False
picGoto.Visible = False
VScroll1.Value = 0
HScroll1.Value = 0
Call DisplayPages
End Select
End Sub
Private Sub cmdNewFolder_Click()
Dim NewFolderName As String
Dim Security As SECURITY_ATTRIBUTES
NewFolderName = InputBox("Enter Folder Name", , "New Folder")
NewFolderName = Trim(NewFolderName)
If NewFolderName > vbNullString Then
CreateDirectory Dir1.Path & "\" & NewFolderName, Security
NewFolderName = Dir1.Path & "\" & NewFolderName
Dir1.Refresh
Dir1.Path = NewFolderName
End If
End Sub
Private Sub cmdOpen_Click()
Dim FolderName As String
Dim ReportTitle As String
Dim i As Integer
FolderName = Dir1.Path & "\"
picGetFolder.Visible = False
picPrintOptions.Visible = True
picPrintOptions.Enabled = False
lblPrintingPg.Visible = True
cmdPrint.Visible = False
On Local Error GoTo CopyError:
DoEvents
ReportTitle = Trim(cPrint.ReportTitle)
If ReportTitle = vbNullString Or InStr(ReportTitle, "\") Then
ReportTitle = "PPview"
End If
For i = 0 To PageNumber
FileCopy TempDir & "PPview" & CStr(i) & ".bmp", FolderName & ReportTitle & CStr(i + 1) & ".bmp"
lblPrintingPg.Caption = "Copying page " & i + 1
lblPrintingPg.Refresh
Next
'/* Restore normal view
picPrintOptions.Enabled = True
cmdPrint.Visible = True
picPrintOptions.Visible = False
lblPrintingPg.Visible = False
Exit Sub
CopyError:
If Err.Number = 76 Then
ReportTitle = "PPview"
Resume
End If
End Sub
Private Sub cmdQuit_Click()
picGetFolder.Visible = False
'/* Restore normal view
picPrintOptions.Enabled = True
cmdPrint.Visible = True
picPrintOptions.Visible = False
lblPrintingPg.Visible = False
End Sub
Private Sub cmdUpOne_Click()
Dir1.Path = Dir1.List(-2)
End Sub
Private Sub Dir1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dir1.Path = Dir1.List(Dir1.ListIndex)
End Sub
Private Sub Drive1_Change()
Dir1.Path = Drive1.Drive
End Sub
Private Sub Picture1_Click()
picPrintOptions.Visible = False
picGetFolder.Visible = False
picGoto.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 txtGoto_Change()
If Val(txtGoto) > PageNumber + 1 Then txtGoto = PageNumber + 1
End Sub
Private Sub txtGoto_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
KeyAscii = 0
cmdGotoOK_Click
ElseIf (KeyAscii < 48 Or KeyAscii > 57) And KeyAscii <> 8 Then
KeyAscii = 0
End If
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
Picture1.SetFocus
On Local Error GoTo 0
End Sub
Private Sub DisplayPages()
Label1 = CStr(ViewPage + 1) & vbNewLine & "-- of --" & 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
Printer.Orientation = cPrint.Orientation
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
picGetFolder.Visible = False
picGoto.Visible = False
VScroll1.Value = 0
HScroll1.Value = 0
Call DisplayPages
End Select
End Sub
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -