Description: 1: New project and remove Form1. Choose Project / View Source, copy the source code below to override the existing code. Save (such as: d: /projects/source/winapi/winapi.dpr). 2: New WinAPI.inc files to the directory of the saved project, open with Notepad, type the following code: const cm_about = 101; // must have a carriage return here, otherwise the BRCC32 cannot be saved when compiled (eg: D: / Projects) / Source/winapi/winapi.inc). Three: New addres.rc files to the save project directory, open with Notepad, type the following code: #include "winapi.inc"
WNDMENU MENU BEGIN POP "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 Save. Open the MS-DOS (Win9x: Command; NT, 2000: CMD) program, enter the following command to compile resource files BRCC32 -R FileName (such as: D: /Projects/Source/winapi/addres.rc) Enter. At this time, a file called Addres.res will be generated under the file name path you entered. This is the resource file that the program needs to be used normally. Four: Compile the project to be saved in the first step. run. 5: When the program is running, you can press the button, its key value, or the corresponding prompt will be displayed on the window; try to press and hold Shift, Ctrl, or Left button, or right or right when moving the mouse, will display different colors; double click; Try adjusting the size of the window to see the effect. Six: If you have any questions, welcome to discuss with me: 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_SINGLINE OR DT_RIGHT); SELECTOBJECT (DC, OldFont); Endpaint (AHND, Astructure);
Procedure onchar (ahnd: hwnd; var); var DC: hdc; begin DC: = getDC (AHND); s: = format (SON_CHAR, [CHAR (Amsg.Charcode), Loword (Amsg.KeyData)]) Setbkcolor (DC, GetSysColor); 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); Textout (DC); Textout , NX, NY 20, PCHAR (S), Length (s)); ReleaseDC (AHND, DC); END;
Procedure onkeyDown (AHND: HWND; var); 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: TWMMOMOVE); 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); 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 (HWND; AMSG, WPARAM, LPARAM: long): Bool; stdcall; begin result: = true; Case Amsg of wm_initdialog: exit;
WM_COMMAND: IF (WPARAM = IDOK) or (wparam = idcancel) THEN BEGIN Enddialog (Hndsout, 1); EXIT; End; End; Result: = FALSE;
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, Tw Mlbuttondblclk (AMESSAGE));
WM_COMMAND: IF WPARAM = CM_ABOUT THEN Begin DialogBox (Hinstance, 'AboutDialog', Hnds); Result: = DefWindowProc (Hnds); EndwD, 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;
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;
Var amsg: TMSG; Begin IF Not RegisterInstance Then Begin Messagebox (0, Serr_REGISTER, NIL, MB_OK); End;
IF createInstance = 0 THEN Begin MessageBox (0, serr_creat, nil, mb_ok); End;
While GetMessage (AMSG, 0, 0, 0) Do Begin TranslateMsage (AMSG); DISPATCHMESSAGE (AMSG); END;
