Показать сообщение отдельно
  #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 в.д.
Ответить с цитированием