Активная прога

[юрка]

Подскажи пожалуйста. Как сделать так чтобы
при нажатие на клавишу F1 вылезала не виндовская
справка а мною заложенная в код задание.
Чтобы программка как бы всегда была активной.
Не зависимо от запущенного приложени, программы
при нажатие на клавишу F1, F2 и т.д. работали
мною заложенные действия, а не той или иной
программы, приложения.

[Dzhon]

А готов-ли Ты к ЭТОМУ, Юрий
Ведь для этого нужно перехватить системное сообщение Win, (мягко говоря) заблокировать его и послать свое. Это о-о-очень коротко. Более развернуто можно узнать при изучении API.

[юрка]

Ну пожаааааааааалуйста. Мне очень хочеться узнать. Опишите пожалуйста подробно.

[Dzhon]

Гуру!!! Просьба к Вам!
Я сам еще не разобрался в этих наворотах..
Юрий, я не даром спросил про готовность, просто чтобы что-то понять нужно подготовить базовые знания, для начала API, а далее познакомиться с сабкласингом(вроде так), иначе невозможно объяснить будет и придется опять вернуться к началу.

[юрка]

Эх... Ну помогите пожалуйсат. Люди лобрые. В крайнем случае всегда же можно просто код в нужные места кода встаить и будет прога. И разбираться потом сидеть, как да что. Просто есть желание но мало знаний.

[hCORe]

Сабклассинг не пойдет. Нужен хук, причем глобальный. Полностью на VB этого сделать нельзя, т.к. требуется Native DLL. Native DLL создать можно (через пень-колоду), но работать, увы, не будет. См. тему про расширение системного трея

[ANDLL]

Здается мне, что функция RegisterHotKey именно для этого и создана...

Код: Выделить всё

Private Const MOD_ALT = &H1
Private Const MOD_CONTROL = &H2
Private Const MOD_SHIFT = &H4
Private Const PM_REMOVE = &H1
Private Const WM_HOTKEY = &H312
Private Type POINTAPI
    x As Long
    y As Long
End Type
Private Type Msg
    hWnd As Long
    Message As Long
    wParam As Long
    lParam As Long
    time As Long
    pt As POINTAPI
End Type
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 PeekMessage Lib "user32" Alias "PeekMessageA" (lpMsg As Msg, ByVal hWnd As Long, ByVal wMsgFilterMin As Long, ByVal wMsgFilterMax As Long, ByVal wRemoveMsg As Long) As Long
Private Declare Function WaitMessage Lib "user32" () As Long
Private bCancel As Boolean
Private Sub ProcessMessages()
    Dim Message As Msg
    'loop until bCancel is set to True
    Do While Not bCancel
        'wait for a message
        WaitMessage
        'check if it's a HOTKEY-message
        If PeekMessage(Message, Me.hWnd, WM_HOTKEY, WM_HOTKEY, PM_REMOVE) Then
            'minimize the form
            WindowState = vbMinimized
        End If
        'let the operating system process other events
        DoEvents
    Loop
End Sub
Private Sub Form_Load()
    'KPD-Team 2000
    'URL: http://www.allapi.net/
    'E-Mail: KPDTeam@Allapi.net
    Dim ret As Long
    bCancel = False
    'register the Ctrl-F hotkey
    ret = RegisterHotKey(Me.hWnd, &HBFFF&, 0, vbKeyF1)
    'show some information
    Me.AutoRedraw = True
    Me.Print "Press F1 to minimize this form"
    'show the form and
    Show
    'process the Hotkey messages
    ProcessMessages
End Sub
Private Sub Form_Unload(Cancel As Integer)
    bCancel = True
    'unregister hotkey
    Call UnregisterHotKey(Me.hWnd, &HBFFF&)
End Sub


[юрка]

