回 帖 发 新 帖 刷新版面

主题:异型窗体通用函数

大家都知道,异型窗体的就是在窗体上贴一张图片,然后挖掉其中不需要的点。。。

现在写了一个通用函数,可是发现一小部分空白点没办法去掉,而一小部分要保留的点却被去除了。问题估计出现在最后的循环部分,不过纠结了一个晚上就是看不出有取错点的。

大家现出火眼金睛,帮我找找

下面是代码(都在一个窗体里),我也上传了测试工程
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 GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function SetWindowPos Lib "user32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long

Private 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

Private Const RGN_OR = 2
Private Const WS_CAPTION = &HC00000                  '  WS_BORDER Or WS_DLGFRAME
Private Const WS_SYSMENU = &H80000
Private Const WS_MINIMIZE = &H20000000
Private Const WS_MAXIMIZE = &H1000000
Private Const SWP_NOMOVE = &H2
Private Const SWP_NOSIZE = &H1
Private Const SWP_NOZORDER = &H4
Private Const SWP_FRAMECHANGED = &H20        '  The frame changed: send WM_NCCALCSIZE
Private Const GWL_STYLE = (-16)

Private Sub Command1_Click()
    End
End Sub

Private Sub Form_Load()
    FormRGN Me, App.Path & "\MAIN.BMP"
    'FormRGN Me, App.Path & "\Winter.JPG"
End Sub

