Оглавление Free Pascal + WinAPI. Создание простейшего окна средствами WinAPI


Текст программы с комментариями

{
  Copyright (c) 1996 by Charlie Calvert
  Modifications by Florian Klaempfl
  Комментарии  Winni

  Стандартное Windows API приложение, написанное на Object Pascal.
  Библиотека VCL не используется. Все сделано на уровне Windows API.  

  API - интерфейс, позволяющий прикладному программисту использовать 
  функции и объекты  операционной системы. Для применения Windows API 
  в Делфи существует модуль Windows, текст которого доступен.

  Для ознакомления с Windows API можно прочесть книгу Джеффри Рихтера
  Windows  - создание эффективных Win32-приложений.

}

{$APPTYPE GUI}   // эквивалентно опции -WC-  или -WG+ 
{$MODE DELPHI}   // эквивалентно опции -Mdelphi 
program WinHello;

uses
  Strings,Windows;

const
  AppName = 'WinHello';

function WindowProc(Window: HWnd; AMessage: UINT; WParam : WPARAM;
                    LParam: LPARAM): LRESULT; stdcall; export;
//Каждое окно в Windows имеет процедуру WindowProc, предназначенную для обработки
//сообщений, поступающих от операционной системы.
  var
     dc : hdc;
     ps : paintstruct;
     r : rect;

(* если интересно, что такое  paintstruct,rect и т п - можно заглянуть в текст модуля 
Windows.pas в Делфи (E:\Program Files\Borland\Delphi7\Source\Rtl\Win\). Там увидим:

  PPaintStruct = ^TPaintStruct;
  {$EXTERNALSYM tagPAINTSTRUCT}
  tagPAINTSTRUCT = packed record
    hdc: HDC;
    fErase: BOOL;
    rcPaint: TRect;
    fRestore: BOOL;
    fIncUpdate: BOOL;
    rgbReserved: array[0..31] of Byte;
  end;
  TPaintStruct = tagPAINTSTRUCT;
  {$EXTERNALSYM PAINTSTRUCT}
  PAINTSTRUCT = tagPAINTSTRUCT;

или в MSDN. Потому что это детальки Windows.
*)

begin
  WindowProc := 0;

  case AMessage of //т е обрабатывает только 2 системных сообщения:
                   //wm_paint (нарисовать) и wm_Destroy (разрушить)
    wm_paint:
      begin
         dc:=BeginPaint(Window,@ps);
         GetClientRect(Window,@r);
         DrawText(dc,'Hello world by Free Pascal',-1,@r,
           DT_SINGLELINE or DT_CENTER or DT_VCENTER);
         EndPaint(Window,ps);
         Exit;
      end;
    wm_Destroy:
      begin
         PostQuitMessage(0);
         Exit;
      end;
  end;

  WindowProc := DefWindowProc(Window, AMessage, WParam, LParam);
end;

 { Register the Window Class }
function WinRegister: Boolean;
var
  WindowClass: WndClass;
begin
  WindowClass.Style := cs_hRedraw or cs_vRedraw;
  WindowClass.lpfnWndProc := WndProc(@WindowProc);
  WindowClass.cbClsExtra := 0;
  WindowClass.cbWndExtra := 0;
  WindowClass.hInstance := system.MainInstance;
  WindowClass.hIcon := LoadIcon(0, idi_Application);
  WindowClass.hCursor := LoadCursor(0, idc_Arrow);
  WindowClass.hbrBackground := GetStockObject(WHITE_BRUSH);
  WindowClass.lpszMenuName := nil;
  WindowClass.lpszClassName := AppName;

  Result := RegisterClass(WindowClass) <> 0;
end;

 { Create the Window Class }
function WinCreate: HWnd;
var
  hWindow: HWnd;
begin
  hWindow := CreateWindow(AppName, 'Hello world program',
              ws_OverlappedWindow, cw_UseDefault, cw_UseDefault,
              cw_UseDefault, cw_UseDefault, 0, 0, system.MainInstance, nil);

  if hWindow <> 0 then begin
    ShowWindow(hWindow, CmdShow);
    ShowWindow(hWindow, SW_SHOW);
    UpdateWindow(hWindow);
  end;

  Result := hWindow;
end;


var
  AMessage: Msg;
  hWindow: HWnd;

begin
  if not WinRegister then begin
    MessageBox(0, 'Register failed', nil, mb_Ok);
    Exit;
  end;
  hWindow := WinCreate;
  if longint(hWindow) = 0 then begin
    MessageBox(0, 'WinCreate failed', nil, mb_Ok);
    Exit;
  end;

  while GetMessage(@AMessage, 0, 0, 0) do begin
    TranslateMessage(AMessage);
    DispatchMessage(AMessage);
  end;
  Halt(AMessage.wParam);
end.

Внешний вид окна:


Примечание:
Интересно пытаться компилировать этот файл в Делфи7 (текст помещается в .dpr). Но обнаруживаются расхождения:
Rambler's Top100
Hosted by uCoz