Уважаемые программисты Я посмотрел код. Кое чего даже поня, хотя
почти ни чего. Помогите пожалуйста разобраться. При нажатие на
клавишу F1 минимизируется окно, ну то есть сворачиваеться. А как
сделать что при F1 одна операция при F2 другая и т.д. и т.п.
Что и как нужно в коде поменять. А то так трудно разобраться
особенно если про api кроме того что это хорошая штука и много
чего сделать можно с помощью ней, боьше не чего не знаешь. А прогу
самому очень хочеться сделать, да и надо. Извините конечно если
я вас отрываю от более важных дел.
С уважением,
Юрка

[hCORe]

Здается мне, что функция RegisterHotKey именно для этого и создана...

Хммм... RegisterHotKey сработал нормально. Но зачем нам, спрашивается, создавать собственный цикл обработки сообщений? Сабклассинг здесь более удобен, да и более правилен.

Тем более, где гарантия, что какая-нибудь злобная прога не "повесила" на F1 свое действие? RegisterHotKey тогда храбро потерпит поражение. {Пример: создаем на рабочем столе ярлык на любой файл; ставим ему в "Быстрый вызов" F1 и запускаем нашу бесценную прогу. Что получилось? Правильно, шиш с маслом!}

[hCORe]

А как сделать что при F1 одна операция при F2 другая и т.д. и т.п.

Зарегистрировать несколько "горячих клавиш" - столько, сколько нужно. И обрабатывать

[hCORe]

Совсем уж тупой пример (доработка):

Код: Выделить всё

Option Explicit

Private Const MOD_ALT = &H1
Private Const MOD_CONTROL = &H2
Private Const MOD_SHIFT = &H4
Private Const PM_REMOVE = &H1
Private Const WM_HOTKEY = &H312
Private Type POINTAPI
    x As Long
    y As Long
End Type
Private Type Msg
    hWnd As Long
    Message As Long
    wParam As Long
    lParam As Long
    time As Long
    pt As POINTAPI
End Type
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 PeekMessage Lib "user32" Alias "PeekMessageA" (lpMsg As Msg, ByVal hWnd As Long, ByVal wMsgFilterMin As Long, ByVal wMsgFilterMax As Long, ByVal wRemoveMsg As Long) As Long
Private Declare Function WaitMessage Lib "user32" () As Long
Private bCancel As Boolean
Private Sub ProcessMessages()
    Dim Message As Msg
    'плохо, конечно, но можно работать и так.
    'система будет "висеть" и вредничать...
    Do While Not bCancel
        'ждем сообщения
        WaitMessage
        'вдруг то самое?
        If PeekMessage(Message, Me.hWnd, WM_HOTKEY, WM_HOTKEY, PM_REMOVE) Then
            'в wParam хранится идентификатор нашей "горячей клавиши"
            If Message.wParam = &HBFFF& Then
                Print "Вызов F1"
            ElseIf Message.wParam = &HAFFF& Then
                Print "Вызов F2"
            ElseIf Message.wParam = &H9FFF& Then
                Print "Вызов F3"
            End If
            If CurrentY > Height - TextHeight("Test") Then Cls
        End If
        'дадим же системе возможность отдышаться!
        DoEvents
    Loop
End Sub
Private Sub Form_Load()
    'KPD-Team 2000
    'URL: http://www.allapi.net/
    'E-Mail: KPDTeam@Allapi.net
    'доработка: hCORe [hCORe <at> mail.ru]
    Dim ret As Long
    bCancel = False
   
    'регистрируем горячие клавиши
    'второй параметр может находиться в диапазоне
    'от &H0& до &HBFFF&. Это числа, 32-битные, целые (4 байта)
    'в шестнадцатиричном представлении - т.е.
    'от 0 до 49151
    ret = RegisterHotKey(Me.hWnd, &HBFFF&, 0, vbKeyF1)
    ret = RegisterHotKey(Me.hWnd, &HAFFF&, 0, vbKeyF2)
    ret = RegisterHotKey(Me.hWnd, &H9FFF&, 0, vbKeyF3)
    'покажем информацию
    AutoRedraw = True
    Print "Нажмите F1, F2 или F3 и посмотрите, что произойдет"
    Print "Завершать программу можно только нажав на КРЕСТИК в углу окна!"
    Print "Иначе горячие клавиши нельзя будет больше зарегистрировать."
    Print "Окно ""умрет"", а ассоциация клавиши с ним останется."
    Print "А ""убить"" ее можно лишь зная hWnd ""безвременно почившего"" окна."
    Print "А мы его не знаем."
    Print
    Print "Убедительная просьба: переделать этот пример под нормальный сабклассинг."
    Print "Хотя можно юзать и так..."
    'показать форму
    Show
    'обработать сообщения
    ProcessMessages
