VB6中模拟按钮的实现

朋友发来一个 VB6 的小要求：自行绘制按钮，并且按钮不能有句柄，不得用 Image 控件，需要支持单击事件，鼠标移动上去会变化。感觉像个考试题啊！

 

先贴代码：

VERSION 5.00 Begin VB.Form Form1 Caption = "Form1" ClientHeight = 3090 ClientLeft = 60 ClientTop = 450 ClientWidth = 4680 LinkTopic = "Form1" ScaleHeight = 3090 ScaleWidth = 4680 StartUpPosition = 3 '窗口缺省 Begin VB.Image Image3 Height = 1215 Left = 1560 Top = 1680 Width = 2655 End End Attribute VB_Name = "Form1" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False Dim pic1 As StdPicture, pic2 As StdPicture Dim btnLeft As Single, btnTop As Single Dim btnRight As Single, btnBottom As Single Dim inButton As Boolean, last As Boolean Private Sub Form_Load() Set pic1 = LoadPicture(App.Path + "/111.bmp") Set pic2 = LoadPicture(App.Path + "/112.bmp") btnLeft = 150: btnTop = 150 ' 亮点在这里啊 btnRight = ScaleX(pic1.Width, vbHimetric, vbPixels) * 15 + btnLeft btnBottom = btnTop + ScaleY(pic1.Height, vbHimetric, vbPixels) * 15 inButton = False: last = inButton Image3.Picture = pic1 MsgBox Image3.Picture.Width & " x " & Image3.Picture.Height & vbNewLine & _ Image3.Width & " x " & Image3.Height End Sub Private Function IsMouseInButton(X As Single, Y As Single) As Boolean IsMouseInButton = (X <= btnRight And X >= btnLeft) And (Y <= btnBottom And Y >= btnTop) End Function Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) Debug.Print "x: " & X & " y: " & Y & " Button: " & Button inButton = IsMouseInButton(X, Y) If inButton <> last Then Me.Refresh Debug.Print "InButton: " & inButton & ", last: " & last End If last = inButton End Sub Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) If inButton Then MsgBox ("button clicked.") End If End Sub Private Sub Form_Paint() If inButton Then PaintPicture pic2, btnLeft, btnTop Else PaintPicture pic1, btnLeft, btnTop End If End Sub

思路就是 使用 PaintPicture 在窗体上作图，使用MouseMove事件判定鼠标是否在图片的位置上，如果是则绘制鼠标移动浮动后的图片，否则就绘制原始按钮图片。

在判断鼠标位置是否在图片位置的这块功能中发现一个问题，StdPicture.Width比图片的实际长度要大，不知道是什么原因造成的。使用必应搜索MS网站无结果，最后依靠伟大的google搜索外国网友的疑问找到解决方法，必须使用 ScaleX 和 ScaleY 函数计算图片在设备（此处是窗体）上的实际大小。

 

花了大约两个小时的时间，好在有一点收获。不错。