100分求解,以下VB代码有何问题 (100分)

  • 主题发起人 主题发起人 pnljh
  • 开始时间 开始时间
P

pnljh

Unregistered / Unconfirmed
GUEST, unregistred user!
以下是一个XP按钮的控件代码,但不能响应快捷键,有个奇怪的问题
请看最后的SetHotKey过程。
为什么userControl.AccessKeys = "s"不行,但在控件的属性窗口中设置
AccessKeys的值为"s"却行。
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINT_API) As Long
Private Declare Function ScreenToClient Lib "user32" (ByVal hWnd As Long, lpPoint As POINT_API) As Long
Public Enum State_b
Normal_ = 0
Default_ = 1
End Enum
Dim m_State As State_b
Dim m_Font As Font
Const m_Def_State = State_b.Normal_
Private Type POINT_API
X As Long
Y As Long
End Type
Dim s As Integer
Event Click()
Event KeyDown(KeyCode As Integer, Shift As Integer)
Event KeyPress(KeyAscii As Integer)
Event KeyUp(KeyCode As Integer, Shift As Integer)
Event MouseOut()
Event MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Event MouseMove(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)
Private Sub lbl_Change()
UserControl_Resize
End Sub
Private Sub lbl_Click()
UserControl_Click
End Sub
Private Sub lbl_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Call UserControl_MouseDown(Button, Shift, X, Y)
End Sub
Private Sub lbl_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Call UserControl_MouseMove(Button, Shift, lbl.Left, lbl.Top)
End Sub
Private Sub lbl_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Call UserControl_MouseUp(Button, Shift, X, Y)
End Sub
Private Sub Timer1_Timer()
Dim pnt As POINT_API
GetCursorPos pnt
ScreenToClient UserControl.hWnd, pnt
If pnt.X < UserControl.ScaleLeft Or _
pnt.Y < UserControl.ScaleTop Or _
pnt.X > (UserControl.ScaleLeft + UserControl.ScaleWidth) Or _
pnt.Y > (UserControl.ScaleTop + UserControl.ScaleHeight) then

Timer1.Enabled = False
RaiseEvent MouseOut
statevalue_pic
End If
End Sub
Private Sub UserControl_AccessKeyPress(KeyAscii As Integer)
RaiseEvent Click
'RaiseEvent KeyPress(KeyAscii)
'MsgBox "hot"
'Call UserControl_Click
End Sub
Private Sub UserControl_Click()
RaiseEvent Click

End Sub
Private Sub UserControl_GotFocus()
make_xpbutton 4
End Sub
Private Sub UserControl_Initialize()
statevalue_pic
End Sub
Private Sub UserControl_InitProperties()
state_value = m_Def_State
Enabled = True
Caption = Ambient.DisplayName
Set Font = UserControl.Ambient.Font
End Sub
Private Sub UserControl_KeyDown(KeyCode As Integer, Shift As Integer)
RaiseEvent KeyDown(KeyCode, Shift)
If Shift = 4 And Chr(KeyCode) = "y" then
UserControl_Click

End Sub
Private Sub UserControl_KeyPress(KeyAscii As Integer)
RaiseEvent KeyPress(KeyAscii)
If KeyAscii = vbKeyEscape Or KeyAscii = vbKeyReturn then
'所有XPButton按钮都能接受此按键
'与按下热键相似
UserControl_Click 'Default / Cancel
Exit Sub
End If
'按下热键
If InStr(UCase(UserControl.AccessKeys), UCase(Chr(KeyAscii))) > 0 then

UserControl_Click

End If

