Форум по Delphi программированию

Delphi Sources



Вернуться   Форум по Delphi программированию > Все о Delphi > ОС и железо
Ник
Пароль
Регистрация <<         Правила форума         >> FAQ Пользователи Календарь Поиск Сообщения за сегодня Все разделы прочитаны

Ответ
 
Опции темы Поиск в этой теме Опции просмотра
  #16  
Старый 06.10.2012, 00:02
Аватар для angvelem
angvelem angvelem вне форума
.
 
Регистрация: 18.05.2011
Адрес: Омск
Сообщения: 3,970
Версия Delphi: 3,5,7,10,12,XE2
Репутация: выкл
По умолчанию

Вот взято из MSDN
Код:
hhook = SetWindowsHookEx(WH_KEYBOARD_LL, LowLevelKeyboardProc, hinst, 0);

LRESULT LowLevelKeyboardProc(INT nCode, WPARAM wParam, LPARAM lParam)
{
    static BOOL fShiftPressed = FALSE;

    BOOL fHandled = FALSE;

    if (nCode == HC_ACTION)
    {
        KBDLLHOOKSTRUCT *pkbdllhook = (KBDLLHOOKSTRUCT *)lParam;

        switch (wParam)
        {
            case WM_SYSKEYDOWN:
                switch (pkbdllhook->vkCode)
                {
                    case VK_LSHIFT:
                    case VK_RSHIFT:
                    {
                        // the user pressed the shift key
                        fShiftPressed = TRUE;
                        break;
                    }
                    case VK_TAB:
                    {
                        if (pkbdllhook->flags & LLKHF_ALTDOWN)
                        {
                            // the user pressed Alt+Tab, execute AltTab hotkey handler
                            fHandled = TRUE;
                        }
                        break;
                    }
                    case VK_ESCAPE:
                    {
                        if (pkbdllhook->flags & LLKHF_ALTDOWN)
                        {
                            // the user pressed Escape, end the AltTab container 
                            // window without switching the selected window
                            fHandled = TRUE;
                        }
                        break;
                    }
                }
                break;

            case WM_KEYUP:
            case WM_SYSKEYUP:
                switch (pkbdllhook->vkCode)
                {
                    case VK_LMENU:
                    case VK_RMENU:
                    {
                        // the user let go of the Alt key, end the AltTab container
                        // window switching to the selected window
                        break;
                    }
                    case VK_LSHIFT:
                    case VK_RSHIFT:
                    {
                        // the user released the shift key
                        fShiftPressed = FALSE;
                        break;
                    }
                }
                break;
        }
    }
    return (fHandled ? TRUE : CallNextHookEx(hhook, nCode, wParam, lParam));
}
как видишь, проверку на Shift сделать не трудно.
__________________
Je venus de nulle part
55.026263 с.ш., 73.397636 в.д.

Последний раз редактировалось angvelem, 06.10.2012 в 00:04.
Ответить с цитированием
  #17  
Старый 06.10.2012, 00:06
Аватар для SCrat.ORS
SCrat.ORS SCrat.ORS вне форума
Активный
 
Регистрация: 20.02.2007
Адрес: Мой адрес не дом и не улица, мой адрес 0x7С00
Сообщения: 208
Версия Delphi: 2006
Репутация: 884
По умолчанию

Код:
 case WM_SYSKEYUP:
                switch (pkbdllhook->vkCode)
                {
                    case VK_LMENU:
                    case VK_RMENU:
                    {
                        // the user let go of the Alt key, end the AltTab container
                        // window switching to the selected window
                        break;
                    }
                    case VK_LSHIFT:
                    case VK_RSHIFT:
                    {
                        // the user released the shift key
                        fShiftPressed = FALSE;
                        break;
                    }
                }
думаешь поможет?...вроде я нечто похожее и делал....попробую конечно
__________________
Програмистами не рождаются, ими становятся!
Ответить с цитированием
  #18  
Старый 06.10.2012, 00:08
Аватар для angvelem
angvelem angvelem вне форума
.
 
Регистрация: 18.05.2011
Адрес: Омск
Сообщения: 3,970
Версия Delphi: 3,5,7,10,12,XE2
Репутация: выкл
По умолчанию

Обрати внимание, в коде 2 раза проверяется на Shift.
__________________
Je venus de nulle part
55.026263 с.ш., 73.397636 в.д.
Ответить с цитированием
  #19  
