clock.bas

来自「一个用vb开发的源代码」· BAS 代码 · 共 55 行

Attribute VB_Name = "modAFS"
Global alan As Integer
Global lr, ud As Integer
Global james As Integer
Global linnegar As Integer
Global startx As Integer
Global starty As Integer
Global finx As Integer
Global finy As Integer
Global holding As Boolean
Global player As String
Global baskets As Integer
Global playtime As Integer

Public Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y 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
Declare Sub ReleaseCapture Lib "user32" ()
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 Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long

Public Const RGN_DIFF = 4
Public Const SC_CLICKMOVE = &HF012&
Public Const WM_SYSCOMMAND = &H112


Dim CurRgn, TempRgn As Long

Public Function AutoFormShape(bg As Form, transColor)

Dim X, Y As Integer

CurRgn = CreateRectRgn(0, 0, bg.ScaleWidth, bg.ScaleHeight)  ' Create base region which is the current whole window

While Y <= bg.ScaleHeight  ' Go through each column of pixels on form
    While X <= bg.ScaleWidth  ' Go through each line of pixels on form
        If GetPixel(bg.hdc, X, Y) = transColor Then  ' If the pixels color is the transparency color (bright purple is a good one to use)
            TempRgn = CreateRectRgn(X, Y, X + 1, Y + 1)  ' Create a temporary pixel region for this pixel
            success = CombineRgn(CurRgn, CurRgn, TempRgn, RGN_DIFF)  ' Combine temp pixel region with base region using RGN_DIFF to extract the pixel and make it transparent
            DeleteObject (TempRgn)
        End If
        X = X + 1
    Wend
        Y = Y + 1
        X = 0
Wend
success = SetWindowRgn(bg.hwnd, CurRgn, True)
DeleteObject (CurRgn)

End Function