用VB无窗口透明Usercontrol编写透明浮动按钮

1、用VB无窗口透明Usercontrol编写透明浮动按钮2009-11-30 16:51使用无窗口透明控件，好处是控件不是从窗口类继承而来的，可以节省一些内存资源，难点 是鼠标控制和坐标计算，缺点是无法直接响应键盘事件。而且，需要注意的是，在Paint 事件里，坐标是从(0，0)开始的，而在其它地方，坐标是相对于容器的。缺点是设计时， 无法用鼠标点选控件(只能用键盘移动)，微软公司也在MSDN里说了这是一个BUG，但至 今未解决。好了，废话俺不说了，打开VB6,新建一个“标准EXE”，然后添加一个用户控件，把 控件的BackStyle属性设置为“透明”，把Windowless属性设置为“True

2、”，再把俺的代 码复制过去，一个美观大方的透明浮动按钮便完成了。用户还可以设置控件的Caption属性 和Picture属性进一步美化。如有不解之处，可与俺联系：1, .个个个个个个个个个个个个个个个个个个个个个个个个个个个个个个个个个个个个个个个个个个个个个个个个个个个个个个个个个个个个个个个个*程序名称：FloatButton.ctl*程序功能：透明浮动按扭*作者：lyserver*联系方式：/lyserver6，A* .* * *7.8. Option Explicit= API 声明=Private Type POINTAPI13.x As Long14.y As Long15. En

3、d Type16. Private Type RECT17.Left As Long18.Top As Long19.Right As Long20.Bottom As Long21. End Type22. Private Declare Function GetCursorPos Lib user32 (lpPoint As POINTAPI) As Long23. Private Declare Function ScreenToClient Lib user32 (ByVal hwnd As Long lpPoint As POINTAPI) As Long24. Private De

4、clare Function DrawEdge Lib user32 (ByVal hdc As Long, qrc As RECT, ByVal edge As Long, ByVal grfFlags As Long) As Long25. Private Const BDR_RAISED = &H526. Private Const BDR_SUNKEN = &HA27. Private Const BDR_RAISEDINNER = &H4Private Const BDR_SUNKENINNER = &H8Private Const BDR_RAISEDOUTER = &H1Priv

5、ate Const BDR_SUNKENOUTER = &H2Private Const BF_RECT = &HFPrivate Declare Function DrawText Lib user32 Alias DrawTextA” (ByVal hdc As Long, ByVal IpStr As String, ByVal nCount As Long, IpRect As RECT, ByVal wFormat As Long) As LongPrivate Const DT_CENTER = &H1Private Const DT_VCENTER = &H4Private Co

6、nst DT_TOP = &H0Private Const DT_BOTTOM = &H8Private Const DT_LEFT = &H0Private Const DT_RIGHT = &H2Private Const DT_SINGLELINE = &H2040.41=事件声明=Public Event Click()45.=属性变量声明=Dim m_Picture As StdPictureDim m_Caption As StringDim m_TextAlign As AlignConstants52.=模块公共变量声明=Dim m_rcDraw As RECTDim m_Mo

7、useButton As IntegerDim WithEvents tm As Timer59.=函数名称：UserControl_Initialize函数说明：初始化控件=二=Private Sub UserControl_Initialize()Set tm = UserControl.Controls.Add(VB.Timer，tm)加载定时器tm.Interval = 10UserControl.ScaleMode = vbPixelsEnd Sub69.=函数名称：UserControl_Terminate函数说明：销毁控件=Private Sub UserControl_Term

8、inate()tm.Enabled = False 关闭定时器UserControl.Controls.Remove tm删除定时器End Sub78.=函数名称：UserControl_ReadProperties函数说明：读取控件属性=Private Sub UserControl_ReadProperties(PropBag As PropertyBag)On Error Resume Nextm_Caption = PropBag.ReadProperty(Caption,)m_TextAlign = PropBag.ReadProperty(TextAlign”, vbAlignNone)Set m_Picture = PropBag.ReadProperty(Picture, Nothing)End Sub89.=函数名称：UserControl_WriteProperties函数说明：保存控件属性=Private Sub UserControl_WriteProperties(PropBag As PropertyBag)CallPropBag.WriteProperty(Ca