Ответить

Хм, странно что мое мыло исчезло из профиля.

cyraxua@hotmail.com

Ответить

Эх вы люди, что-ж вы только для себя, нужно что-б для всех, и для тех у кого нет мыла

Вот специально для них-то и кидаю это чудо... Разбираться вот только самим придется, скажу только что это все в модуле должно быть...

' ----------------------------------------------------------------

Option Explicit

Private Declare Function MapVirtualKey Lib "user32" Alias "MapVirtualKeyA" (ByVal wCode As Long, ByVal wMapType As Long) As Long

Private Declare Function GetKeyNameText Lib "user32" Alias "GetKeyNameTextA" (ByVal lParam As Long, ByVal lpBuffer As String, ByVal nSize As Long) As Long

Private Declare Function RegisterHotKey Lib "user32" (ByVal hWnd As Long, ByVal id As Long, ByVal fsModifiers As Long, ByVal VK As Long) As Long

Private Declare Function UnregisterHotKey Lib "user32" (ByVal hWnd As Long, ByVal id As Long) As Long

Private Declare Function GlobalAddAtom Lib "kernel32" Alias "GlobalAddAtomA" (ByVal lpString As String) As Integer

Private Declare Function GlobalDeleteAtom Lib "kernel32" (ByVal nAtom As Integer) As Integer

Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Private Const GWL_WNDPROC As Long = -4

Public Enum gbHotKeyModifiers

MOD_ALT = &H1

MOD_CONTROL = &H2

MOD_SHIFT = &H4

MOD_WIN = &H8

End Enum

Public Type gbHWHotKeys

VK As Integer

Shift As gbHotKeyModifiers

id As Long

End Type

Private Const WM_HOTKEY = &H312

Public Const cNone As String = "???"

Private OldWndProc2 As Long, hi As Long

Private Function HotKeyWindowProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

On Error Resume Next

HotKeyWindowProc = CallWindowProc(OldWndProc2, hWnd, uMsg, wParam, lParam)

If OldWndProc2 = &H0 Then Exit Function

If uMsg = WM_HOTKEY Then

If IsFrmLoaded("frmOptions") Then Exit Function

For hi = 0 To UBound(HotKeys)

If LoWord(wParam) = HotKeys(hi).id Then

If HiWord(lParam) = HotKeys(hi).VK And LoWord(lParam) = HotKeys(hi).Shift Then

Select Case hi

Case Is = 0: Call frmOptions.Show

Case Is = 1: frmStatistic.Visible = False: DoEvents: Call VBRasHangUp

Case Else

If hRasConn And dllSet.OneKeyDH Then

If frmStatistic.Label2(3).Caption = ConList(hi - 2) Then _

frmStatistic.Visible = False: _

DoEvents: _

Call VBRasHangUp: _

Exit Function

End If

Call frmStatistic.StartAnim(0)

Call VBRasDial(ConList(hi - 2))

frmStatistic.Label2(0).Caption = 1&

frmStatistic.Visible = dllSet.IsWinVis: Call frmStatistic.SetMeOnTop

End Select

Exit For

End If

End If

Next

End If

End Function

'??????????? ??????? ???????

Public Function RegHotKey(hWnd As Long, ByVal Modifiers As gbHotKeyModifiers, ByVal VirtKey As Integer) As Long

If OldWndProc2 = 0 Then OldWndProc2 = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf HotKeyWindowProc)

RegHotKey = GlobalAddAtom(CStr(Rnd)) '????? ID, ?????????? ?? ????????

If RegisterHotKey(hWnd, RegHotKey, Modifiers, VirtKey) = 0 Then RegHotKey = 0

End Function

'???????? ??????? ???????

Public Function UnRegHotKey(hWnd As Long, ByVal id As Integer, Optional UnSubCass As Boolean = False) As Boolean

If UnSubCass Then Call SetWindowLong(hWnd, GWL_WNDPROC, OldWndProc2): OldWndProc2 = 0

If UnregisterHotKey(hWnd, id) = 0 Then Exit Function '???????

Call GlobalDeleteAtom(id) '???????????

UnRegHotKey = True '???????

End Function

Public Function GetHotKeyText(ByVal VK As Integer, Shift As Integer) As String

Dim KeyName As String * 256

If Shift Then GetHotKeyText = Choose(Shift, "Shift", "Ctrl", "Shift + Ctrl", "Alt", "Shift + Alt", "Ctrl + Alt", "Shift + Ctrl + Alt") & " + "

If VK = 17 Or VK = 16 Or VK = 18 Then Exit Function

GetHotKeyText = GetHotKeyText & Left$(KeyName, GetKeyNameText(ByVal MapVirtualKey(VK, 0) * &H10000, KeyName, 255))

If Len(GetHotKeyText) = 0 Then GetHotKeyText = cNone

End Function

Public Function ReModif(ByVal inModif As Long) As Integer

On Error Resume Next

If inModif Then ReModif = Choose(inModif, &H4, &H2, &H6, &H1, &H5, &H3, &H7, &H8, &HC, &HA, &HE, &H9, &HD, &HB, &HF)

End Function

Private Function LoWord(DWord As Long) As Integer

LoWord = IIf(DWord And &H8000&, DWord Or &HFFFF0000, DWord And &HFFFF&)

End Function

Private Function HiWord(DWord As Long) As Integer

HiWord = (DWord And &HFFFF0000) \ &H10000

End Function

' ----------------------------------------------------------------

Конец мессаги

Ответить

Нда.... не красиво с комментами получилось, некрасиво (( Ну да ладно, раздеретесь

Ответить

Спасибо. Чёт многовато кода, а?

Тут много раз мелькала ф-я GetAsyncKeyState.

Мож через неё можно как?

Ответить

Да неет, я просто прямо из проги кусок кода взял. Так-то это все очень красиво получается! Только все это чудо в отдельный модуль поместить, и вызывать себе нужные для работы функции.

А вот на счет той функуии, это совсем не то! Это самый не разумный способ подражания горячим клавишам. Это даже на отдельный способ не тянет

Но если так хочется пойти другим путем, можно еще использовать SetWindowsHookEx, используется в клавиатурных шпионах, но этот способ связан с определенными трудностями

Ответить