1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99
| Option Explicit
Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal _
bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Private Declare Function GetVersionExA Lib "kernel32" _
(lpVersionInformation As OSVERSIONINFO) As Integer
Private Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128
End Type
Private Const KEYEVENTF_KEYUP = &H2
Private Const VK_SNAPSHOT = &H2C
Private Const VK_MENU = &H12
Dim blnAboveVer4 As Boolean
Private Sub Command1_Click()
If blnAboveVer4 Then
keybd_event VK_SNAPSHOT, 0, 0, 0
Else
keybd_event VK_SNAPSHOT, 1, 0, 0
End If
End Sub
Private Sub Command2_Click()
If blnAboveVer4 Then
keybd_event VK_SNAPSHOT, 1, 0, 0
Else
keybd_event VK_MENU, 0, 0, 0
keybd_event VK_SNAPSHOT, 0, 0, 0
keybd_event VK_SNAPSHOT, 0, KEYEVENTF_KEYUP, 0
keybd_event VK_MENU, 0, KEYEVENTF_KEYUP, 0
End If
End Sub
Private Sub Command3_Click()
' Load the captured image into a PictureBox and print it
'Picture1.Picture = Clipboard.GetData()
'Picture1.PaintPicture Clipboard.GetData(), 0, 0
Dim myPicture1 As New StdPicture, Border As Integer, Echel As Single
Set myPicture1 = Clipboard.GetData()
Border = Picture1.Width - Picture1.ScaleWidth
Picture1.Cls
Picture1.Height = (ScaleY(myPicture1.Height, vbHimetric, vbPixels) / 1.5) + Border
Echel = 1 '1.25
Picture1.Width = (ScaleX(myPicture1.Width, vbHimetric, vbPixels) / Echel) + Border
Picture1.PaintPicture myPicture1, 0, 0, ScaleX(myPicture1.Width, vbHimetric, vbPixels) / Echel, _
ScaleY(myPicture1.Height, vbHimetric, vbPixels) / Echel, _
0, 0, _
ScaleX(myPicture1.Width, vbHimetric, vbPixels), _
ScaleY(myPicture1.Height, vbHimetric, vbPixels), _
vbSrcCopy
Dim DifH As Integer, DifW As Integer, OldPrinterScaleMode As Integer, OldPrinterSens As Integer
OldPrinterScaleMode = Printer.ScaleMode
OldPrinterSens = Printer.Orientation
Printer.ScaleMode = vbMillimeters
If myPicture1.Width > myPicture1.Height Then
Printer.Orientation = vbPRORLandscape
Else
Printer.Orientation = vbPRORPortrait
End If
DifW = ScaleX(myPicture1.Width, vbHimetric, Printer.ScaleMode) - Printer.ScaleWidth
DifH = ScaleY(myPicture1.Height, vbHimetric, Printer.ScaleMode) - Printer.ScaleHeight
'Printer.PaintPicture Picture1.Picture, 0, 0
'Printer.EndDoc
Printer.Orientation = OldPrinterSens
Printer.ScaleMode = OldPrinterScaleMode
End Sub
Private Sub Form_Load()
Me.AutoRedraw = True
Me.ScaleMode = vbPixels
Picture1.ScaleMode = vbPixels
Dim osinfo As OSVERSIONINFO
Dim retvalue As Integer
osinfo.dwOSVersionInfoSize = 148
osinfo.szCSDVersion = Space$(128)
retvalue = GetVersionExA(osinfo)
If osinfo.dwMajorVersion > 4 Then blnAboveVer4 = True
'Picture1.Visible = False
Command1.Caption = "Print Screen"
Command2.Caption = "Alt+Print Screen"
Command3.Caption = "Print Image"
End Sub |
Partager