Старый 06.10.2012, 00:09
Аватар для SCrat.ORS
SCrat.ORS SCrat.ORS вне форума
Активный
 
Регистрация: 20.02.2007
Адрес: Мой адрес не дом и не улица, мой адрес 0x7С00
Сообщения: 208
Версия Delphi: 2006
Репутация: 884
По умолчанию

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

А вспомнил, каким образом обрабатывается нажатие 2-х клавиш. в частности Шифт и Капс??? в HC_ACTION оно отображает только последнее нажатое... кажется есть одна идея но не уверен
__________________
Програмистами не рождаются, ими становятся!

Последний раз редактировалось SCrat.ORS, 06.10.2012 в 00:11.
Ответить с цитированием
  #20  
Старый 06.10.2012, 00:45
Аватар для Freeman
Freeman Freeman вне форума
Местный
 
Регистрация: 05.10.2012
Адрес: Санкт-Петербург
Сообщения: 577
Версия Delphi: 6
Репутация: выкл
По умолчанию

Цитата:
Сообщение от SCrat.ORS
KOL ... хм не слышал, почитаю гугл =)
Наконец-то нашелся повод подвигнуть меня на выкладывание своей кухни.

Выложил "tricky lite"-версию модуля System для Delphi 6/7, доработанную уже после KOL:
  • Диспетчер памяти выпилен полностью, поэтому в обязательном порядке требуется включение HeapMM или ShareMM. Ну, или если сильно хочется, то и SysMM.
  • Если упоминание какого-либо из этих модулей не будет стоять первой строчкой в uses dpr-файла, программа упадет на первом же GetMem, -- он может быть и неявным.

Заодно выложил сборку BorlndMM.dll на основе FastMM, используемую как замена оригинального BorlndMM.dll в Delphi 2-7 и заодно как подгружаемая библиотека в ShareMM. Из-за легкой версии System заменитель имеет меньший размер чем оригинал, и это при увеличенной производительности.

Залил также CapSwitch как пример кода. Все права сохранены.

Я обычно поддерживаю и развиваю лишь те программы, которыми пользуюсь сам. CapSwitch использовать не планирую, оттого и ветка Abandoned.

Перезалил также архив с lite-версией программы. Он временный, и через какое-то время удалю. Типа, компилируйте сами.

Думается, как-нибудь опишу в блоге, что и как с этим "tricky lite".
Ответить с цитированием
  #21  
Старый 06.10.2012, 00:48
Аватар для SCrat.ORS
SCrat.ORS SCrat.ORS вне форума
Активный
 
Регистрация: 20.02.2007
Адрес: Мой адрес не дом и не улица, мой адрес 0x7С00
Сообщения: 208
Версия Delphi: 2006
Репутация: 884
По умолчанию

angvelem, спасибо, навел меня на правильную мысль, все заработало как положено. Ссылка на исходники в 1 посте.
__________________
Програмистами не рождаются, ими становятся!
Ответить с цитированием
  #22  
Старый 06.10.2012, 00:57
Аватар для SCrat.ORS
SCrat.ORS SCrat.ORS вне форума
Активный
 
Регистрация: 20.02.2007
Адрес: Мой адрес не дом и не улица, мой адрес 0x7С00
Сообщения: 208
Версия Delphi: 2006
Репутация: 884
По умолчанию

Freeman, я конечно понимаю свою не компетентность, но как эти модули запилить в делфи? Скопировать в ..\source\Win32\rtl\sys\ - не помогло, после компиляции все-равно вес программы 83 кб. Помоги пожалуйста.
__________________
Програмистами не рождаются, ими становятся!
Ответить с цитированием
  #23  
Старый 06.10.2012, 01:04
Аватар для angvelem
angvelem angvelem вне форума
.
 
Регистрация: 18.05.2011
Адрес: Омск
Сообщения: 3,970
Версия Delphi: 3,5,7,10,12,XE2
Репутация: выкл
По умолчанию

Вот набросок:
Код:
unit MyThread;

interface

uses
  Windows;

type
  TKbLEDTag	= (kbledNum, kbledCaps, kbledScroll);
  TLedScroll	= class
  private
    fHandle	: HWND;
    fDummy	: DWORD;
    fSuspend	: Boolean;
  public
    constructor Create(Suspend : Boolean);
    procedure Resume;
    procedure Suspend;
    procedure Terminate;

    property Handle : HWND read fHandle;
  end;

const
  LangKbLED	= kbledScroll;  // LED to indicate language

