一个功能很强的程序
本程序象C语言一样，用Delphi也能写出只有几十K、十几K、甚至只有几K的小程序，本文以一个能将Win95桌面藏起来的小程序为例，还涉及Win95 TrayIcon的显示。
本程序能写得很小的诀窍是：根本没有用任何的 Form 。也就是说，源程序只有一个Prog1.dpr 文件，当然资源文件是不能少的。资源中包括桌机两种状态的图标。程序完全用标准的 WINAPI 写成，由于用到的资源很少，所以程序的体积也很小。当然，用这样的方法编程时不能使用 Delphi的所见即所得的编程方式。
本程序用到了如下一些功能:
在任务栏上显示图标，不同状态的切换
只用一个工程文件，运行中注册建立窗口
点击任务栏显隐桌面
ShowWindow(FindWindow('Progman',nil),SW_RESTORE|SW_HIDE);
运行中建立弹出菜单，对菜单命令的处理
不显示程序窗口，程序不能重复运行
注册窗口对不同消息的控制
program prog1;
{prog1.dpr}
uses Windows, Messages, ShellAPI, sysutils;
{$R *.RES}
{可以看出本程序比普通的 Delphi 程序用到的 Unit 少的多。 下面声明了全局常量和变量，暂时可以不管他们。}
const
AppName = 'DeskTop Hide';
var
x: integer;
tid: TNotifyIconData;
WndClass: array[0..50] of char;
procedure HandleCommand (Wnd: hWnd; Cmd: Word);
begin
case Cmd of
Ord ('A'): MessageBox (0, 'Freeware brian.slack@strath.ac.uk 1997',AppName, mb_ok);
Ord ('E'): PostMessage (Wnd, wm_Close, 0, 0);
end;
end;
function DummyWindowProc (Wnd: hWnd; Msg, wParam: Word; lParam: LongInt):LongInt; stdcall;
{注意这里有一个 stdcall;定义了回调函数}
var
TrayHandle: Thandle;
dc: hDC;
pm: Hmenu;
pt: Tpoint;
begin
DummyWindowProc := 0;
{下面两句是找到 Win95 任务栏的句柄}
StrPCopy(@WndClass[0], 'Progman');
TrayHandle := FindWindow(@WndClass[0], nil);
{下面开始处理消息}
case Msg of
{收到窗口创建消息 - 在任务栏上显示一个图标}
wm_Create: // Program initialisation - just set up a tray icon
begin
tid.cbSize := sizeof (tid);
tid.Wnd := Wnd;
tid.uID := 1;
tid.uFlags := nif_Message or nif_Icon or nif_Tip;
tid.uCallBackMessage := wm_User;
tid.hIcon := LoadIcon (hInstance, 'mainICON');
lstrcpy (tid.szTip,'Desktop is on');
Shell_NotifyIcon (nim_Add, @tid);
end;
wm_Destroy: {收到关闭窗口消息时的处理}
begin
Shell_NotifyIcon (nim_Delete, @tid);
PostQuitMessage (0);
ShowWindow(TrayHandle, SW_RESTORE);
end;
{收到菜单消息时调用 HandleCommand 过程，并退出函数}
wm_Command: // Command notification
begin
HandleCommand (Wnd, LoWord (wParam));
Exit;
end;
{收到其他用户消息时的处理}
wm_User: // Had a tray notification - see what to do
{如果单击了鼠标左键， 则打开或关闭桌面}
if (lParam = wm_LButtonDown) then
begin
if x = 0 then
begin
ShowWindow(TrayHandle, SW_HIDE);
tid.hIcon := LoadIcon (hInstance, 'OFFICON');
lstrcpy (tid.szTip,'Desktop is off');
Shell_NotifyIcon (NIM_MODIFY, @tid);
x:=1
end else
begin
ShowWindow(TrayHandle, SW_RESTORE);
tid.hIcon := LoadIcon (hInstance, 'ONICON');
lstrcpy (tid.szTip,'Desktop is on');
Shell_NotifyIcon (NIM_MODIFY, @tid);
x:= 0;
end; {end of if}
end else
{如果是鼠标右键，则动态生成一个弹出式菜单}
if (lParam = wm_RButtonDown) then
begin
GetCursorPos (pt);
pm := CreatePopupMenu;
AppendMenu (pm, 0, Ord ('A'), 'About DeskTop Hide...');
AppendMenu (pm, mf_Separator, 0, Nil);
AppendMenu (pm, 0, Ord ('E'), 'Exit DeskTop Hide');
SetForegroundWindow (Wnd);
dc := GetDC (0);
if TrackPopupMenu (pm, tpm_BottomAlign or tpm_RightAlign,
pt.x,pt.y, 0, Wnd, Nil)
then SetForegroundWindow (Wnd);
DestroyMenu (pm)
end; {end of if}
end; {end of case}
{在处理过消息之后，还要调用默认函数，
以完成标准的Windows程序应该执行的任务，
所以这一句非常重要}
DummyWindowProc := DefWindowProc (Wnd, Msg, wParam, lParam);
end;
{这个就是处理菜单消息的过程}
{现在看来，程序的主框架很明了，但是它还不能完成任何任务。
过程 Panic将显示一个对话框后退出程序，
它在 Winmain 过程的开始部分被调用，
其实 Panic的功能很简单，之所以要写成一个函数的原因
恐怕一方面是结构化编程的需要，
另一方面借此避开了 String 和 Pchar 的转换。}
procedure Panic (szMessage: Pchar);
begin
if szMessage <> Nil then
MessageBox (0, szMessage, AppName, mb_ok);
Halt (0);
end;
{现在进入程序的主要部分，首先是定义了一批过程，
为了能让读者更好地理解，我们先把这些过程跳过去，
先说主程序。主程序位于程序的最后，
这样做的好处是可以直接使用程序中定义的过程。
主程序十分简单：}
procedure WinMain;
var
Wnd: hWnd; {声明窗口句柄(Handle)变量}
Msg: TMsg; {声明消息变量}
cls: TWndClass; {窗口类变量}
begin
{ Previous instance running ? If so, exit }
{ 检查是否程序已经运行，如果已经运行则调用Panic过程退出 }
if FindWindow (AppName, Nil) <> 0 then
Panic (AppName + ' is already running.');
{ Register the window class }
{ 这里的注册窗口类程序是例行公事，照抄即可}
FillChar (cls, sizeof (cls), 0); {用这一句将窗口类变量cls清零}
cls.lpfnWndProc := @DummyWindowProc; {取回调函数DummyWindowProc的地址}
cls.hInstance := hInstance; {实例句柄}
cls.lpszClassName := AppName; {窗口类名}
RegisterClass (cls); {注册窗口类cls}
{ 现在可以创建程序的主窗口了-在本程序中是个虚拟窗口}
{ Now create the dummy window }
Wnd := CreateWindow (AppName, AppName, ws_OverlappedWindow,0, 0, 100, 100,
0, 0, hInstance, Nil);
x:= 0; {变量X其实是个开关变量，记录现在是否已经隐藏了桌面}
{ 如果窗口创建成功，则显示窗口，并进入消息循环 }
if Wnd <> 0 then
begin
ShowWindow (Wnd, sw_Hide);{本例中窗口是隐藏的}
{ 下面进入消息循环，该循环将不断运行直到 GetMessage返回0 }
while GetMessage (Msg, 0, 0, 0) do
begin
TranslateMessage (Msg);
DispatchMessage (Msg);
end;
end;
end;
{主程序}
begin
WinMain;
end.
105. 利用HOOK建立鼠标增强程序
http://www.jxit.com.cn/devecom/coolbaby/article/list.asp?id=103
在Windows系统中提供了一种系统消息挂钩的(Message hook)功能，使用消息挂钩，可以实时监视处理系统中的各种消息。很多鼠标增强软件就是利用消息挂钩来拦截所有的鼠标消息进行处理的。
要设置鼠标消息挂钩，一般先建立一个使用鼠标消息挂钩的动态连接库(DLL)文件，然后就可以在其它程序中使用这个DLL文件处理鼠标消息。
下面的程序介绍通过鼠标消息挂钩监视鼠标消息，从而实现类似于一些鼠标增强软件一样的使窗口上下左右滚动的功能。
1．建立动态连接库
选择菜单 File|New ，选择DLL产生一个DLL模版，保存为 MHook.Dpr
//MHook.Dpr源程序
library MHook;
uses SysUtils,Classes,hkproc in 'hkproc.pas';
exports
EnableMouseHook,
DisableMouseHook;
begin
hNextHookProc:=0;
procSaveExit:=ExitProc;
ExitProc:=@HotKeyHookExit;
end.
再选择菜单 File|New ，选择Unit建立一个Pas文件，保存为 HKProc.pas
//HKProc.pas源程序
unit hkproc;
interface
uses Windows,Messages;
const
Move_Up = 0;
Move_Down=1;
Move_Left=2;
Move_Right=3;
var
hNextHookProc:HHook;
procSaveExit
ointer;
M_Direct:Integer;
LPoint:TPoint;
NowWindow:Integer;
function MouseProc(iCode:Integer;wParam:WPARAM;lParam
ointer):
LRESULT; stdcall;export;
function EnableMouseHook(WndHandle:integer):BOOL;export;
function DisableMouseHook:BOOL;export;
function GetDirect(FPoint : TPoint;LPoint : TPoint):integer;
procedure HotKeyHookExit;far;
implementation
//GetDirect函数根据光标的移动决定窗口滚动的方向。
function GetDirect(FPoint : TPoint;LPoint : TPoint):integer;
var
iWidth,iHeight:integer;
begin
iWidth:=LPoint.x-FPoint.x;
iHeight:=lPoint.y-FPoint.y;
Result:=-1;
if ((iWidth=0)or(iHeight=0))then exit;
if ((abs(iWidth) div abs(iHeight))>=2) then
if iWidth<0 then //Move to left
Result:=Move_Left
else
Result:=Move_Right
else if ((abs(iHeight) div abs(iWidth))>=2) then
if iHeight<0 then //Move to top
Result:=Move_Up
else
Result:=Move_Down;
end;
function MouseProc(iCode:Integer;wParam:WPARAM;
lParam
ointer):LRESULT; stdcall;export;
var
pMouse:^MOUSEHOOKSTRUCT;
l:integer;
begin
//如果用户按下鼠标右键同时Scroll Lock键为按下状态则滚动窗口。
if ((wParam=WM_RBUTTONDOWN) and Boolean(GetKeyState(145))) then
begin
pMouse:=lParam;
l:=GetDirect(lPoint,pMouse.pt);
if l>=0 then M_Direct:=l;
lPoint:=pMouse.pt;
NowWindow:=WindowFromPoint(lPoint);
if M_Direct=Move_Up then
SendMessage(NowWindow,WM_VSCROLL,SB_PAGEUP,0)
else if M_Direct=Move_Down then
SendMessage(NowWindow,WM_VSCROLL,SB_PAGEDOWN,0)
else if M_Direct=Move_Left then
SendMessage(NowWindow,WM_HSCROLL,SB_PAGELEFT,0)
else if M_Direct=Move_Right then
SendMessage(NowWindow,WM_HSCROLL,SB_PAGERIGHT,0);
Result:=1;
exit;
end
else if ((wParam=WM_RBUTTONUP) and Boolean(GetKeyState(145))) then
Result:=1
else
begin
Result:=0;
if iCode<0 then
begin
Result:=CallNextHookEx(hNextHookProc,iCode,wParam,integer(lParam));
Exit;
end;
end;
end;
function EnableMouseHook(WndHandle:integer):BOOL;export;
begin
GetCursorPos(lPoint);
Result:=False;
if hNextHookProc<>0 then exit;
//设置Mouse hook
hNextHookProc:=SetWindowsHookEx(WH_MOUSE,@MouseProc,Hinstance,0);
Result:=hNextHookProc<>0;
end;
function DisableMouseHook:BOOL;export;
begin
if hNextHookProc<>0 then
begin
UnHookWindowsHookEx(hNextHookProc);
hNextHookProc:=0;
end;
Result:=hNextHookProc=0;
end;
procedure HotKeyHookExit;
begin
if hNextHookProc<>0 then
DisableMouseHook;
ExitProc:=procSaveExit;
end;
end.
在菜单中选择 Project|Build MHook建立DLL文件。
2．建立程序调用动态连接库
在这里我们还是使用Delphi建立程序，当然也可以使用诸如VB等调用动态连接库。在菜单中选 File|New Application建立一个新程序，将工程文件保存为Project1.dpr
//project1的源程序
program Project1;
uses Forms, Sample1 in 'Sample1.pas' {Form1};
{$R *.RES}
begin
Application.Initialize;
//隐藏窗口
Application.ShowMainForm := False;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.
将Form1的源程序文件保存成Sample1.pas
//Form1的源程序
unit Sample1;
interface
uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Menus, ImgList,ShellApi, ExtCtrls;
const
WM_ICONMESSAGE=WM_USER+$100;
type
TForm1 = class(TForm)
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormCreate(Sender: TObject);
private
procedure WMBarIcon(var Message:TMessage);message WM_ICONMESSAGE;
public
end;
function EnableMouseHook(WndHandle:integer):BOOL;external 'MHook.DLL';
function DisableMouseHook:BOOL;external'MHook.DLL';
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.WMBarIcon (var Message:TMessage);
begin
//用户双击任务栏图标则关闭程序
if Message.LParam = WM_LBUTTONDBLCLK then close;
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
var
lpData
NotifyIconData;
begin
//删除任务栏图标
lpData := new(PNotifyIconDataA);
lpData.cbSize := 88;//SizeOf(PNotifyIconDataA);
lpData.Wnd := Form1.Handle;
lpData.hIcon := Form1.Icon.Handle;
lpData.uCallbackMessage := WM_ICONMESSAGE;
lpData.uID :=0;
lpData.szTip := '鼠标演示';
lpData.uFlags := NIF_ICON or NIF_MESSAGE or NIF_TIP;
Shell_NotifyIcon(NIM_DELETE,lpData);
dispose(lpData);
//解除Mouse hook
DisableMouseHook;
end;
procedure TForm1.FormCreate(Sender: TObject);
var
lpData
NotifyIconData;
begin
EnableMouseHook(Form1.Handle);
Form1.Visible := False;
lpData := new(PNotifyIconDataA);
lpData.cbSize := 88;//SizeOf(PNotifyIconDataA);
lpData.Wnd := Form1.Handle;
lpData.hIcon := Form1.Icon.Handle;
lpData.uCallbackMessage := WM_ICONMESSAGE;
lpData.uID :=0;
lpData.szTip := '鼠标演示';
lpData.uFlags := NIF_ICON or NIF_MESSAGE or NIF_TIP;
Shell_NotifyIcon(NIM_ADD,lpData);
dispose(lpData);
end;
end.
运行程序，按下Scroll Lock键使其有效，将光标移动到文本窗口中（如IE、Word），移动鼠标，点击鼠标右键，窗口就可以依上一次移动的方向滚动。
利用上面的原理，将程序做一些改动，就可以象专业的鼠标增强程序一样做出例如缩放窗口，运行程序等很多鼠标增强效果来。上面的程序在Windows95,Delphi4.0下运行通过。
