回 帖 发 新 帖 刷新版面

主题:[原创]打造自己的多风格按纽--用户控件制作详解(4)-完

打造自己的多风格按纽--用户控件制作详解(4)

九、添加必要的鼠标事件

  我们这个按纽控件目前还只有 Click事件,这是不能满足用户要求的,因此还应添加若干必需的事
件,以及当这些事件发生时,按纽的颜色变化以及标题文本的颜色变化。
  让我们在 Option Explicit 节增加有关鼠标事件的声明:

Event MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Event MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Event MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)

  当鼠标移到按纽上或者鼠标点击按纽时,按纽的颜色应该发生不同的变化,以告知用户正在进行的
动作,而当鼠标离开按纽时,又必须恢复原有的颜色,这就需要获取当前鼠标位置。但 MouseMove事件
只能获取鼠标位于按纽上时的位置,不能获知鼠标是否离开了按纽。解决的办法是添加一个计时器,并
调用获取鼠标位置的 API 函数 GetCursorPos。当鼠标移到按纽上时,计时器启动,同时不断地探测鼠
标当前位置,一旦鼠标离开按纽,就恢复按纽原有颜色并停止计时器运行。
  根据以上思路,请在 UserControl 上添加一个计时器,属性设置为:

Enabled = False
Interval = 100

  计时器以及鼠标事件的过程代码如下:

Private Sub Timer1_Timer()
Dim p As POINTAPI
GetCursorPos p
If WindowFromPoint(p.X, p.Y) <> hwnd Then Timer1.Enabled = False: PaintColor
End Sub

Private Sub UserControl_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Ambient.UserMode And UserControl.Enabled And Button = 0 Then                                                            
  Dim sc As Long, cc As Long
  If BJShadeModus = 0 Then '如果没有使用色彩渐变
    sc = vBackColor: vBackColor = sc + &H20&
    PaintColor
    vBackColor = sc
  Else
    sc = vStartColor: cc = vCeaseColor
    vStartColor = sc + &H30&: vCeaseColor = cc + &H5&
    PaintColor
    vStartColor = sc: vCeaseColor = cc
  End If
  Timer1.Enabled = True
  RaiseEvent MouseMove(Button, Shift, X, Y)
End If
End Sub

Private Sub UserControl_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Ambient.UserMode And UserControl.Enabled Then                                                             
  Dim cX As Integer, cY As Integer
  cX = vCaptionPosX: cY = vCaptionPosY
  vCaptionPosX = cX + 1: vCaptionPosY = cY + 1
  PaintColor
  vCaptionPosX = cX: vCaptionPosY = cY
  RaiseEvent MouseDown(Button, Shift, X, Y)
End If
End Sub

Private Sub UserControl_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
PaintColor
RaiseEvent MouseUp(Button, Shift, X, Y)
End Sub

  Timer1_Timer 过程中还调用了 API 函数 WindowFromPoint,这个函数的作用是返回指定点的窗口
的句柄,当鼠标移出按纽后,返回的就不是按纽控件的句柄了,程序据此判断鼠标已不位于按纽之上。
  MouseMove 和 MouseDown过程中的 Ambient.UserMode 属性返回一个布尔值,它指示控件当前的运
用模式:返回 True 表示在设计模式(正在被中间用户使用),返回 False表示在运行模式(正在被最
终用户使用)。
  RaiseEvent MouseMove(Button, Shift, X, Y) 语句激活事件并将三个参数传递给中间用户所编
程序中的 PrettyCmd_MouseMove 事件过程。
  提醒一点:我在代码中只是对颜色作了简单的变化,你可以根据自己的喜好加以修改,甚至可以专
门编写一段过程来变化这些颜色。

  最后,在 Option Explicit 节中声明 Timer1_Timer 过程中所用到的两个 API 函数:

Private Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long


十、设置按纽能否作为标准命令按纽使用以及对[Tab]的处理

  VB的标准按纽控件可以通过设置Default属性或Cancel属性来决定是否窗体的缺省命令按纽或取消
按纽,也能够通过[Tab]键来获得焦点,那么,我们自制的按纽控件也应该具有这些属性。
  为了使 PrettyCmd 具有 Default 和 Cancel 属性,请进入控件设计的 UserControl页面,在属性
窗口中找到 DefaultCancel 属性,将它设为 True,然后在 Option Explicit 节中添加事件声明:

Event KeyPress(KeyAscii As Integer)

  再添加过程代码:

Private Sub UserControl_AccessKeyPress(KeyAscii As Integer)
If Not Ambient.UserMode Then Exit Sub
If Ambient.DisplayAsDefault Then
  If KeyAscii = 13 Then UserControl_Click  '如果按下回车键
Else
  If KeyAscii = 27 Then UserControl_Click   '如果按下Esc键
