Lastly, I have been using Visual Studio with Telerik’s JustCode more and more often and this is more or less the first time I noticed that a habit from Visual Studio is not available in Delphi IDE. Previously was the opposite way, so for example I have F9 as “Start Debugging” in Visual Studio, instead of F5.
But what I missed in Delphi is a “navigation to definition” on middle click which is, I believe, a JustCode shortcut to standard VS command. Delphi had (since Delphi 4 at least) a similar navigation command available on Ctrl+Click or Alt+Up. So solution to have this shortcut in Delphi is simple: when cursor is in Delphi IDE editor and middle click is performed, simulate Alt+Up keypress.
It can be easily done in AutoHotKey (just one line of script). But I think it is more fun to write a tiny Delphi program and using only WinAPI achieve this. I’ve written “only WinAPI” because there are masses of Delphi components for what we will be doing here.
This is time to say thanks to authors of Global mouse hook in Delphi and How to Hook the Mouse to Catch Events Outside of your application articles, which I based on.
We need to create a hook procedure in a dll because it will be global hook procedure, which will be loaded and executed by Windows on hooked event. We need of course to create a UI project too, because in this project we provide UI for registering this hook procedure.
One thing to clarify in the source is this TEditControl string. This is the class name of editor control in Delphi IDE. You may also notice, that (when compiled with debug configuration), this code will log using CodeSite logger (great tool shipped with Delphi XE2).
Before you go to code, I also want to mention these forward keywords because you may be curious why I didn’t placed the forwarded procedures at top of file. Forwards are used instead of interface section (which can’t be inclued in the library project source) to achieve a “newspaper” coding style in which the most important procedures are placed at beginning and details are at bottom. OK, let’s go to the code.
DLL project
library MiddleButton;
uses
Winapi.Windows, Winapi.Messages, GlobalHeap in 'GlobalHeap.pas'{$IFDEF DEBUG}, CodeSiteLogging{$ENDIF};
function HookProc(Code: Integer; wParam: wParam; lParam: lParam): LRESULT; stdcall; forward;
function GetClassName(Handle: HWND): string; forward;
procedure SendInputs; forward;
procedure RunHook; stdcall;
begin
Log('RunHook...');
GlobalData.HookHandle := SetWindowsHookEx(WH_MOUSE, @HookProc, HInstance, 0);
if GlobalData.HookHandle = INVALID_HANDLE_VALUE then
Log('ERROR: SetWindowsHookEx');
Log('...RunHook');
end;
procedure KillHook; stdcall;
begin
Log('KillHook...');
if (GlobalData <> nil) and (GlobalData.HookHandle <> INVALID_HANDLE_VALUE) then
UnhookWindowsHookEx(GlobalData.HookHandle);
Log('...KillHook');
end;
function HookProc(Code: Integer; wParam: wParam; lParam: lParam): LRESULT; stdcall;
var
CurrWND: THandle;
begin
if (Code >= 0) and (wParam = WM_MBUTTONDOWN) then
begin
Log('WM_MBUTTONDOWN');
CurrWND := PMouseHookStruct(lParam)^.HWND;
if GetClassName(CurrWND) = 'TEditControl' then
begin
SendInputs;
exit(1);
end;
end;
Result := CallNextHookEx(0, Code, wParam, lParam);
end;
function GetClassName(Handle: HWND): string;
var
Len: Integer;
begin
SetLength(Result, 256);
Len := Winapi.Windows.GetClassName(Handle, PChar(Result), Length(Result));
SetLength(Result, Len);
end;
procedure SendInputs;
var
Inputs: array [0 .. 5] of TInput;
begin
ZeroMemory(@Inputs, sizeof(Inputs));
Inputs[0].Itype := INPUT_MOUSE;
Inputs[1].Itype := INPUT_MOUSE;
Inputs[2].Itype := INPUT_KEYBOARD;
Inputs[3].Itype := INPUT_KEYBOARD;
Inputs[4].Itype := INPUT_KEYBOARD;
Inputs[5].Itype := INPUT_KEYBOARD;
Inputs[0].mi.dwFlags := MOUSEEVENTF_LEFTDOWN;
Inputs[1].mi.dwFlags := MOUSEEVENTF_LEFTUP;
Inputs[2].ki.wVk := VK_MENU;
Inputs[3].ki.wVk := VK_UP;
Inputs[4].ki.wVk := VK_UP;
Inputs[4].ki.dwFlags := KEYEVENTF_KEYUP;
Inputs[5].ki.wVk := VK_MENU;
Inputs[5].ki.dwFlags := KEYEVENTF_KEYUP;
SendInput(Length(Inputs), Inputs[0], sizeof(TInput));
end;
exports
KillHook,
RunHook;
end.
GlobalHeap.pas
unit GlobalHeap;
interface
uses
Winapi.Windows{$IFDEF DEBUG}, CodeSiteLogging{$ENDIF};
type
PDLLGlobal = ^TDLLGlobal;
TDLLGlobal = packed record
HookHandle: HHOOK;
end;
var
GlobalData: PDLLGlobal;
procedure Log(Context: string);
implementation
const
MemMapFile = 'Middle_Button_Map_File';
var
MMF: THandle;
procedure CreateGlobalHeap;
begin
Log('CreateGlobalHeap...');
MMF := CreateFileMapping(INVALID_HANDLE_VALUE, nil, PAGE_READWRITE, 0, sizeof(TDLLGlobal), MemMapFile);
if MMF = 0 then
begin
Log('ERROR: CreateFileMapping');
exit;
end;
GlobalData := MapViewOfFile(MMF, FILE_MAP_ALL_ACCESS, 0, 0, sizeof(TDLLGlobal));
if GlobalData = nil then
begin
CloseHandle(MMF);
Log('ERROR: MapViewOfFile');
end;
Log('...CreateGlobalHeap');
end;
procedure DeleteGlobalHeap;
begin
Log('DeleteGlobalHeap...');
if GlobalData <> nil then
UnmapViewOfFile(GlobalData);
if MMF <> INVALID_HANDLE_VALUE then
CloseHandle(MMF);
GlobalData := nil;
MMF := 0;
Log('...DeleteGlobalHeap');
end;
procedure Log(Context: string);
begin
{$IFDEF DEBUG}
if GlobalData = nil then
CodeSite.Send(Context)
else
CodeSite.Send(Context + ' Data: %p Hook: %x', [GlobalData, GlobalData.HookHandle]);
{$ENDIF}
end;
initialization
CreateGlobalHeap;
finalization
DeleteGlobalHeap;
end.
UI project
program HookRunner;
uses
Vcl.Forms,
HookRunnerMainUnit in 'HookRunnerMainUnit.pas' {Form1};
{$R *.res}
begin
Application.Initialize;
Application.ShowMainForm := False;
Application.MainFormOnTaskbar := True;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.
HookRunnerMainUnit.pas
unit HookRunnerMainUnit;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Winapi.ShellAPI, Vcl.ExtCtrls, Vcl.AppEvnts;
const
WM_ICONTRAY = WM_USER + 1;
type
TForm1 = class(TForm)
btnRun: TButton;
lbRunning: TLabel;
btnKill: TButton;
ApplicationEvents1: TApplicationEvents;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure btnRunClick(Sender: TObject);
procedure btnKillClick(Sender: TObject);
procedure TrayMessage(var Msg: TMessage); message WM_ICONTRAY;
procedure ApplicationEvents1Minimize(Sender: TObject);
private
FTrayIconData: TNotifyIconData;
procedure InitializeTrayIcon;
end;
procedure RunHook; stdcall; external 'MiddleButton.dll' name 'RunHook';
procedure KillHook; stdcall; external 'MiddleButton.dll' name 'KillHook';
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
btnRunClick(nil);
InitializeTrayIcon;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
btnKillClick(nil);
Shell_NotifyIcon(NIM_DELETE, @FTrayIconData);
end;
procedure TForm1.btnRunClick(Sender: TObject);
begin
RunHook;
btnRun.Enabled := False;
btnKill.Enabled := True;
lbRunning.Show;
end;
procedure TForm1.btnKillClick(Sender: TObject);
begin
KillHook;
btnRun.Enabled := True;
btnKill.Enabled := False;
lbRunning.Hide;
end;
procedure TForm1.InitializeTrayIcon;
begin
with FTrayIconData do
begin
cbSize := SizeOf;
Wnd := Handle;
uID := 0;
uFlags := NIF_MESSAGE + NIF_ICON + NIF_TIP;
uCallbackMessage := WM_ICONTRAY;
hIcon := Application.Icon.Handle;
StrPCopy(szTip, Caption);
end;
Shell_NotifyIcon(NIM_ADD, @FTrayIconData);
end;
procedure TForm1.TrayMessage(var Msg: TMessage);
begin
if Msg.LParam = WM_LBUTTONDOWN then
begin
Show;
WindowState := wsNormal;
Application.BringToFront;
BringToFront;
end;
end;
procedure TForm1.ApplicationEvents1Minimize(Sender: TObject);
begin
Hide;
end;
end.
That’s it. Thanks for reading!
