簡單的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,或左鍵，或右鍵，會顯示不同的顏色﹔雙擊﹔再嘗試調整窗口的大小看看效果。
　　六：如有疑問，歡迎與我討論：[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.

本文地址：http://com.8s8s.com/it/it5223.htm