Ответить

Нажатия на клавиши обрабатываются следующим образом:

Private Sub Object_MouseDown() - когда кнопка нажата, но ещё не отпущена

Private Sub Object_MouseUp() - когда кнопка была нажата и отпущена

установить, какая кнопка нажата, можно следующим образом:

If Button = vbRightButton Then

...

End If

или соответственно

If Button = vbLeftButton Then

...

End If

я, например, сделал так (типа стиль оффис ХП ):

разместить на форме два одинаковых по форме лейбла (лэйбл1 - светло-жёлтый, например, &H00EFFFFF&, лэйбл2 - светло-серый, например, &H00C0C0C0&) и воткнуть следующий код:

Private Sub Text1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)

Label1.Visible = False

Label2.Visible = False

End Sub

Private Sub Text1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)

If Button = vbRightButton Then `определяем, какая менюха была нажата

mouseX = X

mouseY = Y

Label1.Visible = True

Label2.Visible = True

Label1.Top = mouseY + 50

Label1.Left = mouseX + 50

Label2.Top = mouseY

Label2.Left = mouseX

End If

End Sub

будет что-то вроде менюшки с тенью

а вот насчёт текстбокса мне самому интересно...

Ответить

to Netracer:

Вопрос был в другом!!!!!!!

НЕ в том чтобы понажатию на textbox что то происходило, а к примеру моя программа работает а я нажал клавишу в Explorer'e и чпри этом программа обрабатывает какие-то операторы!!!!!!

Ответить

Нужно ставить хук на мышь. Только, наверно, на VB это не решить. Хотя если долго мучиться...

Может у кого есть работающий пример установки хука? У меня ничего не вышло.

Ответить

Ответить

Ответить

2 boevik

Спасибки, я это уже читал. Но не понимаю, зачем  мучиться, если можно просто

Sub TextBox_MouseDown(X as Integer,Y as Integer, Button as Long) 

If Button=vbRightButton then..............

Кстати о массиве - мне и самому в голову приходило, но был облом пробовать, а теперь поздно - VB6 кончился

Ответить

2Село

If Button=vbRightButton then Exit Sub

контекстное меню появляется.

Как тебе удалось избавится от него при помощи TextBox_MouseDown?

Ответить

По-моему отлавливать клики надо так же как и нажатия клавишь, с помощью API. Типа VK_LMOUSEBUTTON или как там. В общем, найду у себя пример - ссылку дам.

Ответить

to USA^

Да мне тут уже присылали какие-то hook'и но я ничего не понял !!!Вот оно:

Option Explicit
Type POINTAPI
        x As Long
        y As Long
End Type

Type TMSG
    hwnd As Long
    message As Long
    wParam As Long
    lParam As Long
    time As Long
    pt As POINTAPI
End Type

Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpDest As Any, lpSource As Any, ByVal cBytes As Long)
Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public hJournalHook As Long, hAppHook As Long
Public SHptr As Long
Public Const WM_CANCELJOURNAL = &H4B

Public Function JournalRecordProc(ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
  If nCode < 0 Then
     JournalRecordProc = CallNextHookEx(hJournalHook, nCode, wParam, lParam)
     Exit Function
  End If
  ResolvePointer(SHptr).FireEvent lParam
  Call CallNextHookEx(hJournalHook, nCode, wParam, lParam)
End Function

Public Function AppHookProc(ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
   If nCode < 0 Then
      AppHookProc = CallNextHookEx(hAppHook, nCode, wParam, lParam)
      Exit Function
   End If
   Dim msg As TMSG
   CopyMemory msg, ByVal lParam, Len(msg)
   Select Case msg.message
       Case WM_CANCELJOURNAL
            If wParam = 1 Then ResolvePointer(SHptr).FireEvent WM_CANCELJOURNAL
   End Select
   Call CallNextHookEx(hAppHook, nCode, wParam, ByVal lParam)
End Function

Private Function ResolvePointer(ByVal lpObj& As cSystemHook
  Dim oSH As cSystemHook
  CopyMemory oSH, lpObj, 4&
  Set ResolvePointer = oSH
  CopyMemory oSH, 0&, 4&
End Function

Это было в простом модуле а вот ниже то что было в Классовом модуле:

Public Event MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
Public Event MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
Public Event MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
Public Event KeyDown(KeyCode As Integer, Shift As Integer)
Public Event KeyUp(KeyCode As Integer, Shift As Integer)
Public Event SystemKeyDown(KeyCode As Integer)
Public Event SystemKeyUp(KeyCode As Integer)

Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Private Declare Function GetAsyncKeyState% Lib "user32" (ByVal vKey As Long)

Private Const WM_KEYDOWN = &H100
Private Const WM_KEYUP = &H101
Private Const WM_MOUSEMOVE = &H200
Private Const WM_LBUTTONDOWN = &H201
Private Const WM_LBUTTONUP = &H202
Private Const WM_LBUTTONDBLCLK = &H203
Private Const WM_RBUTTONDOWN = &H204
Private Const WM_RBUTTONUP = &H205
Private Const WM_RBUTTONDBLCLK = &H206
Private Const WM_MBUTTONDOWN = &H207
Private Const WM_MBUTTONUP = &H208
Private Const WM_MBUTTONDBLCLK = &H209
Private Const WM_MOUSEWHEEL = &H20A
Private Const WM_SYSTEMKEYDOWN = &H104
Private Const WM_SYSTEMKEYUP = &H105

Private Const WH_JOURNALRECORD = 0
Private Const WH_GETMESSAGE = 3

Private Type EVENTMSG
     wMsg As Long
     lParamLow As Long
     lParamHigh As Long
     msgTime As Long
     hWndMsg As Long
End Type

Dim EMSG As EVENTMSG

Public Function SetHook() As Boolean
   If hJournalHook = 0 Then hJournalHook = SetWindowsHookEx(WH_JOURNALRECORD, AddressOf JournalRecordProc, App.hInstance, 0)
   If hAppHook = 0 Then hAppHook = SetWindowsHookEx(WH_GETMESSAGE, AddressOf AppHookProc, App.hInstance, App.ThreadID)
   SetHook = True
End Function

Public Sub RemoveHook()
   UnhookWindowsHookEx hAppHook
   UnhookWindowsHookEx hJournalHook
End Sub

Private Sub Class_Initialize()
  SHptr = ObjPtr(Me)
End Sub

Private Sub Class_Terminate()
  If hJournalHook Or hAppHook Then RemoveHook
End Sub

Friend Function FireEvent(ByVal lParam As Long)
  Dim i%, j%, k%
  Dim s As String
  If lParam = WM_CANCELJOURNAL Then
     hJournalHook = 0
     SetHook
     Exit Function
  End If
 
  CopyMemory EMSG, ByVal lParam, Len(EMSG)
  Select Case EMSG.wMsg
    Case WM_KEYDOWN
         j = 0
         If GetAsyncKeyState(vbKeyShift) Then j = (j Or 1)        'fixed by JJ
         If GetAsyncKeyState(vbKeyControl) Then j = (j Or 2)      'fixed by JJ
         If GetAsyncKeyState(vbKeyMenu) Then j = (j Or 4)         'fixed by JJ
         s = Hex(EMSG.lParamLow)
         k = (EMSG.lParamLow And &HFF)
         RaiseEvent KeyDown(k, j)
         s = Left$(s, 2) & Right$("00" & Hex(k), 2)               'fixed by JJ
         EMSG.lParamLow = CLng("&h" & s)
         CopyMemory ByVal lParam, EMSG, Len(EMSG)
    Case WM_KEYUP
         j = 0                                                    'fixed by JJ
         If GetAsyncKeyState(vbKeyShift) Th

Ответить

2 boevik

убирать мне так не удавалось, а заменить своей popupкой(например на другом языке) несложно...

Кстати, вопрос!  если в проге задействован редкий язык (польский например), то после установки на другую машину, где нет необходимых шрифтов, она будет писать иероглифами?

Ответить