home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / PM-M2B.ZIP / SCROLL.MOD < prev    next >
Text File  |  1990-10-03  |  8KB  |  220 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, August 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: page 155.                                                  *)
  31. (*----------------------------------------------------------------------------*)
  32.  
  33. (*# call(same_ds => off) *)
  34. (*# data(heap_size=> 3000) *)
  35.  
  36. MODULE SCROLL;
  37.  
  38. IMPORT OS2DEF,Win,Gpi,Dos,Lib,SYSTEM,IO,Str;
  39. FROM OS2DEF IMPORT HDC,HRGN,HAB,HPS,HBITMAP,HWND,HMODULE,HSEM,
  40.                    POINTL,RECTL,PID,TID,LSET,NULL,
  41.                    COLOR,NullVar,NullStr,BOOL ;
  42. FROM OS2MAC IMPORT SHORT1FROMMP,SHORT2FROMMP,MPFROMSHORT,MPFROM2SHORT;
  43.  
  44. TYPE
  45.   StrPtr = POINTER TO ARRAY[0..0] OF CHAR;
  46.  
  47. CONST
  48.   SBM_SETTHUMBSIZE = 2;
  49.   szClientClass = 'Client Window';
  50.   CWPM_CREATE = Win.WM_USER;
  51.   szString    = 'This is a very long line of text that does not '+
  52.                 'not fit in the window, and so should be scrolled in order to see the '+
  53.                 'entire line. Scrolling is done using the scroll bar of the standard '+
  54.                 'window, which is an ownee of the frame, and so transmits its messages to the '+
  55.                 'client window procedure which scrolls the text by redisplaying it in the '+
  56.                 'appropriate location';
  57.  
  58. VAR
  59.   hab           : HAB;
  60.   hmq           : Win.HMQ;
  61.   qmsg          : Win.QMSG;
  62.   hwndScrollBar,
  63.   hwndControl,
  64.   hwndFrame,
  65.   hwndClient,
  66.   client,
  67.   hwnd          : HWND;
  68.   rclText       : RECTL;
  69.   MaxLeft,
  70.   TextLen,
  71.   WindowLen     : CARDINAL;
  72.   r             : Win.MRESULT;
  73.   flcreateFlags : LSET;
  74.  
  75. PROCEDURE Error;
  76. BEGIN
  77. END Error;
  78.  
  79. (*--------------------  Start of window procedure  ---------------------*)
  80. (*# save,call(near_call=>off,reg_param=>(),reg_saved=>(di,si,ds,es,st1,st2)) *)
  81.  
  82. PROCEDURE ClientWinProc(
  83.                        hwnd : HWND;
  84.                        msg:CARDINAL;
  85.                        mp1,mp2:Win.MPARAM)
  86.                        : Win.MRESULT;
  87. VAR
  88.   ptlText : ARRAY [0..Gpi.TXTBOX_COUNT] OF POINTL;
  89.   hps           : HPS;
  90.   fSliderMoved,
  91.   rslt          : BOOLEAN;
  92.  
  93. BEGIN
  94.   CASE msg OF
  95.     | Win.WM_CREATE :
  96.         hwndScrollBar := Win.WindowFromID(Win.QueryWindow(hwnd,Win.QW_PARENT,
  97.                                            B_FALSE),Win.FID_HORZSCROLL);
  98.         hps := Win.GetPS(hwnd);
  99.         Gpi.QueryTextBox(hps,LONGCARD(Str.Length(szString)),szString,
  100.                            Gpi.TXTBOX_COUNT,ptlText);
  101.  
  102.         Win.ReleasePS(hps);
  103.         rclText.yBottom := 0;
  104.         rclText.yTop    := ptlText[Gpi.TXTBOX_TOPLEFT].y -
  105.                            ptlText[Gpi.TXTBOX_BOTTOMLEFT].y;
  106.         TextLen         := CARDINAL(ptlText[Gpi.TXTBOX_TOPRIGHT].x -
  107.                            ptlText[Gpi.TXTBOX_TOPLEFT].x);
  108.         rclText.xLeft := 0;
  109.  
  110.     | Win.WM_SIZE :
  111.         WindowLen := SHORT1FROMMP(mp2);
  112.         rclText.xRight := LONGINT(WindowLen - CARDINAL(rclText.xLeft));
  113.         MaxLeft := WindowLen - TextLen;
  114.         Win.SendMsg(hwndScrollBar,Win.SBM_SETSCROLLBAR,
  115.           MPFROMSHORT(CARDINAL(-rclText.xLeft)),
  116.           MPFROM2SHORT(0,CARDINAL(-LONGINT(MaxLeft))));
  117.         Win.SendMsg(hwndScrollBar,SBM_SETTHUMBSIZE,
  118.           MPFROM2SHORT(WindowLen,TextLen),NULL);
  119.  
  120.     | Win.WM_HSCROLL :
  121.         fSliderMoved := TRUE;
  122.         CASE (SHORT2FROMMP(mp2)) OF
  123.           | Win.SB_LINERIGHT :
  124.               DEC(rclText.xLeft);
  125.  
  126.           | Win.SB_PAGERIGHT :
  127.               rclText.xLeft := rclText.xLeft - LONGINT(WindowLen);
  128.  
  129.           | Win.SB_LINELEFT :
  130.               INC(rclText.xLeft);
  131.  
  132.           | Win.SB_PAGELEFT :
  133.               rclText.xLeft := rclText.xLeft + LONGINT(WindowLen);
  134.  
  135.           | Win.SB_SLIDERTRACK :
  136.               rclText.xLeft := -LONGINT(SHORT1FROMMP(mp2));
  137.  
  138.         ELSE
  139.           fSliderMoved := FALSE;
  140.         END;
  141.         IF (fSliderMoved) THEN
  142.           IF (rclText.xLeft > 0) THEN rclText.xLeft := 0
  143.           ELSIF (rclText.xLeft < LONGINT(MaxLeft)) THEN
  144.             rclText.xLeft := LONGINT(MaxLeft);
  145.           END;
  146.  
  147.           Win.SendMsg(hwndScrollBar,Win.SBM_SETPOS,
  148.                       MPFROMSHORT(CARDINAL(-rclText.xLeft)),NULL);
  149.           Win.InvalidateRect(hwnd,RECTL(NullVar),B_FALSE);
  150.         END;
  151.  
  152.     | Win.WM_PAINT :
  153.         hps := Win.BeginPaint(hwnd,HPS(NULL),RECTL(NullVar));
  154.         Win.DrawText(hps,-1,szString,rclText,0,0,
  155.                      Win.DT_LEFT+Win.DT_VCENTER+Win.DT_ERASERECT+Win.DT_TEXTATTRS);
  156.         Win.EndPaint(hps);
  157.  
  158.     | Win.WM_ERASEBACKGROUND :
  159.        RETURN Win.MPARAM(TRUE);
  160.  
  161.   ELSE
  162.     RETURN Win.DefWindowProc(hwnd,msg,mp1,mp2)
  163.   END;
  164.  
  165.   RETURN Win.MPARAM(FALSE);
  166.  
  167. END ClientWinProc;
  168.  
  169. (*# restore *)
  170. (*---------------------  End of window procedure  ----------------------*)
  171.  
  172. BEGIN
  173.   flcreateFlags := Win.FCF_TITLEBAR + Win.FCF_SYSMENU + Win.FCF_SIZEBORDER +
  174.                    Win.FCF_MINMAX + Win.FCF_SHELLPOSITION + Win.FCF_TASKLIST +
  175.                    Win.FCF_HORZSCROLL;
  176.  
  177.   hab := Win.Initialize(NULL);
  178.   hmq := Win.CreateMsgQueue(hab,0);
  179.  
  180.  
  181.   IF NOT Win.RegisterClass(             (* Register window class        *)
  182.      hab,                               (* Anchor block handle          *)
  183.      szClientClass,                     (* Window class name            *)
  184.      ClientWinProc,                  (* Address of window procedure  *)
  185.      Win.CS_SIZEREDRAW,
  186.      0                                  (* No extra window words        *)
  187.      ) THEN Error END;
  188.  
  189.   hwndFrame := Win.CreateStdWindow(
  190.               Win.HWND_DESKTOP,
  191.               Win.WS_VISIBLE,
  192.               flcreateFlags,
  193.               szClientClass,
  194.               ' - Controls',
  195.               0,
  196.               NULL,
  197.               0,
  198.               hwndClient);
  199.  
  200.  
  201.   WHILE (Win.GetMsg(hab,qmsg,HWND(NULL),0,0)) DO
  202.     r := Win.DispatchMsg(hab,qmsg);
  203.   END;
  204.  
  205.   IF NOT Win.DestroyWindow(hwndFrame) THEN      (* and                          *)
  206.     Error;
  207.   END;
  208.  
  209.   IF NOT Win.DestroyMsgQueue(hmq) THEN      (* and                          *)
  210.     Error;
  211.   END;
  212.  
  213.   IF NOT Win.Terminate(hab) THEN            (* terminate the application    *)
  214.     Error;
  215.   END;
  216.  
  217.   HALT;
  218.  
  219. END SCROLL.
  220.