如何獲取螢屏的影像放到DC中后，加上空心邊框后輸入到表單中。
Option Explicit
'****************************************************
'透明表單與半透明控制
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
'其中hwnd是透明表單的句柄，crKey為顏色值，
'bAlpha是透明度，取值范圍是[0,255]，
Private Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hwnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
'視窗置頂
Private Declare Function SetWindowPos Lib "USER32.DLL" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Integer, ByVal y As Integer, ByVal cx As Integer, ByVal cy As Integer, ByVal uFlags As Long) As Boolean
'創建一個由點X1，Y1和X2，Y2描述的矩形區域
Private Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
'將兩個區域組合為一個新區域
Private Declare Function CombineRgn Lib "gdi32" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long
'創建圓的、星形的等任何形狀視窗
Private Declare Function SetWindowRgn Lib "user32" (ByVal hwnd As Long, ByVal hRgn As Long, ByVal bRedraw As Long) As Long
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC 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 dwRop As Long) As Long
'****************************************************
Private Const WS_EX_LAYERED = &H80000
Private Const GWL_EXSTYLE = (-20)
Private Const LWA_ALPHA = &H2
Private Const LWA_COLORKEY = &H1
Private Const SWP_NOMOVE = &H2 '不更動目前視窗位置
Private Const SWP_NOSIZE = &H1 '不更動目前視窗大小
Private Const HWND_TOPMOST = -1 '設定為最上層
Private Const HWND_NOTOPMOST = -2 '取消最上層設定
Private Const FLAGS = SWP_NOMOVE Or SWP_NOSIZE
Private Const SRCCOPY = &HCC0020
Dim bTopMost As Boolean '置頂標志
Dim sX As Single, sY As Single, oX As Single, oY As Single '滑鼠坐標
Dim StartDraw As Boolean, StopDraw As Boolean '開始停止標志
Private Declare Function TextOutW Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal lpString As Long, ByVal nCount As Long) As Long
Private Declare Function lstrlenW Lib "kernel32" (ByVal lpString As Long) As Long
Private Declare Function SetTextColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function FillRect Lib "user32" (ByVal hdc As Long, lpRect As RECT, ByVal hBrush As Long) As Long
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Sub Command1_Click()
Dim mDC As Long
Dim mBmp As Long
Dim R As RECT
Dim hBrush As Long
Dim oldBmp As Long
mDC = CreateCompatibleDC(Me.hdc)
mBmp = CreateCompatibleBitmap(Me.hdc, Me.Width, Me.Height)
hBrush = CreateSolidBrush(vbRed)
oldBmp = SelectObject(mDC, mBmp)
' R.Left = 100
' R.Top = 100
' R.Right = 100
' R.Bottom = 100
' FillRect mDC, R, hBrush
BitBlt mDC, 0, 0, Me.Width, Me.Height, mBmp, 0, 0, SRCCOPY
SelectObject mDC, oldBmp
DeleteObject mBmp
DeleteDC mDC
DeleteObject hBrush
End Sub
uj5u.com熱心網友回復：
Option Explicit
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC 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 dwRop As Long) As Long
Private Declare Function CreateDC Lib "gdi32" Alias "CreateDCA" (ByVal lpDriverName As String, ByVal lpDeviceName As String, ByVal lpOutput As String, lpInitData As Long) As Long
Private Const SRCCOPY = &HCC0020
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Declare Function CreatePen Lib "gdi32" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long
Private Declare Function Rectangle Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Dim mDC As Long
Dim mBmp As Long
Dim hBrush As Long
Private Sub Command1_Click()
Dim R As RECT
Dim hBrush As Long
Dim oldBmp As Long
Dim oldBmp1 As Long
Dim a As Long
a = CreateDC("DISPLAY", 0, 0, 0)
mDC = CreateCompatibleDC(a)
mBmp = CreateCompatibleBitmap(a, Me.Width, Me.Height)
oldBmp = SelectObject(mDC, mBmp)
hBrush = CreatePen(0, 0, vbRed)
oldBmp1 = SelectObject(Picture1.hdc, hBrush)
R.Left = 100
R.Top = 100
R.Right = 100
R.Bottom = 100
Rectangle Picture1.hdc, 20, 20, 40, 40
SelectObject Picture1.hdc, oldBmp1
BitBlt Me.hdc, 0, 0, Me.Width, Me.Height, a, 0, 0, SRCCOPY
End Sub
Private Sub Form_Unload(Cancel As Integer)
DeleteObject mBmp
DeleteDC mDC
DeleteObject hBrush
End Sub
轉載請註明出處，本文鏈接：https://www.uj5u.com/gongcheng/155898.html
標籤：VB基礎類
下一篇：Excel VBA編程