var
  EnUS		: Boolean;
  OldEnUS	: Boolean = True;
  Msg		: TMsg;

implementation

procedure ToggleKeybrdLED(LEDTag: TKbLEDTag);

  procedure SimulateLkKey(KeyDown: Boolean);
  const
    VKeyCodes : array[TKbLEDTag] of Byte = (VK_NUMLOCK, VK_CAPITAL, VK_SCROLL);
    ScanCodes : array[TKbLEDTag] of Byte = ($45, $3A, $46);
  begin
    keybd_event(VKeyCodes[LEDTag], ScanCodes[LEDTag], KEYEVENTF_EXTENDEDKEY or Ord(not KeyDown) * KEYEVENTF_KEYUP, 0);
  end;

begin
  SimulateLkKey(True);
  SimulateLkKey(False);
end;

function ThreadProc : DWORD; stdcall;
var
  Msg  : TMsg;
begin
  if PostThreadMessage(GetCurrentThreadId, 0, 0, 0) then
    GetMessage(Msg, 0, 0, 0);

  while True do
  begin
    EnUS := GetKeyboardLayout(GetWindowThreadProcessId(GetForegroundWindow)) and $FFFF = $0409;
    if EnUS <> OldEnUS then
    begin
      ToggleKeybrdLED(LangKbLED);
      OldEnUS := EnUS;
    end;
    Sleep(100);
  end;
end;

constructor TLedScroll.Create(Suspend : Boolean);
const
  Bol : array[Boolean] of DWORD = (0, CREATE_SUSPENDED);
begin
  fHandle := CreateThread(NIL, 0, @ThreadProc, NIL, Bol[Suspend], fDummy);
  fSuspend := Suspend;
end;

procedure TLedScroll.Resume;
begin
  if fSuspend then
  begin
    ResumeThread(fHandle);
    fSuspend := False;
  end;
end;

procedure TLedScroll.Suspend;
begin
  if not fSuspend then
  begin
    SuspendThread(fHandle);
    fSuspend := True;
  end;
end;

procedure TLedScroll.Terminate;
begin
  if fHandle <> 0 then
  begin
    ExitThread(0);
    fHandle := 0;
  end;
end;

end.
exe-шник выходит чуть больше 17 Кб.
__________________
Je venus de nulle part
55.026263 с.ш., 73.397636 в.д.
Ответить с цитированием
  #24  
Старый 06.10.2012, 01:05
Аватар для Freeman
Freeman Freeman вне форума
Местный
 
Регистрация: 05.10.2012
Адрес: Санкт-Петербург
Сообщения: 577
Версия Delphi: 6
Репутация: выкл
По умолчанию

Нужно на сайте KOL скачать сам KOL и легкие замены SysUtils и Classes. Настроить пути в проекте и попробовать собрать. Размер должен уменьшиться.

После этого можно экспериментировать с заменой System, для чего найти сначала на сайте KOL версию под свой компилятор. Ну, и читать, что написано на сайте (или где? не помню) и в самих модулях.
Ответить с цитированием
  #25  
Старый 06.10.2012, 01:05
Аватар для angvelem
angvelem angvelem вне форума
.
 
Регистрация: 18.05.2011
Адрес: Омск
Сообщения: 3,970
Версия Delphi: 3,5,7,10,12,XE2
Репутация: выкл
По умолчанию

продолжение:
Код:
program CapSwitch;

uses
  Windows,  MyThread;

type
  TKBDLLHOOKSTRUCT = record
    vkCode	: DWORD;
    scanCode	: DWORD;
    flags	: DWORD;
    time	: DWORD;
    dwExtraInfo	: DWORD;
 end;
 PKBDLLHOOKSTRUCT = ^TKBDLLHOOKSTRUCT;

const
  WH_KEYBOARD_LL = 13;

var
  hhkLowLevelKybd : HHOOK;
  Mutex : THandle;
  aLedscroll : TLedScroll;//TThread;

//------------------------------------------------------------------------------

