home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: Graphics / Graphics.zip / os2apipm.zip / APIEXAM / MOU2.ADB < prev    next >
Encoding:
Text File  |  1996-07-16  |  3.3 KB  |  88 lines
  1. --  event2
  2. with os2; use os2;
  3. with os2.vio; use os2.vio;
  4. with os2.mou; use os2.mou;
  5. with builtin; use builtin;
  6. procedure mou2 is
  7.  
  8. BUTTON2 :constant ushort:= 16#10#; --  bit 4 : buttton 2 push
  9. UPPER   :constant ushort:=   5   ;
  10. LOWER   :constant ushort:=  15   ;
  11. LEFT    :constant ushort:=   5   ;
  12. RIGHT   :constant ushort:=  31   ;
  13.  
  14. str1 :constant string(1..15):= "Test Test Test" & character'val(0);
  15. len  :aliased ushort := ushort(str1'length);
  16. Blank   : array(0..1) of aliased byte := ( 16#20#,16#07#);
  17.                                         -- blank ,normal attribute
  18.                                         -- clear screen
  19. Fill    : array(0..1) of aliased byte := ( 16#20#,16#17#);
  20.     -- blank , blue
  21. MouHandle : aliased  ushort ;               -- mouse handle
  22. Event     : aliased  MOUEVENTINFO ;
  23. ReadType  : aliased ushort := 1;      --  0 - no wait, 1 - wait
  24.  
  25. MouPos    : aliased PTRLOC ;          --  mouse place
  26. OldCur    : aliased VIOCURSORINFO;    --  old cursor
  27. Cursor    : aliased VIOCURSORINFO;    --  new cursor
  28. row       : ushort;
  29. rc : apiret16    ;                    --  return code
  30. text : string(1..27) := "Event=... row =... col =..." ;
  31. pos  : string(1..3) ;
  32. begin
  33. rc:=  VioScrollUp(0 ,0 ,-1 ,-1 ,-1 ,Blank(0)'unchecked_access ,0 );
  34.  
  35.  
  36.  
  37. rc:=  VioGetCurType( OldCur'unchecked_access, 0 ); -- get old cursor
  38. Cursor.yStart :=  0 ;               -- doing
  39. Cursor.cEnd   :=  0 ;               -- current
  40. Cursor.cx     :=  1 ;               -- cursor
  41. Cursor.attr   := -1 ;               -- invisible
  42.  
  43. rc:=  VioSetCurType( Cursor'unchecked_access, 0 );
  44.  
  45.                                         -- get mouse handle
  46. if MouOpen( system.null_address, MouHandle'unchecked_access) > 0 then
  47.    put_edit("MouOpen error rc=",integer(rc)); goto fin ;
  48. end if;
  49.  
  50. MouPos.col := 40;                  -- cursor position
  51. MouPos.row :=  5;
  52. if MouSetPtrPos( MouPos'unchecked_access, MouHandle ) > 0 then
  53.    put_edit("MouSetPtrPos error rc=",integer(rc)); goto fin ;
  54. end if;
  55.                                         -- draw standard mouse
  56. if MouDrawPtr( MouHandle ) > 0 then
  57.    put_edit("MouDrawPtr error rc=",integer(rc)); goto fin;
  58. end if;
  59.                                         -- light region
  60. for  row in UPPER..LOWER loop
  61.   rc:=    VioWrtNCell( Fill(0)'unchecked_access, RIGHT-LEFT+1, row, LEFT, 0 );
  62. end loop;
  63.                                         -- title
  64.  
  65. rc:=    VioWrtCharStr(str1         ,len  , UPPER+1, LEFT+1, 0 );
  66.  
  67. loop --    wait mouse event
  68.   if MouReadEventQue( Event'unchecked_access,
  69.                       ReadType'unchecked_access,
  70.                       MouHandle ) > 0 then
  71.      put_edit("MouReadEventQue error rc=",integer(rc)); goto fin;
  72.   end if;
  73.   rc:= MouGetPtrPos( MouPos'unchecked_access, MouHandle );
  74.   pos := put_i( integer(Event.fs),3);  overlay(text, 7,pos);
  75.   pos := put_i(integer(MouPos.row),3); overlay(text,16,pos);
  76.   pos := put_i(integer(MouPos.col),3); overlay(text,25,pos);
  77.   -- write current mouse information
  78.   rc  := VioWrtCharStr(text         ,27   , UPPER+3, LEFT  , 0 );
  79.  
  80.   if  Event.fs = BUTTON2   then exit; end if;  -- right buutton
  81.  
  82. end loop ;
  83. rc:=  MouClose( MouHandle );            -- free mouse handle
  84. rc:=  VioSetCurType(OldCur'unchecked_access, 0 ); -- restore old cursor
  85.  
  86. <<fin>> null;
  87. end mou2;
  88.