home *** CD-ROM | disk | FTP | other *** search
/ PC World 2003 February / PCWorld_2003-02_cd.bin / Software / Topware / devpascal / examples / WinHello / winhello.pp < prev   
Text File  |  2000-09-11  |  3KB  |  117 lines
  1. {
  2.   $Id: winhello.pp,v 1.1 1998/12/20 22:23:54 peter Exp $
  3.   Copyright (c) 1996 by Charlie Calvert
  4.   Modifications by Florian Klaempfl
  5.  
  6.   Standard Windows API application written in Object Pascal.
  7.   No VCL code included. This is all done on the Windows API
  8.   level.
  9. }
  10.  
  11. {$APPTYPE GUI}
  12. {$MODE DELPHI}
  13. program WinHello;
  14.  
  15. uses
  16.   Strings, Windows;
  17.  
  18. const
  19.   AppName = 'WinHello';
  20.  
  21. function WindowProc(Window: HWnd; AMessage, WParam,
  22.                     LParam: Longint): Longint; stdcall; export;
  23.  
  24.   var
  25.      dc : hdc;
  26.      ps : paintstruct;
  27.      r : rect;
  28.  
  29. begin
  30.   WindowProc := 0;
  31.  
  32.   case AMessage of
  33.     wm_paint:
  34.       begin
  35.          dc:=BeginPaint(Window,@ps);
  36.          GetClientRect(Window,@r);
  37.          DrawText(dc,'Hello world by Free Pascal',-1,@r,
  38.            DT_SINGLELINE or DT_CENTER or DT_VCENTER);
  39.          EndPaint(Window,ps);
  40.          Exit;
  41.       end;
  42.     wm_Destroy:
  43.       begin
  44.          PostQuitMessage(0);
  45.          Exit;
  46.       end;
  47.   end;
  48.  
  49.   WindowProc := DefWindowProc(Window, AMessage, WParam, LParam);
  50. end;
  51.  
  52.  { Register the Window Class }
  53. function WinRegister: Boolean;
  54. var
  55.   WindowClass: WndClass;
  56. begin
  57.   WindowClass.Style := cs_hRedraw or cs_vRedraw;
  58.   WindowClass.lpfnWndProc := WndProc(@WindowProc);
  59.   WindowClass.cbClsExtra := 0;
  60.   WindowClass.cbWndExtra := 0;
  61.   WindowClass.hInstance := system.MainInstance;
  62.   WindowClass.hIcon := LoadIcon(0, idi_Application);
  63.   WindowClass.hCursor := LoadCursor(0, idc_Arrow);
  64.   WindowClass.hbrBackground := GetStockObject(WHITE_BRUSH);
  65.   WindowClass.lpszMenuName := nil;
  66.   WindowClass.lpszClassName := AppName;
  67.  
  68.   Result := RegisterClass(WindowClass) <> 0;
  69. end;
  70.  
  71.  { Create the Window Class }
  72. function WinCreate: HWnd;
  73. var
  74.   hWindow: HWnd;
  75. begin
  76.   hWindow := CreateWindow(AppName, 'Hello world program',
  77.               ws_OverlappedWindow, cw_UseDefault, cw_UseDefault,
  78.               cw_UseDefault, cw_UseDefault, 0, 0, system.MainInstance, nil);
  79.  
  80.   if hWindow <> 0 then begin
  81.     ShowWindow(hWindow, CmdShow);
  82.     UpdateWindow(hWindow);
  83.   end;
  84.  
  85.   Result := hWindow;
  86. end;
  87.  
  88.  
  89. var
  90.   AMessage: Msg;
  91.   hWindow: HWnd;
  92.  
  93. begin
  94.   if not WinRegister then begin
  95.     MessageBox(0, 'Register failed', nil, mb_Ok);
  96.     Exit;
  97.   end;
  98.   hWindow := WinCreate;
  99.   if longint(hWindow) = 0 then begin
  100.     MessageBox(0, 'WinCreate failed', nil, mb_Ok);
  101.     Exit;
  102.   end;
  103.  
  104.   while GetMessage(@AMessage, 0, 0, 0) do begin
  105.     TranslateMessage(AMessage);
  106.     DispatchMessage(AMessage);
  107.   end;
  108.   Halt(AMessage.wParam);
  109. end.
  110.  
  111. {
  112.   $Log: winhello.pp,v $
  113.   Revision 1.1  1998/12/20 22:23:54  peter
  114.     * new name
  115.  
  116. }
  117.