www.pudn.com > gameprg.zip > Module1.bas

Attribute VB_Name = "Module1" 
Public Declare Function GetObjectAPI Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long 
 
Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long 
 
Public Declare Function SetWindowRgn Lib "user32" (ByVal hwnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long 
 
Public Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long 
 
Public Declare Function CombineRgn Lib "gdi32" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long 
 
Public Const RGN_OR = 2 
 
Public Declare Function GetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, ByVal dwCount As Long, lpBits As Any) As Long 
 
 
Public Type BITMAP '14 bytes 
bmType As Long 
bmWidth As Long 
bmHeight As Long 
bmWidthBytes As Long 
bmPlanes As Integer 
bmBitsPixel As Integer 
bmBits As Long 
End Type 
 
Dim bmByte() As Byte 
 
Public Declare Function ReleaseCapture Lib "user32" () As Long 
 
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long 
 
'Public Const WM_SYSCOMMAND = &H112 
'Public Const SC_MOVE = &HF012 
Public Const HTCAPTION = 2 
Public Const WM_NCLBUTTONDOWN = &HA1 
 
 
Public load_flag As Boolean 
Public a(4, 3) As Integer 
Public b(9, 1) As Integer 
Public left_ok As Boolean 
Public right_ok As Boolean 
Public up_ok As Boolean 
Public down_ok As Boolean 
Public move_num As Integer 
Public step_num As Integer 
Public step1 As Integer 
Public max_step As Integer 
Public game_num As Integer 
 
 
 
 
 
 
 
Public Sub SetAutoRgn(hForm As Form, Optional transColor As Byte = vbNull) 
Dim X As Long, Y As Long 
Dim Rgn1 As Long, Rgn2 As Long 
Dim SPos As Long, EPos As Long 
Dim bm As BITMAP 
Dim hbm As Long 
Dim Wid As Long, Hgt As Long 
Dim xoff As Long, yoff As Long 
 
'获取窗体背景图片尺寸 
 
hbm = hForm.Picture 
GetObjectAPI hbm, Len(bm), bm 
Wid = bm.bmWidth 
Hgt = bm.bmHeight 
 
 
ReDim bmByte(1 To Wid, 1 To Hgt) 
GetBitmapBits hbm, Wid * Hgt, bmByte(1, 1) '获取图像数组 
 
 
'如果没有传入transColor参数，则用第一个像素作为透明色 
 
If transColor = vbNull Then transColor = bmByte(1, 1) 
 
Rgn1 = CreateRectRgn(0, 0, 0, 0) 
 
For Y = 1 To Hgt '逐行扫描 
X = 0 
Do 
X = X + 1 
 
While (bmByte(X, Y) = transColor) And (X < Wid) 
X = X + 1 '跳过是透明色的点 
Wend 
SPos = X 
While (bmByte(X, Y) <> transColor) And (X < Wid) 
X = X + 1 '跳过不是透明色的点 
Wend 
EPos = X - 1 
 
'这一段是合并区域 
If SPos <= EPos Then 
Rgn2 = CreateRectRgn(SPos - 1, Y - 1, EPos, Y) 
CombineRgn Rgn1, Rgn1, Rgn2, RGN_OR 
DeleteObject Rgn2 
End If 
Loop Until X >= Wid 
Next Y 
 
SetWindowRgn hForm.hwnd, Rgn1, True '设定窗体形状区域 
DeleteObject Rgn1 
 
End Sub