1,485
社区成员
发帖
与我相关
我的任务
分享
Option Explicit
Private Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
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 CreateEllipticRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Const RGN_AND = 1
Private Const RGN_COPY = 5
Private Const RGN_OR = 2
Private Const RGN_XOR = 3
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 Ellipse 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 CreatePen Lib "gdi32" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Sub Command1_Click()
Dim h As Long
Dim hRect As Long, hCl As Long, hC As Long
h = Picture1.hWnd
Picture1.Line (100, 100)-Step(80, 150), vbBlue, BF '画一个蓝色的长方形
'Rectangle h, 100, 100, 180, 250
hRect = CreateRectRgn(100, 100, 180, 250) ' 生成这个区域对象
Picture1.Circle (120, 130), 80, vbRed '画一个圆形
Picture1.FillColor = vbRed
'Ellipse h, 40, 50, 200, 210
hCl = CreateEllipticRgn(40, 50, 200, 210)
hC = CombineRgn(hRect, hRect, hCl, RGN_OR)
If hC <> 0 Then
SetWindowRgn h, hRect, True
End If
DeleteObject hCl
DeleteObject hRect
End Sub
Private Sub Form_Load()
With Picture1
.ScaleMode = vbPixels
.FillStyle = 0
.FillColor = vbRed
.AutoRedraw = True
End With
End Sub
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
Private Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hwnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
Const WS_EX_LAYERED = &H80000
Const GWL_EXSTYLE = (-20)
Const LWA_COLORKEY = &H1
Dim rtn&
Private Sub Form_Load()
Picture1.BackColor = RGB(66, 66, 66)
Shape1.BackColor = RGB(66, 66, 66)
rtn = GetWindowLong(hwnd, GWL_EXSTYLE)
rtn = rtn Or WS_EX_LAYERED
SetWindowLong hwnd, GWL_EXSTYLE, rtn
SetLayeredWindowAttributes hwnd, RGB(66, 66, 66), &H2, LWA_COLORKEY
End Sub
Private Declare Function TransparentBlt Lib "msimg32.dll" _
(ByVal hdcDest As Long, _
ByVal nXOriginDest As Long, _
ByVal nYOriginDest As Long, _
ByVal nWidthDest As Long, _
ByVal nHeightDest As Long, _
ByVal hdcSrc As Long, _
ByVal nXOriginSrc As Long, _
ByVal nYOriginSrc As Long, _
ByVal nWidthSrc As Long, _
ByVal nHeightSrc As Long, _
ByVal crTransparent As Long _
) As Long