End Sub
Private Sub UserControl_KeyUp(KeyCode As Integer, Shift As Integer)
RaiseEvent KeyUp(KeyCode, Shift)
End Sub
Private Sub UserControl_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
RaiseEvent MouseDown(Button, Shift, X, Y)
make_xpbutton 1
End Sub
Private Sub UserControl_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Timer1.Enabled = True
If X >= 0 And Y >= 0 And _
X <= UserControl.ScaleWidth And Y <= UserControl.ScaleHeight then
RaiseEvent MouseMove(Button, Shift, X, Y)
If Button = vbLeftButton then
make_xpbutton 1
else
: make_xpbutton 3
End If
End If
End Sub
Private Sub UserControl_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
RaiseEvent MouseUp(Button, Shift, X, Y)
statevalue_pic
End Sub
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
state_value = PropBag.ReadProperty("State", m_Def_State)
Enabled = PropBag.ReadProperty("Enabled", True)
Caption = PropBag.ReadProperty("Caption", Ambient.DisplayName)
Set Font = PropBag.ReadProperty("Font", UserControl.Ambient.Font)
End Sub
Public Property Get Enabled() As Boolean
Enabled = UserControl.Enabled
End Property
Public Property Let Enabled(ByVal New_Enabled As Boolean)
UserControl.Enabled() = New_Enabled
PropertyChanged "Enabled"
statevalue_pic
If Enabled = True then
lbl.ForeColor = vbBlack else
lbl.ForeColor = RGB(161, 161, 146)
End Property
Private Sub UserControl_Resize()
statevalue_pic
lbl.Top = (UserControl.ScaleHeight - lbl.Height) / 2
lbl.Left = (UserControl.ScaleWidth - lbl.Width) / 2
End Sub
Private Sub UserControl_Show()
statevalue_pic
End Sub
Private Sub UserControl_Terminate()
statevalue_pic
End Sub
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
Call PropBag.WriteProperty("State", m_State, m_Def_State)
Call PropBag.WriteProperty("Enabled", UserControl.Enabled, True)
Call PropBag.WriteProperty("Caption", lbl.Caption, Ambient.DisplayName)
Call PropBag.WriteProperty("Font", m_Font, UserControl.Ambient.Font)
End Sub
Public Property Get State() As State_b
State = m_State
End Property
Public Property Let State(ByVal vNewValue As State_b)
m_State = vNewValue
PropertyChanged "State"
statevalue_pic
End Property
Private Sub statevalue_pic()
If State = Default_ then
s = 4
else
If State = Normal_ then
s = 0
End If

If UserControl.Enabled = True then
make_xpbutton s
else
: make_xpbutton 2
End If
End Sub
Private Sub make_xpbutton(z As Integer)
UserControl.ScaleMode = 3
Dim brx, bry, bw, bh As Integer
brx = UserControl.ScaleWidth - 3
bry = UserControl.ScaleHeight - 3
bw = UserControl.ScaleWidth - 6
bh = UserControl.ScaleHeight - 6

UserControl.PaintPicture pc.GraphicCell(z), 0, 0, 3, 3, 0, 0, 3, 3
UserControl.PaintPicture pc.GraphicCell(z), brx, 0, 3, 3, 15, 0, 3, 3
UserControl.PaintPicture pc.GraphicCell(z), brx, bry, 3, 3, 15, 18, 3, 3
UserControl.PaintPicture pc.GraphicCell(z), 0, bry, 3, 3, 0, 18, 3, 3
UserControl.PaintPicture pc.GraphicCell(z), 3, 0, bw, 3, 3, 0, 12, 3
UserControl.PaintPicture pc.GraphicCell(z), brx, 3, 3, bh, 15, 3, 3, 15
UserControl.PaintPicture pc.GraphicCell(z), 0, 3, 3, bh, 0, 3, 3, 15
UserControl.PaintPicture pc.GraphicCell(z), 3, bry, bw, 3, 3, 18, 12, 3
UserControl.PaintPicture pc.GraphicCell(z), 3, 3, bw, bh, 3, 3, 12, 15
End Sub
Public Property Get Caption() As String
Caption = lbl.Caption
End Property
Public Property Let Caption(ByVal vNewCaption As String)
lbl.Caption() = vNewCaption

PropertyChanged "Caption"
End Property
Public Property Get Font() As Font
Set Font = m_Font
End Property
Public Property Set Font(ByVal vNewFont As Font)
Set m_Font = vNewFont
Set UserControl.Font = vNewFont
Set lbl.Font = m_Font
Call UserControl_Resize
PropertyChanged "Font"
End Property
Public Sub SetHotKey()
Dim s As String
If InStr(1, lbl.Caption, "&amp;") > 0 then
s = Mid(lbl.Caption, InStr(1, lbl.Caption, "&amp;") + 1, 1)
UserControl.AccessKeys = s
else
UserControl.AccessKeys = ""
End If
' UserControl.AccessKeys = "d"
End Sub
 
UserControl.AccessKeys
要求的是byte还是string?
如果是String,应该是可以的。如果是byte,你用变量S,是不行的

呵呵,我猜的。。
 
UserControl.AccessKeys
是String型
 
虽然没有找到问题所在,但是已找到解决的办法,100分便宜你了
 
后退
顶部