透明mod.bas

一个测试网络链接速度的工具源码。测试你的网络连接速率。

Attribute VB_Name = "alphaMod"
Option Explicit
''''''''''''''''''''''''窗口自定义'''''''''''''''''''''''''''''
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 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 ReleaseCapture Lib "user32" () As Long
Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Public Const RGN_OR = 2
Public Const WM_NCLBUTTONDOWN = &HA1
Public Const HTCAPTION = 2

'
''''''''''''''''''''''''窗口自定义'''''''''''''''''''''''''''''''
'
'自定义函数
Public Function MakeRegion(FrmSkin As Object) As Long
    Dim X As Long, Y As Long, StartLineX As Long
    Dim FullRegion As Long, LineRegion As Long
    Dim TransparentColor As Long
    Dim InFirstRegion As Boolean
    Dim InLine As Boolean
    Dim hdc As Long
    Dim PicWidth As Long
    Dim PicHeight As Long
    '设置初始参数
    hdc = FrmSkin.hdc
    PicWidth = FrmSkin.ScaleWidth
    PicHeight = FrmSkin.ScaleHeight
    InFirstRegion = True
    InLine = False
    X = 0: Y = 0: StartLineX = 0
    '获取图片框原点像素的RGB值作为初值
    TransparentColor = GetPixel(hdc, 0, 0)
    '逐一扫描获取图片框各点像素的RGB值
    For Y = 0 To PicHeight - 1
      For X = 0 To PicWidth - 1
       If GetPixel(hdc, X, Y) = TransparentColor Or X = PicWidth Then
          If InLine Then
             InLine = False
             '创建源区域2
             LineRegion = CreateRectRgn(StartLineX, Y, X, Y + 1)
             If InFirstRegion Then
                '定义源区域1初值
                FullRegion = LineRegion
                InFirstRegion = False
             Else
                '将两个区域组合为一个新区域
                CombineRgn FullRegion, FullRegion, LineRegion, RGN_OR
                '删除源区域2，释放内存空间
                DeleteObject LineRegion
             End If
          End If
        Else
          If Not InLine Then
             InLine = True
             '定义源区域2的x1
             StartLineX = X
          End If
        End If
      Next X
    Next Y
    '获取最后区域
    MakeRegion = FullRegion
End Function