很酷的透明窗体

0, stop_c + x0, R + y0 + 1)

If combined_rgn = 0 Then
combined_rgn = new_rgn
Else
CombineRgn combined_rgn, combined_rgn, new_rgn, RGN_OR
DeleteObject new_rgn
End If
End If
Loop
Next R

Case 24:
colourDepth = 3

ReDim bytes(0 To bm.bmWidthBytes - 1, 0 To bm.bmHeight - 1)

GetBitmapBits picShape.Image, bm.bmHeight * bm.bmWidthBytes, bytes(0, 0)

For R = 0 To bm.bmHeight - 2
注释： Create a region for this row.
C = 0
Do While C < bm.bmWidth
start_c = 0
stop_c = 0

offset = C * colourDepth

Do While C < bm.bmWidth
If bytes(offset, R) <> 255 Or _
bytes(offset + 1, R) <> 255 Or _
bytes(offset + 2, R) <> 255 Then Exit Do
C = C + 1
offset = offset + colourDepth
Loop
start_c = C

Do While C < bm.bmWidth
If bytes(offset, R) = 255 And _
bytes(offset + 1, R) = 255 And _
bytes(offset + 2, R) = 255 _
Then Exit Do
C = C + 1
offset = offset + colourDepth
Loop
stop_c = C

If start_c < bm.bmWidth Then
If stop_c >= bm.bmWidth Then stop_c = bm.bmWidth - 1

注释： 建立区域
new_rgn = CreateRectRgn(start_c + x0, R + y0, stop_c + x0, R + y0 + 1)

If combined_rgn = 0 Then
combined_rgn = new_rgn
Else
CombineRgn combined_rgn, combined_rgn, new_rgn, RGN_OR
DeleteObject new_rgn
End If
End If
Loop
Next R

Case 32:
colourDepth = 4

ReDim longs(0 To bm.bmWidthBytes \ 4 - 1, 0 To bm.bmHeight - 1)

GetBitmapBits picShape.Image, bm.bmHeight * bm.bmWidthBytes, longs(0, 0)


For R = 0 To bm.bmHeight - 2

C = 0
Do While C < bm.bmWidth
start_c = 0
stop_c = 0

Do While C < bm.bmWidth
If (longs(C, R) And &HFFFFFF) <> &HFFFFFF Then Exit Do
C = C + 1
Loop
start_c = C

Do While C < bm.bmWidth
If (longs(C, R) And &HFFFFFF) = &HFFFFFF Then Exit Do
C = C + 1
Loop
stop_c = C

If start_c < bm.bmWidth Then
If stop_c >= bm.bmWidth Then stop_c = bm.bmWidth - 1

new_rgn = CreateRectRgn(start_c + x0, R + y0, stop_c + x0, R + y0 + 1)

If combined_rgn = 0 Then
combined_rgn = new_rgn
Else
CombineRgn combined_rgn, combined_rgn, new_rgn, RGN_OR
DeleteObject new_rgn
End If
End If
Loop
Next R

Case Else
MsgBox "对不起，程序必须在 16位, 24-位 或 32-位 颜色下。", _
vbExclamation + vbOKOnly

Exit Sub
End Select

注释： 设置表单外观为建立区域
SetWindowRgn hWnd, combined_rgn, True
    DeleteObject combined_rgn
End Sub

Private Sub picShape_Click()

End Sub

Private Sub Form_Load()

Move (Screen.Width - Width) / 2, (Screen.Height - Height) / 2

FitToPicture

End Sub

Private Sub picShape_DblClick()

Unload Me

End Sub

Private Sub picshape_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
MoveTrue = True
OldX = x: OldY = y
End Sub

Private Sub picshape_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)

If MoveTrue = True Then
Form1.Left = Form1.Left + x - OldX
Form1.Top = Form1.Top + y - OldY
End If

End Sub

Private Sub picshape_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)

MoveTrue = False

End Sub