浅谈如何利用PB实现树型列表动态半透明提示（四）（原

作者：BALLOONMAN2002 2004年6月26日 4、创建用户函数wf_maketrans，用于实现半透明效果： Long hDCscr,bhandle,hdest,frmdc,BlendLng,copywidth,copyheight,copyleft,copytop,ret long copywidth2,copyheight2,copyleft2,copytop2,mledc Long xDeviation,yDeviation blendfunction Blend Window lw_tmp //BlendLng = 11796480 Blend.SourceConstantAlpha = char(trans) CopyMemory2(BlendLng, Blend, 4) lw_tmp=frm.getparent() //lw_tmp.setredraw(true) copywidth = UnitsToPixels(frm.Width, XUnitsToPixels!) copyheight = UnitsToPixels(frm.Height, YUnitsToPixels!) copywidth2 = UnitsToPixels(mle.Width, XUnitsToPixels!) copyheight2 = UnitsToPixels(mle.Height, YUnitsToPixels!) //上述代码用于坐标体系转换 frm.x = xpos frm.y = ypos If lw_tmp.Border <> false Then yDeviation = GetSystemMetrics(SM_CYCAPTION) + GetSystemMetrics(SM_CYFRAME) xDeviation = GetSystemMetrics(SM_CXFRAME) Else yDeviation = 0 xDeviation = 0 End If if trim(lw_tmp.menuname) <> "" then yDeviation = yDeviation + GetSystemMetrics(SM_CYMENU) end if //也可以用CLIENTTOSCREEN进行转换 copyleft = UnitsToPixels((lw_tmp.x + xpos), XUnitsToPixels!) + xDeviation copytop = UnitsToPixels((lw_tmp.y + ypos), YUnitsToPixels!) + yDeviation copyleft2 = UnitsToPixels(mle.x, XUnitsToPixels!) copytop2 = UnitsToPixels(mle.y, YUnitsToPixels!) //上述代码用于坐标体系转换 hDCscr = GetDC(0) //获取屏幕的设备句柄 hdest = CreateCompatibleDC(hDCscr) bhandle = CreateCompatibleBitmap(hDCscr, copywidth, copyheight) ret = SelectObject(hdest,bhandle) frmdc = getdc(handle(frm)) mledc = getdc(handle(mle)) //此句可加可不加，主要是起清除原来图象目的，防止图象重叠，VB中此处必须要.cls，因为它具有AUTOREDRAW能力 //frm.setredraw(true) //mle.setredraw(true) //'此处一定要等待一段时间，否则窗体来不及hide，就已经被重新抓屏了 Sleep(100) ret = BitBlt(hdest, 0, 0, copywidth, copyheight, hDCscr, copyleft , copytop , 13369376) //上述代码即将屏幕的截图拷贝到内存缓存区域 //VB中FORM具有AUTOREDRAW的属性可以自动重画，PB无此能力，只好在此处就得显示出来 if ib_first then wf_setrgn(frm) end if frm.Visible = True if ib_first then wf_setrgn(frm) ib_first = false end if ret = AlphaBlend(frmdc, 0, 0, copywidth, copyheight, hdest, 0, 0, copywidth, copyheight, BlendLng) ret = AlphaBlend(mledc, 0, 0, copywidth2, copyheight2, hdest, copyleft2 , copytop2, copywidth2, copyheight2, BlendLng) //上述代码将内存缓存区域中的截图拷贝到气泡UO和其上的MLE_1控件的HDC //setnewrgn frm wf_setrgn(frm) ret = ReleaseDC(0, hDCscr) ret = ReleaseDC(handle(frm), frmdc) ret = ReleaseDC(handle(mle), mledc) ret = DeleteDC(hdest) ret = DeleteObject(bhandle) //最后释放或删除获取的内存对象 四、气泡形状效果实现 1、声明本地外部函数： Function ulong CreateRectRgn(ulong X1,ulong Y1,ulong X2,ulong Y2) LIBRARY "gdi32.dll" Function ulong CreateRoundRectRgn(ulong X1,ulong Y1,ulong X2,ulong Y2,ulong X3,ulong Y3) LIBRARY "gdi32.dll" Function ulong CreatePolygonRgn(ref POINTAPI lpPoint[],ulong nCount,ulong nPolyFillMode) LIBRARY "gdi32.dll" Function ulong CombineRgn(ulong hDestRgn,ulong hSrcRgn1,ulong hSrcRgn2,ulong nCombineMode) LIBRARY "gdi32.dll" Function ulong CreateSolidBrush(ulong crColor) LIBRARY "gdi32.dll" Function ulong FrameRgn(ulong hdc,ulong hRgn,ulong hBrush,ulong nWidth,ulong nHeight) LIBRARY "gdi32.dll" Function ulong SetWindowRgn(ulong hWnd,ulong hRgn,boolean bRedraw) LIBRARY "user32.dll" 2、创建用户函数wf_setrgn，用于创建气泡形状控件，该函数在上一小节的用户函数wf_maketrans中予以调用： long rgn_1,rgn_2,myrgn,hhbr,w,h,ret POINTAPI shapev[] //初始化长、宽边距 w = UnitsToPixels(frm.Width, XUnitsToPixels!) h = UnitsToPixels(frm.Height, YUnitsToPixels!) //初始化右下脚三角顶点坐标 shapev[1].X = w * (1 / 8) shapev[1].Y = h - 30 shapev[2].X = 0 shapev[2].Y = h shapev[3].X = w * (3 / 8) shapev[3].Y = h - 30 //开始创建指定图形区域 myrgn = CreateRectRgn(0, 0, 0, 0) rgn_1 = CreateRoundRectRgn(0, 0, w, h - 20, 20, 20) //创建椭圆角矩形区域 rgn_2 = CreatePolygonRgn(shapev[],3,1) //创建任意多边形区域 //合并最终图形 ret = CombineRgn(myrgn, rgn_1, rgn_2, 2) // 创建用户自定义颜色刷子 hhbr = CreateSolidBrush(16479614) //对最终图形画边框 ret = FrameRgn(getdc(handle(frm)), myrgn, hhbr, 1, 1) //设置当前窗体使用此区域 ret = SetWindowRgn(handle(frm), myrgn, True) //释放各对象 ret = DeleteObject(myrgn) ret = DeleteObject(rgn_1) ret = DeleteObject(rgn_2) ret = DeleteObject(hhbr) 2、利用上述代码可以轻松实现任务栏右下脚提示效果，如图： http://blog.csdn.net/images/blog_csdn_net/balloonman2002/17312/r_BALLOON-2.JPG 至此，树型列表动态半透明效果提示全部完成，效果图见： http://blog.csdn.net/images/blog_csdn_net/balloonman2002/17312/r_BALLOON-1.JPG 如需要进一步资料，请联系QQ:27855043,MSN:WEIYIN2001@MSN.COM 如有不当之处，敬盼您的指点。