请老师帮忙修改自定义按钮
能不能将按钮点击以后变成控件内img(4)的颜色,点击按钮1后,按钮1变成img(4)的颜色,点击按钮2后,按钮2变成img(4)的颜色,按钮1恢复原来的img(0)的颜色,也就是点击后的按钮处于醒目的选择状态,谢谢
CMCommandButton源代码.rar
(11.08 KB)
'缺省属性值: Const m_def_ClickON = 0 '属性变量: Dim m_ClickON As Boolean
'注意!不要删除或修改下列被注释的行! 'MemberInfo=0,0,0,0 Public Property Get ClickON() As Boolean ClickON = m_ClickON End Property Public Property Let ClickON(ByVal New_ClickON As Boolean) m_ClickON = New_ClickON PropertyChanged "ClickON" Call ReDraw '重绘按钮 End Property
Dim imgindex As ButtonState '使用这个变量来进行标记 按钮的图像索引号
imgindex = mState
'如果指定了单击保持开关 If m_ClickON Then If mState = BS_Normal Then '如果当前是 默认色 imgindex = BS_hongse '设置为提示颜色,状态是随时会修改的。 End If End If
'*****************************************五、编写重画控件的过程:ReDraw '重画控件 Private Sub ReDraw() Dim lngWidth As Long '按钮长度 Dim lngHeight As Long '按钮高度 Dim lngCantWidth As Long '按钮四个角的长度 Dim lngCantHeight As Long '按钮四个角的高度 Dim imgindex As ButtonState '使用这个变量来进行标记 按钮的图像索引号 imgindex = mState '如果指定了单击保持开关 If m_ClickON Then If mState = BS_Normal Then '如果当前是 默认色 imgindex = BS_hongse '设置为提示颜色,状态是随时会修改的。 End If End If With UserControl 'UserControl 代表当前按钮,不能用 Me 来代替。 .Cls '清除控件背景图片和文本 lngWidth = .ScaleWidth '按钮内部长度 lngHeight = .ScaleHeight '按钮内部高度 '********************************************************************************** '根据按钮状态,选用不同图片绘制到按钮中。 '因为按钮图片的边框是不同于中部的。 '如果直接全部 PaintPicture 上去而且按钮大于或小于图片的大小时, '边框的线条将会被放大或缩小,而且可能上下边框和左右边框的线条不同粗细, '影响了按钮的美观。所以要先把按钮的左上角、右上角、左下角、右下角画上去, '然后再画上下边框和左右边框。因为左上角、右上角、左下角、右下角是按1:1画到按钮; '上下边框以高度1:1,宽度拉伸到左右两个角;左右边框以宽度1:1,高度拉伸到上下两个角。 '所以边框线看起来就跟原图片一致大小。 '再把图片中部画上去,按钮的主体就出来了。 '********************************************************************************** '-------------------------------------- '因为这里的图片边框(包括内部发光,即图 '片有内外两条边框)为 2 像素,有时候按 '钮的高度或长度会小于 4 像素,所以这里 '用了一个条件判断:当按钮的宽度大小 4 像 '素的时候,左右边框的宽度就等于 2 ,否则 '左右边框宽度等于按钮宽度的一半。上下边框 '也然。 '------------------------------------- lngCantWidth = IIf(lngWidth > 4, 2, lngWidth / 2) '按钮四个角、左右边框的长度 lngCantHeight = IIf(lngHeight > 4, 2, lngHeight / 2) '按钮四个角、上下边框的高度 '------------------------------------- '开始绘制按钮了。img(imgindex):图片是用 'Image 控件组存放的,根据 imgindex 的值 '调用相应的图片进行绘制。 '------------------------------------- '+++++++++++++++++++++++++++++++++++++ 'PaintPicture picture,x1, y1, width1, height1, x2, y2, width2, height2, opcode 'Picture:图片 'X1:按钮中要绘图的 X 坐标值。 'Y1:按钮中要绘图的 Y 坐标值。 'Width1:按钮中要绘图的宽度。 'Height1:按钮中要绘图的高度。 'X2:从图片中取出的区域的 X 坐标值。 'Y2:从图片中取出的区域的 Y 坐标值。 'Width2:从图片中取出的区域的宽度。 'Height2:从图片中取出的区域的高度。 '+++++++++++++++++++++++++++++++++++++ '绘制左上角 .PaintPicture img(imgindex), 0, 0, lngCantWidth, lngCantHeight, 0, 0, 2, 2 '绘制右上角 .PaintPicture img(imgindex), lngWidth - lngCantWidth, 0, lngCantWidth, lngCantHeight, 72, 0, 2, 2 '绘制左下角 .PaintPicture img(imgindex), 0, lngHeight - lngCantHeight, lngCantWidth, lngCantHeight, 0, 20, 2, 2 '绘制右下角 .PaintPicture img(imgindex), lngWidth - lngCantWidth, lngHeight - lngCantHeight, lngCantWidth, lngCantHeight, 72, 20, 2, 2 If lngWidth > 4 Then '绘制上部 .PaintPicture img(imgindex), lngCantWidth, 0, lngWidth - lngCantWidth * 2, lngCantHeight, 2, 0, 70, 2 '绘制下部 .PaintPicture img(imgindex), lngCantWidth, lngHeight - lngCantHeight, lngWidth - lngCantWidth * 2, lngCantHeight, 2, 20, 70, 2 End If If lngHeight > 4 Then '绘制左边 .PaintPicture img(imgindex), 0, lngCantHeight, lngCantWidth, lngHeight - lngCantHeight * 2, 0, 2, 2, 18 '绘制右边 .PaintPicture img(imgindex), lngWidth - lngCantWidth, lngCantHeight, lngCantWidth, lngHeight - lngCantHeight * 2, 72, 2, 2, 18 End If If lngWidth > 4 And lngHeight > 4 Then '绘制中部 .PaintPicture img(imgindex), lngCantWidth, lngCantHeight, lngWidth - lngCantWidth * 2, lngHeight - lngCantHeight * 2, 2, 2, 70, 18 End If '********************************************************************************** '按钮的图片已经绘制好了,现在要写上按钮的 Caption 了。这里用了 API 函数 DrawText 。 '先声明一下。然后根据按钮的 Enabled 属性判断文字的颜色。再写上文字就 OK 了。 '********************************************************************************** If Len(mstrCaption) > 0 Then '当 Caption 不为空时绘制文本。 '如果按钮的 Enabled 属性为 True 时用原来的文字颜色, '为 False 时,使用“无效文本”的颜色作为按钮文本的颜色。 If .Enabled Then .ForeColor = mForeColor Else .ForeColor = vbGrayText End If Dim lpRect As RECT '为方便大家阅读,把定义变量的代码放在这里。 With lpRect If imgindex <> BS_Press Then '因为按钮的边框为 2 像素,焦点框离按钮边框 3 像素。 '所以绘制文字的区域要离按钮边框 5 像素,才不会搞在一起:) .Top = 5 .Bottom = lngHeight - 5 .Left = 5 .Right = lngWidth - 5 Else '当按钮为按下状态时,文字向右、向下各移 2 像素,动感一点。 .Top = 7 .Bottom = lngHeight - 3 .Left = 7 .Right = lngWidth - 3 End If End With '---------------DrawText--------------- 'hDC:要绘制文本的场景 'lpStr:要绘制的文本 'nCount:绘制的文本的长度,如果为 -1 ,则绘制 lpStr 全部内部 'lpRect:绘制文本的位置 'wFormat:绘制文本的样式(DT_CENTER 水平居中,DT_VCENTER 垂直居中,DT_SINGLELINE 单行) Dim ppk As String ppk = getmystring(mstrCaption) DrawText .hDC, ppk, -1, lpRect, DT_CENTER Or DT_VCENTER Or DT_SINGLELINE End If '********************************************************************************** '按钮的图片和文本已经绘制好了,现在要画焦点框了。这里用了 API 函数 DrawFocusRect '先声明一下。 '********************************************************************************** ' If mblnFocus Then ' ' Dim lpFocus As GIVEFOCUS ' ' With lpFocus ' .Bottom = lngHeight - 3 ' .Left = 3 ' .Right = lngWidth - 3 ' .Top = 3 ' End With ' DrawFocusRect .hDC, lpFocus ' End If End With End Sub
Private Sub CMCB1_Click(Index As Integer) Dim CB As Object For Each CB In CMCB1 If CB.Index = Index Then CB.clickon = True Else CB.clickon = False End If Next '对按钮单击事件进行处理 MsgBox "单击了" & Index + 1 & "号按钮" End Sub