End Sub
Private Sub Form_Unload(Cancel As Integer)
    bCancel = True
    'разрегистрировать все "горячие клавиши"
    Call UnregisterHotKey(Me.hWnd, &HBFFF&)
    Call UnregisterHotKey(Me.hWnd, &HAFFF&)
    Call UnregisterHotKey(Me.hWnd, &H9FFF&)
End Sub

[юрка]

А можете пожалуйста написать как. Как их регить и как с ними потом обращаться.

[kirrun]

А еще wParam можно делать 1,2,3... Чтоб уж совсем удобно было... Например для ф1 wParam = 1, для ф 2 = 2 и тп...

[юрка]

Пойду усиленно разбираться
А в строке
ret = RegisterHotKey(Me.hWnd, &H9FFF&, 0, vbKeyF3)

написано &H9FFF&
Это как понять?
буду я например регить клавишу F8 для неё эта штука особая будет или это нашару пишеться?

[kirrun]

Это и есть тот самый wParam...

Я, лично, туда 1 писал =)

[юрка]

Спасибо, правда я непонял %)

[hCORe]

Более "чистый" пример с сабклассингом (субклассированием):

Код: Выделить всё

'код практически полностью написан hCORe {hCORe <at> mail.ru}
'дисклеймер: "Ich liebe Perfokarten!"

'следующий код надо поместить в форму
'с любым, вообще-то, именем.
'но в модуле используется название 'Form1';
'можно, конечно, поменять.

Option Explicit

'субклассировать форму али нет?
Private bSubclass As Boolean
'проблемы?
Private bFailed As Boolean

Private Sub Form_Load()
    Dim lRet As Long
   
    'настройки формы
    Caption = "Горячие клавиши, пример с сабклассингом (субклассированием)"
    AutoRedraw = True
    Width = 6330
    Height = 4785
   
    'инициализация - для приличия
    'можно было бы задать только bSubclass = True
    'т.к. VB инициализирует Boolean'ы значениями False,
    'а все числовые виды переменных - нулями
    bSubclass = True
    bFailed = False
    lRet = 0
   
    'регистрируем горячие клавиши
    'второй параметр может находиться в диапазоне
    'от &H0& до &HBFFF&. Это числа, 32-битные, целые (4 байта)
    'в шестнадцатиричном представлении - т.е.
    'от 0 до 49151
    lRet = RegisterHotKey(Me.hWnd, &HBFFF&, 0, vbKeyF1)
    bFailed = (lRet = 0)
    lRet = RegisterHotKey(Me.hWnd, &HAFFF&, 0, vbKeyF2)
    bFailed = (lRet = 0)
    lRet = RegisterHotKey(Me.hWnd, &H9FFF&, 0, vbKeyF3)
    bFailed = (lRet = 0)
       
    'если хоть раз провалились, то игра не стоит свеч
    If bFailed Then
        Print "Извините, у нас временные проблемы..."
        bSubclass = False
    End If
   
    If bSubclass Then
        'вывод инфы
        Print "Нажмите F1, F2 или F3 и посмотрите, что произойдет"
        Print "Завершать программу можно только нажав на КРЕСТИК в углу окна!"
        Print "Иначе горячие клавиши нельзя будет больше зарегистрировать."
        Print "Окно ""умрет"", а ассоциация клавиши с ним останется."
        Print "А ""убить"" ее можно лишь зная hWnd ""безвременно почившего"" окна."
        Print "А мы его не знаем."
       
        'субклассируем форму
        lOrigin = SetWindowLong(Me.hWnd, GWL_WNDPROC, AddressOf pHcSubclass)
    End If
   
    Print
