home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / PM-M2B.ZIP / CUSTOM.MOD < prev    next >
Text File  |  1990-10-03  |  7KB  |  169 lines
  1. (*----------------------------------------------------------------------------*)
  2. (* Example OS/2 Presentation Manager Program adapted from the book            *)
  3. (* "OS/2 Presentation Manager - Programming Primer" by Asael Dror &           *)
  4. (* Robert Lafore                                                              *)
  5. (*                                                                            *)
  6. (* Example programs converted to JPI Modula-2 Version 2 for OS/2 1.2 by       *)
  7. (* Chris Barker, October 1990                                                 *)
  8. (*                                                                            *)
  9. (* Notes:  I am distributing these programs so that others can learn and also *)
  10. (*         so I can elicit feedback from the user community on programming for*)
  11. (*         OS/2 PM using Modula-2.  If your have any questions, suggestions,  *)
  12. (*         or comments I'd love to hear from you.  I may be reached at the    *)
  13. (*         following addresses:                                               *)
  14. (*                                                                            *)
  15. (*         Compuserve ID: 72261,2312                                          *)
  16. (*         Pete Norloff's OS/2 Shareware BBS - (703) 385-4325                 *)
  17. (*         Max's Doghouse BBS - (703) 548-7849                                *)
  18. (*           The above two BBS carry the Fidonet OS/2 echo which I read       *)
  19. (*           regularly.                                                       *)
  20. (*         Programmer's Corner - (301) 596-1180                               *)
  21. (*         CPCUG Mix (Window Sig) BBS - (301) 738-9060                        *)
  22. (*                                                                            *)
  23. (*         I hope I hear from you!                                            *)
  24. (*                                                                            *)
  25. (*               - Chris                                                      *)
  26. (*                                                                            *)
  27. (*----------------------------------------------------------------------------*)
  28.  
  29. (*----------------------------------------------------------------------------*)
  30. (*  Program Notes:                                                            *)
  31. (*  Page 187.                                                                 *)
  32. (*  The follwing definition should be set to true in the DOS.DEF file inorder *)
  33. (*  to compile this program.                                                  *)
  34. (*                                                                            *)
  35. (* OS/2 Kernel Dos calls -----------------------------------------------      *)
  36. (* Conditional sections, set to TRUE if required ------------------------     *)
  37. (* CONST                                                                      *)
  38. (*  i_RESOURCE        = TRUE;    (* GetResource *)                            *)
  39. (*----------------------------------------------------------------------------*)
  40.  
  41. (*# call(same_ds => off) *)
  42. (*# data(heap_size=> 3000) *)
  43.  
  44. MODULE CUSTOM;
  45.  
  46. IMPORT OS2DEF,Win,Gpi,Dos,Lib,SYSTEM;
  47. FROM OS2DEF IMPORT HDC,HRGN,HAB,HPS,HBITMAP,HWND,HMODULE,HSEM,
  48.                    POINTL,RECTL,PID,TID,LSET,NULL,
  49.                    COLOR,NullVar,NullStr,BOOL,SEL;
  50. FROM OS2MAC IMPORT SHORT1FROMMP,SHORT2FROMMP,MPFROMSHORT,MPFROM2SHORT,
  51.                    MAKEP;
  52.  
  53. TYPE
  54.   StrPtr = POINTER TO ARRAY[0..0] OF CHAR;
  55.   SelText = POINTER TO ARRAY[0..0] OF CHAR;
  56.  
  57. CONST
  58.   szClientClass = 'Client Window';
  59.   ID_FRAMERC    = 1;
  60.   ID_TITLE      = 2;
  61.   LONGSTRINGRC  = 1000;
  62.   ID_MSG        = 101;
  63.   STRINGLEN     = 271;
  64.  
  65. VAR
  66.   hptr          : Win.HPOINTER;
  67.   rslt          : INTEGER;
  68.   hab           : HAB;
  69.   hmq           : Win.HMQ;
  70.   qmsg          : Win.QMSG;
  71.   hwndClient,
  72.   hwnd          : HWND;
  73.   r             : Win.MRESULT;
  74.   flcreateFlags : LSET;
  75.   szBuf         : ARRAY [0..257] OF CHAR;
  76.   selURC        : SEL;
  77.  
  78. (*--------------------  Error reporting procedure  ---------------------*)
  79. PROCEDURE Error;
  80. VAR
  81. BEGIN
  82. END Error;
  83.  
  84. (*--------------------  Start of window procedure  ---------------------*)
  85. (*# save,call(near_call=>off,reg_param=>(),reg_saved=>(di,si,ds,es,st1,st2)) *)
  86.  
  87. PROCEDURE ClientWinProc(hwnd : HWND;
  88.                         msg:CARDINAL;
  89.                         mp1,mp2:Win.MPARAM)
  90.                         : Win.MRESULT;
  91.  
  92.  
  93. VAR
  94.   hps   : HPS;
  95.   rectl : RECTL;
  96.   retcode : CARDINAL;
  97.  
  98. BEGIN
  99.   CASE msg OF
  100.     | Win.WM_CREATE :
  101.         Dos.GetResource(NULL,LONGSTRINGRC,ID_MSG,selURC);
  102.  
  103.     | Win.WM_PAINT :
  104.         hps := Win.BeginPaint(hwnd,HPS(NULL),RECTL(NullVar));
  105.         Win.QueryWindowRect(hwnd,rectl);
  106.         Win.DrawText(hps,STRINGLEN,SelText(MAKEP(selURC,0))^,rectl,0,0,
  107.                      Win.DT_CENTER+Win.DT_VCENTER+Win.DT_ERASERECT+
  108.                      Win.DT_TEXTATTRS);
  109.         Win.EndPaint(hps);
  110.  
  111.   ELSE
  112.     RETURN Win.DefWindowProc(hwnd, msg, mp1, mp2)
  113.   END;
  114.   RETURN Win.MPARAM(FALSE);
  115. END ClientWinProc;
  116.  
  117. (*# restore *)
  118. (*---------------------  End of window procedure  ----------------------*)
  119.  
  120. BEGIN
  121.   flcreateFlags := Win.FCF_TITLEBAR + Win.FCF_SYSMENU + Win.FCF_SIZEBORDER +
  122.                    Win.FCF_MINMAX + Win.FCF_SHELLPOSITION + Win.FCF_TASKLIST +
  123.                    Win.FCF_ICON;
  124.  
  125.   hab := Win.Initialize(NULL);
  126.   hmq := Win.CreateMsgQueue(hab,0);
  127.  
  128.   rslt := Win.LoadString(hab,NULL,ID_TITLE,SIZE(szBuf),szBuf);
  129.  
  130.   IF NOT Win.RegisterClass(             (* Register window class        *)
  131.      hab,                               (* Anchor block handle          *)
  132.      szClientClass,                     (* Window class name            *)
  133.      ClientWinProc,                  (* Address of window procedure  *)
  134.      Win.CS_SIZEREDRAW,
  135.      0                                  (* No extra window words        *)
  136.      ) THEN Error END;
  137.  
  138.   hwnd := Win.CreateStdWindow(
  139.               Win.HWND_DESKTOP,
  140.               Win.WS_VISIBLE,
  141.               flcreateFlags,
  142.               szClientClass,
  143.               szBuf,
  144.               0,
  145.               NULL,
  146.               0,
  147.               hwndClient);
  148.  
  149.  
  150.   WHILE (Win.GetMsg(hab,qmsg,HWND(NULL),0,0)) DO
  151.     r := Win.DispatchMsg(hab,qmsg);
  152.   END;
  153.  
  154.   IF NOT Win.DestroyWindow(hwnd) THEN      (* and                          *)
  155.     Error;
  156.   END;
  157.  
  158.   IF NOT Win.DestroyMsgQueue(hmq) THEN      (* and                          *)
  159.     Error;
  160.   END;
  161.  
  162.   IF NOT Win.Terminate(hab) THEN            (* terminate the application    *)
  163.     Error;
  164.   END;
  165.  
  166.   HALT;
  167.  
  168. END CUSTOM.
  169.