簡單的Windows API示例
說明：
一：新建一個工程，移除Form1。選擇Project\View source，拷貝下面的源代碼覆蓋已有的代碼。保存(如：D:\Projects\Source\WinAPI\WinAPI.dpr)。
二：新建WinAPI.inc文件到保存工程的目錄，用記事本打開，鍵入如下代碼：
const
cm_About = 101; //此處一定要回車，否則BRCC32 編譯時不能通過
保存(如：D:\Projects\Source\WinAPI\WinAPI.inc)。
三：新建AddRes.rc文件到保存工程的目錄，用記事本打開，鍵入如下代碼：
#include "WinAPI.inc"
WndMenu MENU
BEGIN
POPUP "Help"
BEGIN
MENUITEM "&About", cm_About
END
END
AboutDialog DIALOG 18, 18, 141, 58
STYLE DS_MODALFRAME | WS_POPUP | WS_CAPTION | WS_SYSMENU
CAPTION "About"
BEGIN
PUSHBUTTON "OK", IDOK, 45, 40, 50, 12,
WS_CHILD | WS_VISIBLE | WS_TABSTOP
CTEXT " Disigned by Swayi.F ", -1, 1, 9, 140, 8,
WS_CHILD | WS_VISIBLE | WS_GROUP
END
保存。
打開MS-DOS(Win9X: command; NT,2000: cmd)程序，輸入下列命令以編譯資源文件 BRCC32 -r FileName(如：D:\Projects\Source\WinAPI\addres.rc)回車。這時會在你輸入的文件名路徑下產生一個叫AddRes.res的文件。這是程序正常運行需要用到的資源文件。
四：編譯第一步保存的工程。運行。
五：程序運行時，你可以按鍵，其鍵值或相應提示會在窗口上有顯示﹔在移動鼠標時嘗試按住Shift, Ctrl,或左鍵，或右鍵，會顯示不同的顏色﹔雙擊﹔再嘗試調整窗口的大小看看效果。
六：如有疑問，歡迎與我討論：swayi@tom.com
program WinAPI;
uses
Windows, Messages, SysUtils;
{$R *.RES}
{$R AddRes.res}
{$I WinAPI.inc}
const
sCLS_NAME = 'WinAPI';
sSPACE = ' ';
sERR_REGISTER = 'Register instance failed.';
sERR_CREAT = 'Create instance failed.';
sON_CHAR = 'Char: %s ; Repeat: %d.' + sSPACE;
sON_SYS_KEY_DOWN = 'Alt key: %d ; Repeat: %d.' + sSPACE;
sON_KEY_DOWN = 'Key: %d ; Repeat: %d.' + sSPACE;
sON_MOUSE_MOVE = 'XPos: %d ; YPos: %d; Flags: %d' + sSPACE;
sON_LBTN_DBL_CLK = 'Double click pos: %d, %d; Flags: %d.' + sSPACE;
sMSG_TITLE = 'Window API program';
sMSG_TEXT_OUT = 'Press, move, double click and resize now! ';
sMSG_DRAW_TEXT = 'Printed out by DrawText.';
sMSG_HOME = 'Home key is pressed right now.' + sSPACE;
sMSG_LEFT = 'Left key is pressed right now.' + sSPACE;
sMSG_DELETE = 'Delete key is pressed right now.' + sSPACE;
sMSG_LWIN = 'Left Win key is pressed right now.' + sSPACE;
sMSG_F1 = 'F1 key is pressed right now.' + sSPACE;
nSYS_X = 100;
nSYS_Y = 100;
nWIDTH = 500;
nHEIGHT = 360;
nX = 20;
nY = 40;
nTOP = 240;
var
S: string;
procedure OnPaint(AHnd: HWND; var AMsg: TWMPaint);
var
DC: HDC;
AStruct: TPaintStruct;
ARect: TRect;
OldFont: HFont;
begin
DC := BeginPaint(AHnd,AStruct);
OldFont := SelectObject(DC, GetStockObject(SYSTEM_FIXED_FONT));
GetClientRect(AHnd, ARect);
SetBkMode(DC, TRANSPARENT);
ARect.Top := nTOP;
TextOut(DC, 5, 5, sMSG_TEXT_OUT, Length(sMSG_TEXT_OUT));
DrawText(DC, sMSG_DRAW_TEXT, -1, ARect, DT_SINGLELINE or DT_RIGHT);
SelectObject(DC, OldFont);
EndPaint(AHnd, AStruct);
end;
procedure OnChar(AHnd: HWND; var AMsg: TWMChar);
var
DC: HDC;
begin
DC := GetDC(AHnd);
S := Format(sON_CHAR, [Char(AMsg.CharCode), LoWord(AMsg.KeyData)]);
SetBkColor(DC, GetSysColor(COLOR_BTNFACE));
TextOut(DC, nX, nY, PChar(S), Length(S));
ReleaseDC(AHnd, DC);
end;
procedure OnSysKeyDown(AHnd: HWND; var AMsg: TWMSysKeyDown);
var
DC: HDC;
begin
DC := GetDC(AHnd);
S := Format(sON_SYS_KEY_DOWN, [AMsg.CharCode, LoWord(AMsg.KeyData)]);
SetBkColor(DC, GetSysColor(COLOR_BTNFACE));
TextOut(DC, nX, nY + 20, PChar(S), Length(S));
ReleaseDC(AHnd, DC);
end;
procedure OnKeyDown(AHnd: HWND; var AMsg: TWMKeyDown);
var
DC: HDC;
begin
DC := GetDC(AHnd);
case AMsg.CharCode of
VK_HOME: S := sMSG_HOME;
VK_LEFT: S := sMSG_LEFT;
VK_DELETE: S := sMSG_DELETE;
VK_LWIN: S := sMSG_LWIN;
VK_F1: S := sMSG_F1;
else
S := Format(sON_KEY_DOWN, [AMsg.CharCode, LoWord(AMsg.KeyData)]);
end;
SetBkColor(DC, GetSysColor(COLOR_BTNFACE));
TextOut(DC, nX, nY + 40, PChar(S), Length(S));
ReleaseDC(AHnd, DC);
end;
procedure OnMouseMove(AHnd: HWND; var AMsg: TWMMouseMove);
var
DC: HDC;
begin
DC := GetDC(AHnd);
S := Format(sON_MOUSE_MOVE, [AMsg.XPos, AMsg.YPos, AMsg.Keys]);
if ((AMsg.Keys and MK_CONTROL) = MK_CONTROL) then
SetTextColor(DC, RGB(0, 0, 255));
if ((AMsg.Keys and MK_LBUTTON) = MK_LBUTTON) then
SetTextColor(DC, RGB(127, 127, 0));
if ((AMsg.Keys and MK_RBUTTON) = MK_RBUTTON) then
SetTextColor(DC, RGB(255, 0, 0));
if ((AMsg.Keys and MK_SHIFT) = MK_SHIFT) then
SetTextColor(DC, RGB(255, 0, 255));
SetBkColor(DC, GetSysColor(COLOR_BTNFACE));
TextOut(DC, nX, nY + 60, PChar(S), Length(S));
ReleaseDC(AHnd, DC);
end;
procedure OnDblClk(AHnd: HWND; var AMsg: TWMLButtonDblClk);
var
DC: HDC;
begin
DC := GetDC(AHnd);
S := Format(sON_LBTN_DBL_CLK, [AMsg.XPos, AMsg.YPos, AMsg.Keys]);
SetBkColor(DC, GetSysColor(COLOR_BTNFACE));
SetTextColor(DC, RGB(127, 127, 127));
TextOut(DC, nX, nY + 80, PChar(S), Length(S));
ReleaseDC(AHnd, DC);
end;
function WndAbout(HndAbout: HWND; AMsg, WParam, LParam: LongInt): BOOL; stdcall;
begin
Result := True;
case AMsg of
WM_INITDIALOG: Exit;
WM_COMMAND:
if (WParam = idOK) or (WParam = idCancel) then
begin
EndDialog(HndAbout, 1);
Exit;
end;
end;
Result := False;
end;
function WndProc(HndWnd: HWND; AMsg, WParam, LParam: LongInt): LongInt; stdcall;
var
AMessage: TMessage;
begin
AMessage.Msg := AMsg;
AMessage.WParam := WParam;
AMessage.LParam := LParam;
AMessage.Result := 0;
case AMsg of
WM_PAINT: OnPaint(HndWnd, TWMPaint(AMessage));
WM_CHAR: OnChar(HndWnd, TWMChar(AMessage));
WM_SYSKEYDOWN: OnSysKeyDown(HndWnd, TWMSysKeyDown(AMessage));
WM_KEYDOWN: OnKeyDown(HndWnd, TWMKeyDown(AMessage));
WM_MOUSEMOVE: OnMouseMove(HndWnd, TWMMouseMove(AMessage));
WM_LBUTTONDBLCLK: OnDblClk(HndWnd, TWMLButtonDblClk(AMessage));
WM_COMMAND:
if WParam = cm_About then
begin
DialogBox(HInstance, 'AboutDialog', HndWnd, @WndAbout);
Result := DefWindowProc(HndWnd, AMsg, WParam, LParam);
Exit;
end;
WM_DESTROY: PostQuitMessage(WM_QUIT);
else begin
Result := DefWindowProc(HndWnd, AMsg, WParam, LParam);
Exit;
end;
end;
Result := AMessage.Result;
end;
function RegisterInstance: Boolean;
var
AWndCls: TWndClass;
begin
AWndCls.style := CS_VREDRAW or CS_HREDRAW or CS_DBLCLKS;
AWndCls.lpfnWndProc := @WndProc;
AWndCls.cbClsExtra := 0;
AWndCls.cbWndExtra := 0;
AWndCls.hInstance := HInstance;
AWndCls.hIcon := LoadIcon(0, IDI_WINLOGO);
AWndCls.hCursor := LoadCursor(0, IDC_ARROW);
AWndCls.hbrBackground := HBrush(Color_Window);
AWndCls.lpszMenuName := 'WndMenu';
AWndCls.lpszClassName := sCLS_NAME;
Result := RegisterClass(AWndCls) <> 0;
end;
function CreateInstance: THandle;
var
AHnd: THandle;
begin
AHnd := CreateWindow(sCLS_NAME, sMSG_TITLE, WS_OVERLAPPEDWINDOW, nSYS_X, nSYS_Y,
nWIDTH, nHEIGHT, 0, 0, HInstance, nil);
if AHnd <> 0 then
begin
ShowWindow(AHnd, SW_SHOW );
UpdateWindow(AHnd);
end;
Result := AHnd;
end;
var
AMsg: TMsg;
begin
if not RegisterInstance then
begin
MessageBox(0, sERR_REGISTER, nil, MB_OK);
Exit;
end;
if CreateInstance = 0 then
begin
MessageBox(0, sERR_CREAT, nil, MB_OK);
Exit;
end;
while GetMessage(AMsg, 0, 0, 0) do
begin
TranslateMessage(AMsg);
DispatchMessage(AMsg);
end;
end.