End Sub
Private Sub Form_Unload(Cancel As Integer)
    'снимаем сабклассинг
    Call pHcUnsubclass(Me.hWnd)
    'убиваем "горячие клавиши"
    Call UnregisterHotKey(Me.hWnd, &HBFFF&)
    Call UnregisterHotKey(Me.hWnd, &HAFFF&)
    Call UnregisterHotKey(Me.hWnd, &H9FFF&)
End Sub

'дальнейший код надо поместить
'в стандартный модуль с любым именем

'любимая опция
Option Explicit

Public Const GWL_WNDPROC = (-4)
Public Const WM_HOTKEY = &H312
Public Const MOD_ALT = &H1
Public Const MOD_CONTROL = &H2
Public Const MOD_SHIFT = &H4

Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public 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
Public Declare Function RegisterHotKey Lib "user32" (ByVal hWnd As Long, ByVal id As Long, ByVal fsModifiers As Long, ByVal vk As Long) As Long
Public Declare Function UnregisterHotKey Lib "user32" (ByVal hWnd As Long, ByVal id As Long) As Long

'оригинальная оконная процедура
Public lOrigin As Long

'знаю, можно сделать лучше, но уж как есть...
Public Function pHcSubclass(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    If hWnd = 0 Then Exit Function
   
    If uMsg = WM_HOTKEY Then
        '"горячая клавиша"
        If wParam = &HBFFF& Then
            pHcPrint "Вызов F1"
        ElseIf wParam = &HAFFF& Then
            pHcPrint "Вызов F2"
        ElseIf wParam = &H9FFF& Then
            pHcPrint "Вызов F3"
        End If
        pHcSubclass = 0
    Else
        'все остальные события
        pHcSubclass = CallWindowProc(lOrigin, hWnd, uMsg, wParam, lParam)
    End If
   
End Function

Public Function pHcUnsubclass(ByVal hWnd As Long)
    SetWindowLong hWnd, GWL_WNDPROC, lOrigin
End Function

Public Sub pHcPrint(strPrint As String)
    'можно изменить, если надо, имя формы с Form1 на реальное
    'название формы, "ловящей" нажатия
    If Form1.CurrentY > Form1.Height - Form1.TextHeight("Test") Then Form1.Cls
    Form1.Print strPrint
End Sub

[юрка]

А теперь форма почему - то не скрываеться. Свойства формы визибле не работает. Ставлю фальш, а форму всёравно видать.
Спасибо всем что помогаете.

[kirrun]

Код хороший оч.. но только у меня что-то не получилось поставить хоткеем "<", ">", "?" (они же "Б", "Ю", ".")... Как такое мона сделать?

[tyomitch]

Код хороший оч.. но только у меня что-то не получилось поставить хоткеем "<", ">", "?" (они же "Б", "Ю", ".")... Как такое мона сделать?

Заюзать VK_OEM_COMMA, VK_OEM_PERIOD и VK_OEM_2.

[kirrun]

ага... Пасиб.. А как насчет х, ъ, ж, э?

[юрка]

Форма почему-то не скрываеться. Свойства формы визибле не работает. Ставлю фальш, а форму всёравно видать. Помогите пожалуйста. Как сделать чтоб при этом форму не видно было а клавиши все по прежнему нормально функционировали заложенными мною функциями.

[kirrun]

Все работает.

[tyomitch]

ага... Пасиб.. А как насчет х, ъ, ж, э?

Уже нашёл? Если нет, то иди на http://msdn.microsoft.com/library/en-us ... ycodes.asp

[kirrun]

tyomitch

Вот пасиба! Скоро зарелижу первую версию проги, котторая буквы на клаве в афлавитном порядке расставляет... =)

[kirrun]

[оффтоп по теме]Вот моя программка, которая использует горячие клавиши. Милости просим заценить =) http://bbs.vbstreets.ru/viewtopic.php?p=118947 [/оффтоп по теме]

ЗЫ. Э какой каламбур! "Оффтоп по теме" =)

[kirrun]

Ну-ну... Что-то не заметно, чтобы кто-то тестил... А ведь хочется узнать что люди думают...