function LowLevelKeyboardProc(nCode: integer;  wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
var
  fEatKeystroke : Boolean;
  p : PKBDLLHOOKSTRUCT;
  Wnd : HWND;
begin
  fEatKeystroke := False;

  if nCode = 0 then
  begin
    case wParam of
      256 :
      begin
        p := PKBDLLHOOKSTRUCT(lParam);
        fEatKeystroke := (p^.vkCode = 20);
      end;
    end;
  end;

  if fEatKeystroke then
  begin
    Wnd := GetForegroundWindow;
    PostMessage(Wnd, 80, 0, HKL_NEXT);
    Result := 1;
  end
  else
    Result := CallNextHookEx(0, nCode, wParam, lParam);
end;

//------------------------------------------------------------------------------

begin
  // Install the low-level keyboard & mouse hooks
  hhkLowLevelKybd := SetWindowsHookEx(WH_KEYBOARD_LL, LowLevelKeyboardProc, hInstance, 0);
  Mutex := CreateMutex(nil, True, 'CapSwitch_Running');
  if WaitForSingleObject(Mutex, 0) <> WAIT_OBJECT_0 then
    Exit;

  aLedscroll := TLedscroll.Create(True);
  aLedscroll.Resume;

  while GetMessage(msg, 0, 0, 0) do
  begin
    TranslateMessage(msg);
    DispatchMessage(msg);
  end;
 
  // Remove hooks
  if aLedscroll.Handle <> 0 then
    aLedscroll.Terminate;
  UnhookWindowsHookEx(hhkLowLevelKybd);
end.

И забей на KOL большой болт, кака неимоверная и давно умершая.
__________________
Je venus de nulle part
55.026263 с.ш., 73.397636 в.д.
Ответить с цитированием
  #26  
Старый 06.10.2012, 01:09
Аватар для SCrat.ORS
SCrat.ORS SCrat.ORS вне форума
Активный
 
Регистрация: 20.02.2007
Адрес: Мой адрес не дом и не улица, мой адрес 0x7С00
Сообщения: 208
Версия Delphi: 2006
Репутация: 884
По умолчанию

Все конечно хорошо, если не учитывать что либы - MyThread нету
__________________
Програмистами не рождаются, ими становятся!
Ответить с цитированием
  #27  
Старый 06.10.2012, 01:10
Аватар для Freeman
Freeman Freeman вне форума
Местный
 
Регистрация: 05.10.2012
Адрес: Санкт-Петербург
Сообщения: 577
Версия Delphi: 6
Репутация: выкл
По умолчанию

Цитата:
Сообщение от angvelem
exe-шник выходит чуть больше 17 Кб.
У меня 9 КБ получилось.
Ответить с цитированием
  #28  
Старый 06.10.2012, 01:11
Аватар для angvelem
angvelem angvelem вне форума
.
 
Регистрация: 18.05.2011
Адрес: Омск
Сообщения: 3,970
Версия Delphi: 3,5,7,10,12,XE2
Репутация: выкл
По умолчанию

Цитата:
Сообщение от SCrat.ORS
Все конечно хорошо, если не учитывать что либы - MyThread нету
Так смотри выше, я ведь выложил.
__________________
Je venus de nulle part
55.026263 с.ш., 73.397636 в.д.

Последний раз редактировалось angvelem, 06.10.2012 в 01:13.
Ответить с цитированием
  #29  
Старый 06.10.2012, 01:12
Аватар для angvelem
angvelem angvelem вне форума
.
 
Регистрация: 18.05.2011
Адрес: Омск
Сообщения: 3,970
Версия Delphi: 3,5,7,10,12,XE2
Репутация: выкл
По умолчанию

Цитата:
Сообщение от Freeman
У меня 9 КБ получилось.
Если я подправлю System.pas и SysInit.pas, то уложусь менее чем в 4 Кб. Но смысл?
__________________
Je venus de nulle part
55.026263 с.ш., 73.397636 в.д.
Ответить с цитированием
  #30  
Старый 06.10.2012, 01:16
Аватар для SCrat.ORS
SCrat.ORS SCrat.ORS вне форума
Активный
 
Регистрация: 20.02.2007
Адрес: Мой адрес не дом и не улица, мой адрес 0x7С00
Сообщения: 208
Версия Delphi: 2006
Репутация: 884
По умолчанию

11 кб получилось...
__________________
Програмистами не рождаются, ими становятся!
Ответить с цитированием
Ответ


Delphi Sources

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск
Опции просмотра

Ваши права в разделе
Вы не можете создавать темы
Вы не можете отвечать на сообщения
Вы не можете прикреплять файлы
Вы не можете редактировать сообщения

BB-коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.
Быстрый переход


Часовой пояс GMT +3, время: 20:38.


 

Сайт

Форум

FAQ

RSS лента

Прочее

 

Copyright © Форум "Delphi Sources" by BrokenByte Software, 2004-2023

ВКонтакте   Facebook   Twitter