home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / mod201j.zip / modula2.exe / os2demo / hello / hello.mod < prev    next >
Text File  |  1996-01-15  |  14KB  |  407 lines
  1. MODULE HELLO;
  2.  
  3. (************************************************************************
  4.     This is the Modula-2 version of the HELLO.C sample program
  5.     from the IBM Developer's Toolkit for OS/2.
  6.  
  7.     It is a simple Presentation Manager application.
  8.     And it also demonstrates how to compile and use
  9.     a simple dynamic link file being used by this sample
  10.     program.
  11.  
  12.     Needed tools:
  13.       MOD.EXE         This Modula-2 Compiler
  14.       LINK386.EXE     OS/2 linker
  15.                       (part of OS/2 2.x or OS/2 3.0)
  16.       RC.EXE          Resource Script Compiler
  17.                       (from OS/2 Developer's Toolkit)
  18.       ICONEDIT.EXE    Icon Editor with which to create a HELLO.ICO
  19.                       (part of OS/2 2.x or OS/2 3.0)
  20.  
  21.     Needed files:
  22.       HELLO.MOD       Source file of the HELLO sample program.
  23.       HELLO.RC        Resource Script File for the HELLO sample program.
  24.       HELLO.ICO       Program Icon
  25.       DLLTEST.DEF     Sample DLL interface
  26.       DLLTEST.MOD     Sample DLL implementation
  27.  
  28.  
  29.     OS/2 commands for compilation and linkage:
  30.       MOD HELLO.MOD -o -b -pm:pm
  31.       LINK386 @HELLO.RSP
  32.       LINK386 @DLLTEST.RSP
  33.       RC HELLO.RC HELLO.EXE
  34. *************************************************************************)
  35.  
  36. (*$XL+       Modula-2 language extensions: '_' allowed for symbol names *)
  37. (*$A         default alignment for record fields                        *)
  38. (*$CDECL-    Pascal-style procedures                                    *)
  39. (*$XF+       Relaxed function designator usage                          *)
  40.  
  41. FROM SYSTEM        IMPORT ADR, BYTE, LONGWORD;
  42.  
  43. FROM OS2DEF        IMPORT NULLHANDLE, HWND, HMQ, HMODULE, HPS, HAB;
  44. FROM OS2DEF        IMPORT RECTL, POINTL, PSZ;
  45.  
  46. FROM WINDEF        IMPORT CS_SIZEREDRAW, HWND_DESKTOP, HWND_TOP;
  47. FROM WINDEF        IMPORT MPARAM, MRESULT;
  48.  
  49. FROM DOSPROCESS    IMPORT DosBeep;
  50. FROM DOSPROCESS    IMPORT DosExit;
  51. FROM DOSPROCESS    IMPORT EXIT_PROCESS;
  52.  
  53. FROM WINFRAMEMGR   IMPORT WM_ERASEBACKGROUND;
  54. FROM WINFRAMEMGR   IMPORT WinCreateStdWindow;
  55. FROM WINFRAMEMGR   IMPORT FCF_STANDARD, FCF_SHELLPOSITION;
  56.  
  57. FROM WINWINDOWMGR  IMPORT WinInitialize;
  58. FROM WINWINDOWMGR  IMPORT WinRegisterClass;
  59. FROM WINWINDOWMGR  IMPORT WinSetWindowText;
  60. FROM WINWINDOWMGR  IMPORT WinSetWindowPos;
  61. FROM WINWINDOWMGR  IMPORT WinDestroyWindow;
  62. FROM WINWINDOWMGR  IMPORT WinTerminate;
  63. FROM WINWINDOWMGR  IMPORT WinLoadString;
  64. FROM WINWINDOWMGR  IMPORT WinInvalidateRegion;
  65. FROM WINWINDOWMGR  IMPORT WinDefWindowProc;
  66. FROM WINWINDOWMGR  IMPORT WinBeginPaint;
  67. FROM WINWINDOWMGR  IMPORT WinEndPaint;
  68. FROM WINWINDOWMGR  IMPORT SWP_SIZE, SWP_MOVE, SWP_ACTIVATE, SWP_SHOW;
  69.  
  70. FROM WINMESSAGEMGR IMPORT WinPostMsg;
  71. FROM WINMESSAGEMGR IMPORT WinCreateMsgQueue;
  72. FROM WINMESSAGEMGR IMPORT WinGetMsg;
  73. FROM WINMESSAGEMGR IMPORT WinDispatchMsg;
  74. FROM WINMESSAGEMGR IMPORT WinDestroyMsgQueue;
  75. FROM WINMESSAGEMGR IMPORT QMSG, PCMDMSG;
  76. FROM WINMESSAGEMGR IMPORT WM_CREATE, WM_COMMAND, WM_PAINT, WM_CLOSE, WM_QUIT;
  77.  
  78. FROM WINERRORS     IMPORT WinGetErrorInfo;
  79. FROM WINERRORS     IMPORT WinFreeErrorInfo;
  80. FROM WINERRORS     IMPORT PERRINFO;
  81.  
  82. FROM WINDIALOGS    IMPORT MB_MOVEABLE, MB_CUACRITICAL, MB_CANCEL;
  83.  
  84. FROM GPIPRIMITIVES IMPORT GpiSetColor;
  85. FROM GPIPRIMITIVES IMPORT GpiSetBackColor;
  86. FROM GPIPRIMITIVES IMPORT GpiSetBackMix;
  87. FROM GPIPRIMITIVES IMPORT GpiCharStringAt;
  88. FROM GPIPRIMITIVES IMPORT CLR_NEUTRAL, CLR_DARKGRAY, BM_OVERPAINT;
  89.  
  90. IMPORT DLLTest;
  91.  
  92.  
  93. CONST
  94.   MSGBOXID     = 1001;
  95.   ID_WINDOW    = 256;
  96.   ID_OPTIONS   = 257;
  97.   ID_OPTION1   = 258;
  98.   ID_OPTION2   = 259;
  99.   ID_OPTION3   = 260;
  100.   ID_OPTIOND   = 267;
  101.   ID_EXITPROG  = 261;
  102.   IDS_HELLO    = 262;
  103.   IDS_1        = 263;
  104.   IDS_2        = 264;
  105.   IDS_3        = 265;
  106.   IDS_D        = 266;
  107.  
  108. CONST
  109.   STRINGLENGTH = 20;           (* Length of string             *)
  110.  
  111. TYPE
  112.   STRING       = ARRAY [0..STRINGLENGTH-1] OF CHAR;
  113.  
  114. VAR                            (* Define parameters by type     *)
  115.   hab          : HAB;          (* PM anchor block handle        *)
  116.   szHello      : STRING;       (* String parameters, set in     *)
  117.   sz1          : STRING;       (* the processing of WM_CREATE,  *)
  118.   sz2          : STRING;       (* and used in the processing    *)
  119.   sz3          : STRING;       (* of WM_COMMAND, in window      *)
  120.   szD          : STRING;       (* procedure.                    *)
  121.   szString     : STRING;
  122.   pszErrMsg    : PSZ;
  123.   hmq          : HMQ;          (* Message queue handle          *)
  124.   hwndClient   : HWND;         (* Client area window handle     *)
  125.   hwndFrame    : HWND;         (* Frame window handle           *)
  126.   qmsg         : QMSG;         (* Message from message queue    *)
  127.   flCreate     : LONGCARD;     (* Window creation control flags *)
  128.   ok           : BOOLEAN;
  129.   b1           : SYSTEM.BYTE;
  130.   b4           : SYSTEM.LONGWORD;
  131.  
  132.  
  133. PROCEDURE StrLen
  134. ( VAR Str : ARRAY OF CHAR
  135. )         : LONGCARD;
  136. VAR
  137.   i       : LONGCARD;
  138.   j       : LONGCARD;
  139. BEGIN
  140.   j := HIGH( Str );
  141.   i := 0;
  142.   WHILE (Str[ i ] <> CHR( 0 )) AND (i < j) DO
  143.     INC( i );
  144.   END;
  145.   RETURN i;
  146. END StrLen;
  147.  
  148.  
  149.  
  150. (**************************************************************************
  151.   Name:
  152.     MyWindowProc
  153.   Description:
  154.     The window procedure associated with the client area in
  155.     the standard frame window. It processes all messages
  156.     either sent or posted to the client area, depending on
  157.     the message command and parameters.
  158.   Concepts:
  159.   Parameters:
  160.     hwnd = window handle
  161.     msg = message code
  162.     mp1 = first message parameter
  163.     mp2 = second message parameter
  164.   Return:
  165.     depends on message sent
  166. ***************************************************************************)
  167.  
  168. (*$CDECL+    C-style procedures                                         *)
  169.  
  170. PROCEDURE MyWindowProc
  171. ( hwnd         : HWND;
  172.   msg          : LONGCARD;
  173.   mp1          : MPARAM;
  174.   mp2          : MPARAM
  175. )              : MRESULT;
  176. VAR
  177.   hps          : HPS;                   (* Presentation Space handle    *)
  178.   rc           : RECTL;                 (* Rectangle coordinates        *)
  179.   pt           : POINTL;                (* String screen coordinates    *)
  180.   CommandMsg   : PCMDMSG;               (* WM_COMMAND message parameter *)
  181. BEGIN
  182.   CASE msg OF
  183.   | WM_CREATE:
  184.     (* Window initialization is performed here            *)
  185.     (* WinLoadString loads strings from the resource file.*)
  186.     WinLoadString( hab, 0, IDS_HELLO, STRINGLENGTH, szHello );
  187.     WinLoadString( hab, 0, IDS_1,     STRINGLENGTH, sz1     );
  188.     WinLoadString( hab, 0, IDS_2,     STRINGLENGTH, sz2     );
  189.     WinLoadString( hab, 0, IDS_3,     STRINGLENGTH, sz3     );
  190.     WinLoadString( hab, 0, IDS_D,     STRINGLENGTH, szD     );
  191.     szString := szHello;
  192.   | WM_COMMAND:
  193.     (* When the user chooses option 1, 2, or 3 from the Options pull-  *)
  194.     (* down, the text string is set to 1, 2, or 3, and                 *)
  195.     (* WinInvalidateRegion sends a WM_PAINT message.                   *)
  196.     (* When Exit is chosen, the application posts itself a WM_CLOSE    *)
  197.     (* message.                                                        *)
  198.     CommandMsg := ADR( mp1 );
  199.     CASE CommandMsg^.cmd OF
  200.     | ID_OPTION1:
  201.       szString := sz1;
  202.       WinInvalidateRegion( hwnd, 0, FALSE );
  203.     | ID_OPTION2:
  204.       szString := sz2;
  205.       WinInvalidateRegion( hwnd, 0, FALSE );
  206.     | ID_OPTION3:
  207.       szString := sz3;
  208.       WinInvalidateRegion( hwnd, 0, FALSE );
  209.     | ID_EXITPROG:
  210.       b1 := WinPostMsg( hwnd, WM_CLOSE, NIL, NIL );
  211.     | ID_OPTIOND:
  212.       szString := szD;
  213.       WinInvalidateRegion( hwnd, 0, FALSE );
  214.       IF DLLTest.AddTwoCard( 2, 4 ) <> 6 THEN
  215.         DosBeep( 400, 500 );
  216.       END;
  217.     ELSE
  218.       RETURN WinDefWindowProc( hwnd, msg, mp1, mp2 );
  219.     END;
  220.   | WM_ERASEBACKGROUND:
  221.     (* Return TRUE to request PM to paint the window background *)
  222.     (* in SYSCLR_WINDOW.                                        *)
  223.     RETURN LONG( LONG( SHORTCARD( TRUE ) ) );
  224.   | WM_PAINT:
  225.     (* DosBeep( 400, 1000 );*)
  226.     (* Window contents are drawn here *)
  227.     (* Create a presentation space  *)
  228.     hps := WinBeginPaint( hwnd, 0, ADR(rc) );
  229.     (* Set the text coordinates *)
  230.     pt.x := 50; pt.y := 50;
  231.     (* Set the color of the text *)
  232.     GpiSetColor( hps, CLR_NEUTRAL );
  233.     (* Set the background color of the text and how it mixes *)
  234.     GpiSetBackColor( hps, CLR_DARKGRAY );
  235.     GpiSetBackMix( hps, BM_OVERPAINT );
  236.     (* Draw the string... *)
  237.     (* DosBeep( 350, 1000 );*)
  238.     GpiCharStringAt( hps, pt, StrLen( szString ), szString );
  239.     (* DosBeep( 300, 1000 );*)
  240.     WinEndPaint( hps );
  241.     (* DosBeep( 250, 1000 );*)
  242.     (* Drawing is complete *)
  243.   | WM_CLOSE:
  244.     (* This is the place to put your termination routines *)
  245.     (* Cause termination *)
  246.     WinPostMsg( hwnd, WM_QUIT, NIL, NIL );
  247.   ELSE
  248.     (* Everything else comes here. *)
  249.     (* This call MUST exist in your window procedure. *)
  250.     RETURN WinDefWindowProc( hwnd, msg, mp1, mp2 );
  251.   END;
  252.   RETURN LONG( LONG( SHORTCARD( FALSE ) ) );
  253. END MyWindowProc;
  254.  
  255. (*$CDECL-    Pascal-style procedures                                    *)
  256.  
  257.  
  258.  
  259. (**************************************************************************
  260.   Name:
  261.     AbortHello
  262.   Description:
  263.     Report an error returned from an API service
  264.   Concepts:
  265.     use of message box to display information
  266.   Parameters:
  267.     hwndFrame = frame window handle
  268.     hwndClient = client window handle
  269.   Return:
  270.     [none]
  271. ***************************************************************************)
  272.  
  273. PROCEDURE AbortHello
  274. ( hwndFrame         : HWND;
  275.   hwndClient        : HWND
  276. );
  277. VAR
  278.   pErrInfoBlk       : PERRINFO;
  279.   pusOffset         : POINTER TO CARDINAL;
  280.   fStyle            : LONGCARD;
  281. BEGIN
  282.   (*b4 := DosBeep( 2000, 1000 );*)
  283.   pErrInfoBlk := WinGetErrorInfo( hab );
  284.   IF pErrInfoBlk <> NIL THEN
  285.     pusOffset := ADR( pErrInfoBlk^ ) + pErrInfoBlk^.offaoffszMsg;
  286.     pszErrMsg := ADR( pErrInfoBlk^ ) + pusOffset^;
  287.     IF (hwndFrame <> 0) AND (hwndClient <> 0) THEN
  288.       fStyle := MB_MOVEABLE OR MB_CUACRITICAL OR MB_CANCEL;
  289.       b4 := WINDIALOGS.WinMessageBox
  290.       ( HWND_DESKTOP,           (* Parent window is desk top *)
  291.         hwndFrame,              (* Owner window is our frame *)
  292.         pszErrMsg^,             (* PMWIN Error message       *)
  293.         "Error Msg",            (* Title bar message         *)
  294.         MSGBOXID,               (* Message identifier        *)
  295.         fStyle                  (* Flags                     *)
  296.       );
  297.     END;
  298.     b1 := WinFreeErrorInfo( pErrInfoBlk );
  299.   END;
  300.   b1 := WinPostMsg( hwndClient, WM_QUIT, NIL, NIL );
  301. END AbortHello;
  302.  
  303.  
  304.  
  305. (**************************************************************************
  306.   Name:
  307.     HELLO mainline
  308.   Description:
  309.     Initializes the process for OS/2 PM services and
  310.     process the application message queue until a
  311.     WM_QUIT message is received.  It then destroys all
  312.     OS/2 PM resources and terminates.
  313.   Concepts:
  314.     - obtains anchor block handle and creates message
  315.       queue
  316.     - creates the main frame window which creates the
  317.       main client window
  318.     - polls the message queue via Get/Dispatch Msg loop
  319.     - upon exiting the loop, exits
  320.   Parameters:
  321.     [none]
  322.   Return:
  323.     1 - if successful execution completed
  324.     0 - if error
  325. ***************************************************************************)
  326.  
  327. BEGIN (* of HELLO mainline *)
  328.  
  329.   hwndClient := NULLHANDLE;
  330.   hwndFrame := NULLHANDLE;
  331.  
  332.   (* Initializes the process for OS/2 PM services *)
  333.   szHello := "Hello";
  334.  
  335.   hab := WinInitialize( 0 );
  336.   IF hab = 0 THEN
  337.     AbortHello( hwndFrame, hwndClient );
  338.   END;
  339.  
  340.   (* Create a message queue *)
  341.   hmq := WinCreateMsgQueue( hab, 0 );
  342.   IF hmq = 0 THEN
  343.     AbortHello( hwndFrame, hwndClient );
  344.   END;
  345.  
  346.   (* Register a new window class *)
  347.   ok := WinRegisterClass
  348.   ( hab,             (* Anchor block handle *)
  349.     "MyWindow",      (* Window class name *)
  350.     MyWindowProc,    (* Address of window procedure *)
  351.     CS_SIZEREDRAW,   (* Class style *)
  352.     0                (* No extra window words *)
  353.   );
  354.   IF NOT ok THEN
  355.     AbortHello( hwndFrame, hwndClient );
  356.   END;
  357.  
  358.   (* Set frame control flags to standard except for shell positioning *)
  359.   flCreate := FCF_STANDARD AND NOT FCF_SHELLPOSITION;
  360.  
  361.   (* Create a standard window. OS/2 Presentation Manager sends the
  362.      intial messages WM_CREATE and WM_ADJUSTWINDOWPOS to the associated
  363.      window procedure 'MyWindowProc'.
  364.   *)
  365.   hwndFrame := WinCreateStdWindow
  366.   ( HWND_DESKTOP,    (* Desktop window is parent *)
  367.     0,               (* STD. window styles *)
  368.     flCreate,        (* Frame control flag *)
  369.     "MyWindow",      (* Client window class name *)
  370.     "",              (* No window text *)
  371.     0,               (* No special class style *)
  372.     HMODULE( 0 ),    (* Resource is in .EXE file *)
  373.     ID_WINDOW,       (* Frame window identifier *)
  374.     hwndClient       (* Client window handle *)
  375.   );
  376.   IF hwndFrame = 0 THEN
  377.     AbortHello( hwndFrame, hwndClient );
  378.   END;
  379.  
  380.   WinSetWindowText( hwndFrame, "HELLO SAMPLE" );
  381.  
  382.   (* Show and activate frame window at pos. 100,100 and size 200,200. *)
  383.   ok := WinSetWindowPos
  384.   ( hwndFrame,
  385.     HWND_TOP,
  386.     100, 100, 200, 200,
  387.     SWP_SIZE OR SWP_MOVE OR SWP_ACTIVATE OR SWP_SHOW
  388.   );
  389.   IF NOT ok THEN
  390.     AbortHello( hwndFrame, hwndClient );
  391.   END;
  392.   (*DosExit( EXIT_PROCESS, 0 );*)
  393.  
  394.   (* Get and dispatch messages from the application message queue *)
  395.   (* until WinGetMsg returns FALSE, indicating a WM_QUIT message. *)
  396.  
  397.   WHILE WinGetMsg( hab, qmsg, 0, 0, 0 ) DO
  398.     WinDispatchMsg( hab, qmsg );
  399.   END;
  400.  
  401.   (* Tidy up and terminate the application *)
  402.   WinDestroyWindow( hwndFrame );
  403.   WinDestroyMsgQueue( hmq );
  404.   WinTerminate( hab );
  405.  
  406. END HELLO.
  407.