以下是引用片段： Private Sub GetScreen()
Dim wScreen As Long
Dim hScreen As Long
Dim w As Long
Dim h As Long
Picture2.Cls wScreen = Screen.Width \ Screen.TwipsPerPixelX
hScreen = Screen.Height \ Screen.TwipsPerPixelY Picture2.ScaleMode = vbPixels
w = Picture2.ScaleWidth
h = Picture2.ScaleHeight hdcScreen = GetDC(0) r = StretchBlt(Me.Picture2.hdc, 0, 0, wScreen, hScreen, hdcScreen, 0, 0, wScreen, hScreen, vbSrcCopy) End Sub Private Sub WinConnect_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
Me.Text1.Text = Me.Text1.Text & vbCrLf & "连接异常" '操作记录显示
End Sub
Public Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Public 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
Public Dpath As String '存储格式化后的相对路径 Function AddRar()
'利用winrar进行压缩
Dim Rarexe As String 'WINRAR执行文件的位置
Dim Source As String ' 解压缩前的原始文件
Dim Target As String ' 解压缩后的目标文件
Dim FileString As String 'Shell指令中的字符串
Dim Result As Long
Rarexe = Dpath & "winrar\winrar"
Source = "c:\SendScreen.bmp"
Target = "C:\SendScreen.rar"
FileString = Rarexe & " a " & Target & " " & Source
Result = Shell(FileString, vbHide)
End Function
|