Private Function FormRGN(f As Form, strPicPath As String) As Long
    Dim picBox As PictureBox
    Dim transparentColor As Long
    Dim oldStyle As Long, ret As Long
    
    Dim rgnTotal As Long, rgnTemp As Long
    Dim firstRgn As Boolean, isPreDotTran As Boolean
    
    Dim startX As Long, startY As Long, endX As Long, endY As Long
    
    Dim length As Long, width As Long
    
    Dim y As Long, x As Long
    
    Dim bmp As BITMAP
    
    f.BorderStyle = vbBSNone
    Set picBox = f.Controls.Add("VB.PictureBox", "p")
    picBox.width = f.width
    picBox.Height = Height
    picBox.Left = 0
    picBox.Top = 0
    picBox.Visible = True
    picBox.AutoRedraw = True
    picBox.ScaleMode = vbPixels
    picBox.BorderStyle = vbBSNone
    
    '移除窗体标题栏
    oldStyle = GetWindowLong(f.hWnd, GWL_STYLE)
    If oldStyle = 0 Then
        FormRGN = 0
        Exit Function
    End If
    SetWindowLong f.hWnd, GWL_STYLE, oldStyle And Not WS_SYSMENU And Not WS_CAPTION And Not WS_MAXIMIZE And Not WS_MINIMIZE
    SetWindowPos f.hWnd, 0, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOZORDER Or SWP_NOSIZE Or SWP_FRAMECHANGED
    
    '对图片路径做处理
    strPicPath = Replace(strPicPath, "\\", "\")
    Set picBox.Picture = LoadPicture(strPicPath)
    
    
    '获取图片实除宽高,并以此设置窗体
    ret = GetObject(picBox.Picture.Handle, Len(bmp), bmp)
    SetWindowPos f.hWnd, 0, 0, 0, bmp.bmWidth, bmp.bmHeight, SWP_NOZORDER Or SWP_NOMOVE Or SWP_FRAMECHANGED
    SetWindowPos picBox.hWnd, 0, 0, 0, bmp.bmWidth, bmp.bmHeight, SWP_NOZORDER Or SWP_NOMOVE Or SWP_FRAMECHANGED
    
    
    rgnTotal = CreateRectRgn(0, 0, 0, 0) '对总的区域句柄做个初始化
    transparentColor = GetPixel(picBox.hdc, 0, 0) '取得透明点的值
    isPreDotTran = True  '标记前面的点是否透明
    firstRgn = True    '是否是第一块区域
    
    '开始获取区域句柄并进行区域合并
    For y = 0 To picBox.ScaleHeight - 1
        For x = 0 To picBox.ScaleWidth - 1
            If GetPixel(picBox.hdc, x, y) = transparentColor Or x = picBox.ScaleWidth - 1 Then '如果到达透明点 或 点扫描到达行末
                If Not isPreDotTran Then
                    isPreDotTran = True
                    endX = x: endY = y + 1
                    rgnTemp = CreateRectRgn(startX, startY, endX, endY)
                    CombineRgn rgnTotal, rgnTotal, rgnTemp, RGN_OR
                    DeleteObject rgnTemp
                End If
            Else
                If isPreDotTran Then
                    isPreDotTran = False
                    startX = x: startY = y
                    If startX = picBox.ScaleWidth - 1 Then    '如是已经到行末
                        endX = startX + 1
                        endY = startY + 1
                        isPreDotTran = True
                        rgnTemp = CreateRectRgn(startX, startY, endX, endY)
                        CombineRgn rgnTotal, rgnTotal, rgnTemp, RGN_OR
                        DeleteObject rgnTemp
                    End If
                End If
            End If
        Next
    Next
    
    SetWindowRgn f.hWnd, rgnTotal, True
    DeleteObject rgnTotal
    Set picBox = Nothing
    
End Function

回复列表 (共13个回复)

沙发

用GDI+来处理还漂亮过。

板凳

[url=http://file.pfan.cn/upfile/200808272246140.zip]图片窗口[/url]

3 楼

这个方法麻烦了点,用layer来做更简单,只要两三句代码就搞定了,而且可以嵌入flash动画,也是异型边界的
如果用你这个做动画更麻烦

4 楼

哈哈,果然很好玩。

问一下2楼,你的那些API的声明哪里复制的?VB的api viewer没有那些声明。

不知3楼说的layer如何实现,可否提供个例子。如果可以嵌入个flash的例子也提供一个,让我学习学习。

最后,经过我反复调试,发现我原来代码的循环部分没有错,而且比书上的考虑得周详。至于为什么会有一点阴影,现在还不清楚。与书上差别就在于,窗体上的pictureBox我的是动态添加上去的,而书上是直接在设计时画在上面,仅此而已。经过反复比对,其他的没发现任何区别。

5 楼

好了,找到了。api viewer2004,所有的API都有,那个好用啊~!~

不敢乱传播,但为了报答大家的帮助,把下载地址放出来:
http://www.activevb.de/rubriken/apiviewer/index-apiviewereng.html

6 楼

那个GDI+不够全.

7 楼


bcahzvip:

你真神了!

那些什么GIDpXXX函数你是去哪里找的啊,

怎么我连在MSDN里都没有查到。

奇怪?

8 楼

用GDI处理的效果确实好,边界都是柔化效果
我自己的屏幕宠物的一段代码给你看看,用 layer+flash 搞的

[url]http://file.pfan.cn/upfile/200808300849181.rar[/url]

唯一不足的就是边界柔化不好弄,只有当背景是原form背景色时才是柔化的

9 楼

谁还有更好的方法,都可以发到这里来撒!

10 楼

[quote]用GDI处理的效果确实好,边界都是柔化效果
我自己的屏幕宠物的一段代码给你看看,用 layer+flash 搞的

[url]http://file.pfan.cn/upfile/200808300849181.rar[/url]

唯一不足的就是边界柔化不好弄,只有当背景是原form背景色时才是柔化的[/quote]

GOOD!
看了代码,大致了解,但有些疑问:
窗体如何保持置于最顶层,因为我看到窗体切换时,frm总是不会被盖住?

知道了:
    SetWindowPos Me.hwnd, -1, 0, 0, 0, 0, 3
    那个3是swp_nomove or swp_nosize
    原因就是那个-1:HWND_TOPMOST

我来回复

您尚未登录,请登录后再回复。点此登录或注册