getmessageexample.dpr

Delphi Win32核心API参考光盘

program GetMessageExample;

uses
    Windows, Messages, SysUtils;

{$R *.RES}

{The window procedure for our API window}
function WindowProc(TheWindow: HWnd; TheMessage, WParam,
                    LParam: Longint): Longint; stdcall;
begin
  case TheMessage of
    {upon getting the WM_DESTROY message, we exit the application}
    WM_DESTROY: begin
                   PostQuitMessage(0);
                   Exit;
                end;
    WM_LBUTTONDOWN: begin
                      {show the message time and the mouse coordinates}
                      SetWindowText(TheWindow, PChar('Message Time: '+IntToStr(
                                    GetMessageTime)+'   Mouse Coordinates: '+
                                    IntToStr(LoWord(GetMessagePos))+', '+
                                    IntToStr(HiWord(GetMessagePos))));

                      {indicate that the message was handled}
                      Result := 1;
                    end;
    else
      {call the default window procedure for all unhandled messages}
      Result := DefWindowProc(TheWindow, TheMessage, WParam, LParam);
    end;
end;

{ Register the Window Class }
function RegisterClass: Boolean;
var
  WindowClass: TWndClass;
begin
  {setup our new window class}
  WindowClass.Style := CS_HREDRAW or CS_VREDRAW; {set the class styles}
  WindowClass.lpfnWndProc := @WindowProc;        {point to our window procedure}
  WindowClass.cbClsExtra := 0;                   {no extra class memory}
  WindowClass.cbWndExtra := 0;                   {no extra window memory}
  WindowClass.hInstance := hInstance;            {the application instance}
  WindowClass.hIcon := LoadIcon(0, IDI_APPLICATION); {load a predefined logo}
  WindowClass.hCursor := LoadCursor(0, IDC_ARROW);   {load a predefined cursor}
  WindowClass.hbrBackground := COLOR_WINDOW;         {use a predefined color}
  WindowClass.lpszMenuName := nil;                   {no menu}
  WindowClass.lpszClassName := 'TestClass';          {the registered class name}

  {now that we have our class set up, register it with the system}
  Result := Windows.RegisterClass(WindowClass) <> 0;
end;

var
  TheMessage: TMsg;   // holds a message
  OurWindow: HWND;    // the handle to our window
begin
  {register our new class first}
  if not RegisterClass then
  begin
    MessageBox(0,'RegisterClass failed',nil,MB_OK);
    Exit;
  end;

  {now, create a window based on our new class}
  OurWindow := CreateWindowEx(
                            0,                     {no extended styles} 
                            'TestClass',           {the registered class name}
                            'GetMessage Example',  {the title bar text}
                            WS_OVERLAPPEDWINDOW or {a normal window style}
                            WS_VISIBLE,            {initially visible}
                            CW_USEDEFAULT,         {default horizontal position}
                            CW_USEDEFAULT,         {default vertical position}
                            CW_USEDEFAULT,         {default width}
                            CW_USEDEFAULT,         {default height}
                            0,                     {handle of the parent window}
                            0,                     {no menu}
                            hInstance,             {the application instance}
                            nil                    {no additional information}
                            );

  {if our window was not created successfully, exit the program}
  if OurWindow=0 then
  begin
    MessageBox(0,'CreateWindow failed',nil,MB_OK);
    Exit;
  end;

  {the standard message loop}
  while GetMessage(TheMessage,0,0,0) do
  begin
    TranslateMessage(TheMessage);
    DispatchMessage(TheMessage);
  end;

end.