很酷的透明窗体

一个Form1，图片框一个PicShape，在图片框内放置任何图片时，系统将使用图片框中的图片为窗体，并且屏蔽图片中白色部分，从而建立特效的变形窗体。  

Option Explicit

Dim MoveTrue As Boolean, OldX As Long, OldY As Long

Private Type BITMAP
    bmType As Long
    bmWidth As Long
    bmHeight As Long
    bmWidthBytes As Long
    bmPlanes As Integer
    bmBitsPixel As Integer
    bmBits As Long
End Type

Private Declare Function GetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, ByVal dwCount As Long, lpBits As Any) As Long
Private Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) 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 SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long

Private Sub FitToPicture()
Const RGN_OR = 2

Dim border_width As Single
Dim title_height As Single
Dim bm As BITMAP
Dim bytes() As Byte
Dim ints() As Integer
Dim longs() As Long
Dim R As Integer
Dim C As Integer
Dim start_c As Integer
Dim stop_c As Integer
Dim x0 As Long
Dim y0 As Long
Dim combined_rgn As Long
Dim new_rgn As Long
Dim offset As Integer
Dim colourDepth As Integer

ScaleMode = vbPixels

picShape.ScaleMode = vbPixels
picShape.AutoRedraw = True
picShape.Picture = picShape.Image

注释： 获取窗体的边框大小
border_width = (ScaleX(Width, vbTwips, vbPixels) - ScaleWidth) / 2
title_height = ScaleX(Height, vbTwips, vbPixels) - border_width - ScaleHeight

注释： 获取图片大小
x0 = picShape.Left + border_width
y0 = picShape.Top + title_height

注释：给出图片信息
GetObject picShape.Image, Len(bm), bm
Select Case bm.bmBitsPixel
Case 15, 16:
注释：MsgBox _
"图片框中图片的颜色大高。",vbExclamation + vbOKOnly

colourDepth = 2

注释： 分配空格给图片.
ReDim ints(0 To bm.bmWidthBytes \ 2 - 1, 0 To bm.bmHeight - 1)
注释： 给出图片表面数据
GetBitmapBits picShape.Image, bm.bmHeight * bm.bmWidthBytes, ints(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 (ints(C, R) And &H7FFF) <> &H7FFF Then Exit Do
C = C + 1
Loop
start_c = C

Do While C < bm.bmWidth
If (ints(C, R) And &H7FFF) = &H7FFF 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 + y