Jump to content


Check out our Community Blogs

teloris

Member Since 08 Aug 2011
Offline Last Active Nov 21 2011 05:03 PM
-----

Posts I've Made

In Topic: Windows Hooking: Enabling And Disabling Keyboard, With Delphi Code.

08 August 2011 - 11:04 PM

Thank you! Yes, actually I used this code a long time ago for similar idea. It was a short training application. When the video is playing I want the users could not type anything. So instead of disabling and reenabling any text-input-capable controls I simply disable the keyboard machine-wide :)


hi LuthfiHakim,

thanks for your dll. it's work great for me :thumbup:
i add some feature to your program (rebuild it) such as minimize to tray, pop up menu and icon changing.

here's the code

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ShellAPI, Menus, ImgList;

type
  TForm1 = class(TForm)
    Button1: TButton;
    PopupMenu1: TPopupMenu;
    MATIKANKEYBOARD1: TMenuItem;
    N1: TMenuItem;
    N2: TMenuItem;
    UTUP1: TMenuItem;
    N3: TMenuItem;
    AMPILKAN1: TMenuItem;
    ImageList1: TImageList;
    procedure Button1Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure MATIKANKEYBOARD1Click(Sender: TObject);
    procedure N1Click(Sender: TObject);
    procedure AMPILKAN1Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure UTUP1Click(Sender: TObject);
  private
    IconData: TNotifyIconData;
    procedure CreateTrayIcon;
    procedure MinimizeToTray;
    procedure RestoreFromTray;
  public
    procedure WndProc(var Msg : TMessage); override;
  end;

var
  Form1: TForm1;
  Icon: TIcon;

implementation

  function DisableKeyboard: Boolean; stdcall external 'KBHook.dll';
  procedure EnableKeyboard; stdcall external 'KBHook.dll';

{$R *.dfm}

procedure TForm1.WndProc(var Msg : TMessage); // Handle TrayIcon Events
var
  p : TPoint;
begin
  case Msg.Msg of
    WM_USER + 1:       // This is our TrayIcon
    case Msg.lParam of
      WM_RBUTTONDOWN: begin  // User has RightClicked on TrayIcon
         GetCursorPos(p);    // Get Cursor Position
         PopupMenu1.Popup(p.x, p.y);  // Display Menu
      end;
      WM_LBUTTONDBLCLK: RestoreFromTray;  // User has DblClicked on TrayIcon
    end;
  end;
  inherited;  // Continue to do the usual WndProc
end;

procedure TForm1.CreateTrayIcon;
begin
  IconData.cbSize := sizeof(IconData);
  IconData.Wnd := Handle;  // Handle to our Form
  IconData.uID := 100;
  IconData.uFlags := NIF_MESSAGE + NIF_ICON + NIF_TIP;
  IconData.uCallbackMessage := WM_USER + 1;  // Our Callback ID
  IconData.hIcon := Application.Icon.Handle;  // Use our application Icon
  StrPCopy(IconData.szTip, Application.Title);
end;

procedure TForm1.MinimizeToTray;
begin
  Shell_NotifyIcon(NIM_ADD, @IconData);  // Add Tray Icon here
  Form1.Hide;  // Hide our Form...
  ShowWindow(Application.Handle, SW_HIDE);  // ...and hide application from TaskBar.
end;

procedure TForm1.RestoreFromTray;
begin
  Shell_NotifyIcon(NIM_DELETE, @IconData);  // Delete TrayIcon
  ShowWindow(Application.Handle, SW_SHOW);  // Show app on taskbar
  Form1.Show;  // Show Form
  Application.BringToFront;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  if Button1.Caption = 'DEACTIVATE KEYBOARD' then
  begin
    //deactivate keyboard
    DisableKeyboard;

    //icon changing
    ImageList1.GetIcon(0,Icon);
    IconData.hIcon := Icon.Handle;
    Shell_NotifyIcon(NIM_Modify, @IconData);

    Button1.Caption := 'ACTIVATE KEYBOARD'
  end
  else
  begin
    //activate keyboard
    EnableKeyboard;

    //icon changing
    ImageList1.GetIcon(1,Icon);
    IconData.hIcon := Icon.Handle;
    Shell_NotifyIcon(NIM_Modify, @IconData);
    Button1.Caption := 'DEACTIVATE KEYBOARD'
  end;

end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  //activate keyboard
  EnableKeyboard;

  //delete icon
  Shell_NotifyIcon(NIM_DELETE, @IconData);

  //close program
  Application.Terminate;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  //form show up in bottom right screen
  Form1.Left := Screen.Width - Form1.Width;
  Form1.Top := Screen.Height - (Form1.Height + 30);
  
  //create systray icon
  createtrayicon;
  Icon := TIcon.Create;
  Shell_NotifyIcon(NIM_ADD, @IconData);
end;

procedure TForm1.MATIKANKEYBOARD1Click(Sender: TObject);
begin
  //disable keyboard
  DisableKeyboard;

  //icon change
  ImageList1.GetIcon(0,Icon);
  IconData.hIcon := Icon.Handle;

  //icon refresh (after changing)
  Shell_NotifyIcon(NIM_Modify, @IconData);

  Button1.Caption := 'ACTIVATE KEYBOARD'
end;

procedure TForm1.N1Click(Sender: TObject);
begin
  //activate keyboard
  EnableKeyboard;

  //icon changing
  ImageList1.GetIcon(1,Icon);
  IconData.hIcon := Icon.Handle;

  //refresh icon
  Shell_NotifyIcon(NIM_Modify, @IconData);

  Button1.Caption := 'DEACTIVATE KEYBOARD'
end;
                                                                     
procedure TForm1.AMPILKAN1Click(Sender: TObject);
begin
  //form show
  RestoreFromTray;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  //minimize instead of close
  Action := caNone;
  MinimizeToTray;
end;

procedure TForm1.UTUP1Click(Sender: TObject);
begin
  //goto formdestroy
  FormDestroy(sender);
end;

end.

sorry if my code was messed, i'm a newbie in delphi programming :rolleyes:

reference here, here and of course here :thumbup:

here's the executable file :
[ATTACH]4071[/ATTACH]

and here's the source code
[ATTACH]4072[/ATTACH]

Recommended from our users: Dynamic Network Monitoring from WhatsUp Gold from IPSwitch. Free Download