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