說明: 一:新建一個工程,移除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,或左鍵,或右鍵,會顯示不同的顏色﹔雙擊﹔再嘗試調整窗口的大小看看效果。 六:如有疑問,歡迎與我討論:[email protected]
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.

|