首页 诗词 字典 板报 句子 名言 友答 励志 学校 网站地图
当前位置: 首页 > 教程频道 > 开发语言 > VB >

Frame控件透明的有关问题,请帮助修改代码

2012-03-16 
Frame控件透明的问题,请帮助修改代码首先,我在tabcript上边放了一个frame,为了适应xp视觉效果,希望frame背

Frame控件透明的问题,请帮助修改代码
首先,我在tabcript上边放了一个frame,为了适应xp视觉效果,希望frame背景色能够透明,在网上找到一段代码。但是出现了两个问题。

1,只有在button点击得情况下才能生效。我希望在formload的情况下出现
2,重复点击的话,背景色又恢复到了原始效果。

因为对api不太熟悉,修改不了。请指点

Option   Explicit

Private   Sub   Form_Load()
'keine   Systemfarben
Frame1.BackColor   =   &HFF&
End   Sub

Private   Sub   Command1_Click()
'Sub   in   modTransFrame
FrameTransparent   Frame1
End   Sub
'----------   Ende   Formular   "Form1 "   alias   Form1.frm     ----------
'---------   Anfang   Modul   "Module1 "   alias   Module1.bas   ---------
Option   Explicit

Public   Declare   Function   GetDC   Lib   "user32 "   (ByVal   hwnd   As   Long)   _
            As   Long

Public   Declare   Function   DeleteObject   Lib   "gdi32 "   (ByVal   hObject   _
            As   Long)   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   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   Long)   As   Long

Public   CtrlDc   As   Long

Public   Function   FrameTranz(Ctrl   As   Frame)   As   Long
    Dim   lHoch   As   Long
    Dim   lBreit   As   Long
    Dim   lTemp   As   Long
    Dim   lSkin   As   Long
    Dim   lStart   As   Long
    Dim   lZeile   As   Long
    Dim   lSpalte   As   Long
    Dim   lBackColor   As   Long

lSkin   =   CreateRectRgn(0,   0,   0,   0)

    With   Ctrl
'       bei   Form.ScaleMode   =   vbTwips
        lHoch   =   .Height   /   Screen.TwipsPerPixelY
        lBreit   =   .Width   /   Screen.TwipsPerPixelX

'       bei   Form.ScaleMode   =   vbPixels


'       lHoch   =   .Height
'       lBreit   =   .Width

        CtrlDc   =   GetDC(.hwnd)
        lBackColor   =   Ctrl.BackColor

        For   lZeile   =   0   To   lHoch   -   1
            lSpalte   =   0
            Do   While   lSpalte   <   lBreit
                Do   While   lSpalte   <   lBreit   And   GetPixel(CtrlDc,   lSpalte,     _
                lZeile)   =   lBackColor
                    lSpalte   =   lSpalte   +   1
                Loop

                If   lSpalte   <   lBreit   Then
                    lStart   =   lSpalte
                    Do   While   lSpalte   <   lBreit   And   GetPixel(CtrlDc,   lSpalte,     _
                    lZeile)   <>   lBackColor
                        lSpalte   =   lSpalte   +   1
                    Loop

                    If   lSpalte   >   lBreit   Then   lSpalte   =   lBreit
                    lTemp   =   CreateRectRgn(lStart,   lZeile,   lSpalte,   lZeile   +   1)
                    Call   CombineRgn(lSkin,   lSkin,   lTemp,   2)
                    Call   DeleteObject(lTemp)
                End   If
            Loop
        Next   lZeile
    End   With

FrameTranz   =   lSkin
End   Function

Public   Sub   FrameTransparent(Ctrl   As   Frame)
Dim   lSkin   As   Long
        Ctrl.Visible   =   True
        lSkin   =   FrameTranz(Ctrl)
        Call   SetWindowRgn(Ctrl.hwnd,   lSkin,   True)
End   Sub

[解决办法]
在 form的show事件里面写
FrameTransparent Frame1
[解决办法]
你在程序中加入下面的一句话,就可以解决“2,重复点击的话,背景色又恢复到了原始效果。”

CtrlDc = GetDC(.hwnd) 
lBackColor = Ctrl.BackColor 

'========避免重复绘制================================================
if GetPixel(CtrlDc, 0, 0) <> lBackColor then exit Function 
’==================================================================

因为执行一次透明操作后, GetPixel(CtrlDc, 0, 0) 的颜色就不等于 lBackColor 了。




[解决办法]
至于:1,只有在button点击得情况下才能生效。我希望在formload的情况下出现 

是因为在窗体还没有Show之前,系统不会绘制窗体及控件的,可采取一个笨办法:

设置一个 Timer1, 将其Timer1.Enabled = false , Timer1.Interval = 10,然后:

Private Sub Form_Load() 
'keine Systemfarben 
Frame1.BackColor = &HFF& 
Timer1.Enabled = True
End Sub 

Private Sub Timer1_Timer()
Command1_Click
Timer1.Enabled = False
End Sub

勉强可以解决以上问题,当然,也许有更好的办法,我还没时间去探究。

热点排行