dmodule.bas

来自「使用VB仿QQ界面开发的ICQ程序,采用C/S结架,实现简单文字聊天.」· BAS 代码 · 共 51 行

Attribute VB_Name = "dModule"
Public Declare Function sndPlaySound Lib "winmm.dll" Alias "sndPlaySoundA" (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long
Public YourSN As String
Public FinalClose As Boolean
'Public Function FileExists(sFullPath As String) As Boolean
'    Dim oFile As New Scripting.FileSystemObject
'    FileExists = oFile.FileExists(sFullPath)
'End Function

'---------------------------------------
'定义连接服务器的IP地址和端口.
Public gPort As String
Public gHostIP As String
'Public Const gPort = 1008
'Public Const gHostIP = "192.168.1.198"  '"216.77.225.246" 'put your IP here and comment out the one below to allow people to connect to your IP

'---------------------------
'XP界面效果
Public Declare Sub InitCommonControls Lib "comctl32.dll" ()
'Private Sub Form_Initialize()
'    InitCommonControls
'End Sub
'--------------------------
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
Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Dim CurRgn, TempRgn As Long  ' Region variables

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 <= 5 ' 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)  ' Delete the temporary pixel region and clear up very important resources
            End If
            x = x + 1
        Wend
            y = y + 1
            x = 0
    Wend
    success = SetWindowRgn(bg.hWnd, CurRgn, True)  ' Finally set the windows region to the final product
    DeleteObject (CurRgn)  ' Delete the now un-needed base region and free resources
    ' This code is by Chris Yates (1999)
End Function