home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: Graphics / Graphics.zip / os2apipm.zip / APIEXAM / SCROLL.ADB < prev    next >
Text File  |  1996-07-17  |  2KB  |  45 lines
  1. -- scroll
  2. with os2; use os2;
  3. with os2.vio; use os2.vio;
  4. with os2.bse; use os2.bse;
  5. with text_io; use text_io;
  6. procedure scroll is    -- scrolling screen
  7.  
  8.  LINES       :constant ushort :=25;       -- high screen
  9.  LINE_LENGTH :constant ushort :=80;       -- wide screen
  10.  SCR_LENGTH  :constant ushort := LINES * LINE_LENGTH;
  11.  HANDLE      :constant ushort :=0 ;       -- hendle
  12.  HEIGHT      :constant ushort :=10;       -- high window
  13.                        -- strings for window
  14. subtype str6 is string(1..6);
  15. str : array(1..10) of str6 :=("one...","two...","three.","four..","five..",
  16.                              "six...","seven.","eight.","nine..","ten...");
  17. Top       : ushort       := 0;
  18. Left      : ushort       := 0;
  19.             --  first byte => symbol second byte => attribute !!!
  20. Xcell     : array(0..1) of aliased byte  := (16#58#,16#07#); -- normal, 'X'
  21. blank     : array(0..1) of aliased byte  := (16#20#,16#70#); -- inverse, white
  22. TopRow    : ushort       := 10;       -- window
  23. LeftCol   : ushort       := 24;
  24. BotRow    : ushort       := 20;
  25. RightCol  : ushort       := 50;
  26. lines_n   : ushort       := 1;        -- scrolling lines
  27. attr      : uchar        := 16#70#;   -- inverse
  28. rc        : apiret16;                 -- return code
  29. begin
  30.                          -- fill screen  'X'
  31.   rc:=  VioWrtNCell( Xcell(0)'unchecked_access,
  32.                          SCR_LENGTH, Top, Left, HANDLE );
  33.   for j in 1..height loop
  34.                          -- scrolling up
  35.      if  VioScrollUp(TopRow, LeftCol, BotRow, RightCol,
  36.                          lines_n, blank(0)'unchecked_access, HANDLE )>0
  37.      then put("VioScrollUp error"); goto fin; end if;
  38.                          -- print line in window bottom
  39.      if  VioWrtCharStr( str(integer(j)), 6 , BotRow, LeftCol+1, HANDLE ) > 0
  40.      then put("VioWrtCharStr error"); goto fin; end if;
  41.      if  DosSleep(500)=0 then null; end if;    -- pause
  42.   end loop;
  43. <<fin>> null;
  44. end scroll ;
  45.