End If
'RaiseEvent KeyPress(KeyAscii) '如果去掉前面的注释符,则在窗体代码中可以响应KeyPress事件
End Sub

  在这段代码中,首先测试 Ambient 对象的 UserMode属性,如果是设计模式就退出过程,如果是运
行模式,那么再测试 DisplayAsDefault 属性,该属性如果为True,则控件是窗体的缺省命令按纽,可
以响应回车键,否则响应 [Esc] 键。

  继续输入当按纽控件获得或失去焦点时的处理过程代码(这是专为处理 [Tab] 键编写的):

Private Sub UserControl_GotFocus()
If Ambient.UserMode And UserControl.Enabled Then
  Dim sc As Long, cc As Long
  If BJShadeModus = 0 Then '如果没有使用色彩渐变
    sc = vBackColor: vBackColor = sc + &H20&
    PaintColor
    vBackColor = sc
  Else
    sc = vStartColor: cc = vCeaseColor
    vStartColor = sc + &H30&: vCeaseColor = cc + &H5&
    PaintColor
    vStartColor = sc: vCeaseColor = cc
  End If
End If
End Sub

Private Sub UserControl_LostFocus()
PaintColor
End Sub

  GotFocus事件过程与 MouseMove 事件过程的代码很相似,你可以将相似部分另写为一个子过程,然后
在这两个事件过程中调用它,以节省代码。


十一、锦上添花--为按纽加上美丽的图片

  在 Option Explicit 节中的声明:

Dim vStdPicture As StdPicture   '声明一个 StdPicture 类型的图像框
Dim vPicPosX As Integer         '图片位置X坐标
Dim vPicPosY As Integer         '图片位置Y坐标

  添加三对属性过程:


Public Property Get PicPosX() As Integer
PicPosX = vPicPosX
End Property

Public Property Let PicPosX(ByVal vNewValue As Integer)
vPicPosX = vNewValue
PropertyChanged "PicPosX"
PaintColor
End Property

Public Property Get PicPosY() As Integer
PicPosY = vPicPosY
End Property

Public Property Let PicPosY(ByVal vNewValue As Integer)
vPicPosY = vNewValue
PropertyChanged "PicPosy"
PaintColor
End Property

Public Property Get Picture() As StdPicture
Set Picture = vStdPicture
End Property

Public Property Set Picture(ByVal vNewPic As StdPicture)
Set vStdPicture = vNewPic
PropertyChanged "Picture"
PaintColor
End Property

  由于 Picture 是一个对象属性,它具有与 Font 属性相似的特殊之处,即:在它的两个属性过程
中,均须在等式的前面加上“Set”关键字。但 Picture 属性更加特殊,一般的对象(如 Font 对象)
只有 Set 过程而没有 Let 过程,但 Picture属性必须包括这两个过程。否则,你将只能在程序设计时
在属性窗口加入图片,而不能在程序代码中以 PrettyCmd.Picture=LoadPicture("路径")的语句形式动
态加载图片(会跳出错误对话框说“Picture 属性无法使用”,网上很多发表的能带图片的按纽控件,
都有这个 BUG,就是因为缺少 Let 过程)。所以我们必须加上这段过程代码:

Public Property Let Picture(ByVal vNewPic As StdPicture)
UserControl.Picture = vNewPic
End Property
  
  接着,在 ReadProperties 过程中添加代码:

Set vStdPicture = PropBag.ReadProperty("Picture", Nothing)
vPicPosX = PropBag.ReadProperty("PicPosX", 10)
vPicPosY = PropBag.ReadProperty("PicPosy", (UserControl.ScaleHeight - 16) / 2)

  在 WriteProperties 过程中添加代码:

PropBag.WriteProperty "Picture", vStdPicture, Nothing
PropBag.WriteProperty "PicPosX", vPicPosX, 10
PropBag.WriteProperty "PicPosY", vPicPosY, (UserControl.ScaleHeight - 16) / 2

  在 UserControl_Resize 过程中 DrawButton 语句的前面添加代码:

vPicPosX = 10
vPicPosY = (UserControl.ScaleHeight - 16) / 2

  以上有关语句中的“-16”可以改为“-32”或者减去别的什么数,这只是一个预设的图像高度值。

  下面再接着添加绘制图像的过程代码:

Private Sub DrawImage()
Dim pW As Long, pH As Long
pW = ScaleX(vStdPicture.Width, vbHimetric, vbPixels)
pH = ScaleY(vStdPicture.Height, vbHimetric, vbPixels)
UserControl.PaintPicture vStdPicture, vPicPosX, vPicPosY, pW, pH
End Sub

  ScaleX 和 ScaleY 方法的作用是把 StdPicture 图像框宽、高的计量单位转换为“像素”。
  PaintPicture方法把StdPicture图像框中的图像复制到用户控件上,这个方法大家应该都很熟悉。

  在 PaintColor 过程的后面增加一句:

If Not vStdPicture Is Nothing Then DrawImage

  这一句的意思是:如果 StdPicture 图像框不为空,就转去执行绘图过程

  修改 MouseDown 过程,修改好的代码如下:

Private Sub UserControl_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Ambient.UserMode And UserControl.Enabled Then
  Dim cX As Integer, cY As Integer, pX As Integer, PY As Integer
  cX = vCaptionPosX: cY = vCaptionPosY
  vCaptionPosX = cX + 1: vCaptionPosY = cY + 1
  pX = vPicPosX: PY = vPicPosY
  vPicPosX = pX + 1: vPicPosY = PY + 1
  PaintColor
  vCaptionPosX = cX: vCaptionPosY = cY: vPicPosX = pX: vPicPosY = PY
  RaiseEvent MouseDown(Button, Shift, X, Y)
End If
End Sub

  最后添加属性描述:

Picture:返回/设置控件中显示的图像。
PicPosX:返回/设置图像在按纽控件上显示时的 X 坐标(以像素为单位)。
PicPosY:返回/设置图像在按纽控件上显示时的 Y 坐标(以像素为单位)。

  至此,我们制作的多风格按纽“中功告成”!


十二、编译为 .OCX 文件

  编译为 .OCX 文件后,你就可以象使用系统中的其它标准控件一样来调用我们这个漂亮的按纽控件
了!步骤如下:

  1.退出工程,用记事本打开 PrettyCmd.ctl,作一点小小的改动。

找到这一句:Attribute VB_Exposed = False
改为:Attribute VB_Exposed = True

  保存,退出记事本。

  说明:由于我们是在窗体工程中添加的用户控件,无法直接编译.OCX文件,所以要改一下以后再进
行第二个步骤。如果我们是在用户控件工程或工程组中(包含窗体工程和用户控件工程)编写的代码,
则无需任何改动就可直接编译为.OCX文件。

  2.新建一个 ActiveX 控件工程,将工程名改为 PrettyButton,再用添加现存用户控件的方法,将
PrettyCmd.ctl 添加进工程,并移除 UserControl1。

  3.右击工程管理器中的 PrettyButton(PrettyButton),选择“PrettyButton属性”菜单项,弹
出工程属性对话框,在“通用”选项卡中“工程类型”下拉框中选中“ActiveX 控件”,在“生成”选
项卡中设置好版本号和版本信息,其它选项就保持默认吧,确定退出。
  提示:如果你想使这个.ocx控件具有许可证,可在“通用”选项卡中勾选“要求许可证关键字”,
这样,即使有人将你的.ocx拷贝了去,也无法使用!不过我建议不要这样做,大家互通有无互相提高不
是更好吗。

  4.点击“文件→生成 PrettyButton.ocx”,大约 3 秒钟后,恭喜你,按纽控件文件生成了!生成
的 PrettyButton.ocx 文件大小为60K。

  但是,别忘了我们还没有大功告成,因为如果你还想增加一些属性或事件(例如 PrettyCmd_KeyDo
wn),则还有更多的代码等着你去绞尽脑汁,呵呵,任重而道远啊!不过有了前面实验的基础,我想你
一定能够胜利达到自己的目标!
  我累了,不想再多说什么了……

  附件是我们这个自制多风格按纽的完整代码

回复列表 (共23个回复)

11 楼


ding,qiang[em1][em1]

12 楼

实在是强悍啊

13 楼

VB 版的呀

14 楼

汗`我以前下过一和,和你这个一样的.原来作者是你啊.

15 楼

16 楼

请问一江秋水大哥,如果在一个XP化的程序中加入自定义控件在退出时会出错,你是怎样解决的?

17 楼

把你的XP化的程序作为附件发上来,我帮你看看

18 楼

http://bbs.pfan.cn/downfile.asp?fileid=2582

19 楼

试了一下,无论是运行工程组文件还是运行那个编译的EXE文件,退出时都没有发生任何错误啊。

20 楼

确实有这个问题,我以前也遇到过,不过很少把他xp化,一直未管它
如果你在主程序里加上一个comctl32.dll编写的控件,例如reachtextbox这类控件后就不会出错了
猜想是主程序启动时调用comctl32初始化函数,但退出时应该还有一句退出函数,但我把这个dll都查了一遍,没看到哪个函数象退出函数,所以就没管它了。
我现在在网吧里,运行了noname的程序,确实在退出时要出错(vb里面调试不会出错),是个系统错误,是终止掉了的。

我以前看过你的xp控件,发现主程序xp化后不出错,发现你里面用了由comctl32.dll编写的控件!我把那个控件删除后就出错了!

我来回复

您尚未登录,请登录后再回复。点此登录或注册