如何在98下做异形窗体和半透明窗体？

Question

98下没有SetLayeredWindowAttributes函数，要怎么搞定这个问题呢？
我不希望是通过扫描来确定出一个区域的，那样速度很慢。
有没有什么好办法来确定一张位图中我想得到的RGN呢？还有怎么做半透明呢？

Answer 1

听说有个补丁程序，在98下安装后就可以用一些2000下才支持的API，不过我没用过不知能不能用在这里。

Answer 2

用扫描方法也可以很快的,只是不知道你用的是什么办法,我用的是getbitmapbits,比getpixel快很多.

Answer 3

函数SetLayeredWindowAttributes
　　使用这个函数，可以轻松的实现半透明窗体。按照微软的要求，透明窗体窗体在创建时应使用WS_EX_LAYERED参数（用CreateWindowEx），或者在创建后设置该参数（用SetWindowLong），我选用后者。全部函数、常量声明如下： 
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 SetLayeredWindowAttributes Lib "user32" (ByVal hwnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long 
　 　其中hwnd是透明窗体的句柄，crKey为颜色值，bAlpha是透明度，取值范围是[0,255]，dwFlags是透明方式，可以取两个值：当取值为LWA_ALPHA时，crKey参数无效，bAlpha参数有效；当取值为LWA_COLORKEY时，bAlpha参数有效而窗体中的所有颜色为crKey的地方将变为透明－－这个功能很有用：我们不必再为建立不规则形状的窗体而调用一大堆区域分析、创建、合并函数了，只需指定透明处的颜色值即可，哈哈哈哈！请看具体代码。
Private Const WS_EX_LAYERED = &H80000
Private Const GWL_EXSTYLE = (-20)
Private Const LWA_ALPHA = &H2
Private Const LWA_COLORKEY = &H1
代码一：一个半透明窗体
Private Sub Form_Load()
　　Dim rtn As Long
　　rtn = GetWindowLong(hwnd, GWL_EXSTYLE)
　　rtn = rtn Or WS_EX_LAYERED
　　SetWindowLong hwnd, GWL_EXSTYLE, rtn
　　SetLayeredWindowAttributes hwnd, 0, 200, LWA_ALPHA
End Sub代码二：形状不规则的窗体
Private Sub Form_Load()
　　Dim rtn As Long
　　BorderStyler=0
　　rtn = GetWindowLong(hwnd, GWL_EXSTYLE)
　　rtn = rtn Or WS_EX_LAYERED
　　SetWindowLong hwnd, GWL_EXSTYLE, rtn
　　SetLayeredWindowAttributes hwnd, &HFF0000, 0, LWA_COLORKEY '将扣去窗口中的蓝色
End Sub

Answer 4

图片转化为区域Public Function MakeRegion(picSkin As PictureBox) 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 = picSkin.hDC
    PicWidth = picSkin.ScaleWidth
    PicHeight = picSkin.ScaleHeight
    
    InFirstRegion = True: InLine = False
    X = Y = StartLineX = 0
     
    TransparentColor = GetPixel(hDC, 0, 0)
    'Dim t As Integer
    't = (form1.Height - form1.ScaleHeight) / 15
   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
                   LineRegion = CreateRectRgn(StartLineX, Y, X, Y + 1)
                    
                   If InFirstRegion Then
                       FullRegion = LineRegion
                       InFirstRegion = False
                   Else
                       CombineRgn FullRegion, FullRegion, LineRegion, RGN_OR
                       DeleteObject LineRegion
                   End If
               End If
           Else
               If Not InLine Then
                   InLine = True
                   StartLineX = X
               End If
           End If
       Next
   Next
    
   MakeRegion = FullRegion
End Function

Answer 5

用BitBlt把背景和前景的DC传送到内存中,再进行异或操作后传回屏幕即可.

Answer 6

''这些内容放入模块，可以直接把 Form 变为指图像样式的函数。
Option ExplicitPublic Declare Function GetObject 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 Declare Function GetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, ByVal dwCount As Long, lpBits As Any) As Long
Public Declare Function CreatePolygonRgn Lib "gdi32" (lpPoint As Any, ByVal nCount As Long, ByVal nPolyFillMode As Long) As LongPublic Const RGN_OR = 2
Public Const ALTERNATE = 1 ' ALTERNATE and WINDING arePublic Type BITMAP
        bmType As Long
        bmWidth As Long
        bmHeight As Long
        bmWidthBytes As Long
        bmPlanes As Integer
        bmBitsPixel As Integer
        bmBits As Long
End TypePublic Type POINTAPI
        X As Long
        Y As Long
End Type
Public Sub SetAutoRgn(hForm As Form, hbm As Long, 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, SPos1 As Long, Epos1 As Long
Dim bm As BITMAP
'Dim hbm As Long
Dim Wid As Long, hGt As Long
Dim Bind As Boolean
Dim bmByte() As Byte
Dim Pt(0 To 3) As POINTAPI
    Bind = False
'   获取窗体背景图片尺寸
    'hbm = hForm.Pic
    If hbm = 0 Then Exit Sub
    GetObject hbm, Len(bm), bm
    Wid = bm.bmWidth
    hGt = bm.bmHeight
    '改变窗体尺寸以符合背景图片大小
    hForm.Height = hGt * Screen.TwipsPerPixelY
    hForm.Width = Wid * Screen.TwipsPerPixelX
'    Rgn1 = CreateRectRgn(0, 0, hGt, Wid)
'    SetWindowRgn hForm.hWnd, Rgn1, True
    ReDim bmByte(1 To bm.bmWidthBytes, 1 To hGt)
    SetWindowRgn hForm.hWnd, Rgn1, True
    GetBitmapBits hbm, bm.bmWidthBytes * 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)   '((bmByte(X, Y) >= transColor - 2) And (bmByte(X, Y) <= transColor + 2)) And (X < Wid)
                X = X + 1 '跳过透明色的点
            Wend
            If X < Wid Then
                SPos = X
                While (bmByte(X, Y) <> transColor) And (X < Wid)  '((bmByte(X, Y) <= transColor - 2) Or (bmByte(X, Y) >= transColor + 2)) And (X < Wid)
                    X = X + 1 '跳过不透明的点
                Wend
                Epos = X - 1
                '这一段是合并区域
                Rgn2 = CreateRectRgn(SPos, Y, Epos, Y + 1)
                CombineRgn Rgn1, Rgn1, Rgn2, RGN_OR
                DeleteObject Rgn2
            End If
        Loop Until X >= Wid
    Next Y
    Erase bmByte
    '设定窗体形状区域
    SetWindowRgn hForm.hWnd, Rgn1, True
    DeleteObject Rgn1
End Sub''这些内容放入窗体,事先在窗体上加载图片，图片应有明显的分割颜色，调用方法
Private Sub Form_Load()
    SetAutoRgn frmAniClock, Me.Picture
End Sub

Answer 7

回复人： JayZhou(周杰伦) ( ) 信誉：100  2003-04-14 18:40:00  得分:0 
 
 
  我是希望 不 通过扫描的办法来搞的，各位前辈，有招吗？
  
 
不扫描那扫什么？你有好的想法吗？

Answer 8

对呀，就是想知道有没有不扫描就能得到一个依据位图而产生的RGN