home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / mcedit / bobmouse.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-04-11  |  9.6 KB  |  416 lines
  1. UNIT BobMouse;
  2.  
  3. INTERFACE
  4.  
  5. USES DOS;
  6.  
  7. type
  8.   cursormasktype = ARRAY[0..1,0..15] of word;
  9.  
  10. var
  11.   cursormask : cursormasktype;
  12.  
  13. PROCEDURE MouseCall(VAR M1,M2,M3,M4 : Word); { general mouse function to  }
  14.                                              { make calls not included in }
  15.                                              { this unit.                 }
  16. FUNCTION  IsLogitechMouse : Boolean;                  { Looks at driver }
  17. PROCEDURE MouseReset;                  { Standard Mouse function call 0 }
  18. FUNCTION  GetNumberOfMouseButtons : Integer;                        { 0 }
  19. PROCEDURE ShowMouse;                                                { 1 }
  20. PROCEDURE HideMouse;                                                { 2 }
  21. PROCEDURE PollMouse(VAR X,Y : Word;
  22.                     VAR Left, Right, Both : Boolean);               { 3 }
  23. PROCEDURE MouseToXY(X,Y : Word);                                    { 4 }
  24. PROCEDURE SetColumnRange(High,Low : Word);                          { 7 }
  25. PROCEDURE SetRowRange(High,Low : Word);                             { 8 }
  26. PROCEDURE SetMouseGraphCursorTo(cursormask : cursormasktype;
  27.                                 x, y : integer);
  28. PROCEDURE HandMouse;                                                { 9 }
  29. PROCEDURE WatchMouse;
  30. PROCEDURE ConditionalOff(x1,y1,x2,y2: Word);                        { 16 }
  31. FUNCTION MouseIsInstalled : Boolean;
  32. FUNCTION GetMouseVersion : string;                                  { 36 }
  33. FUNCTION GetMouseType : string;                                     { 36 }
  34. FUNCTION GetMouseIRQ : string;                                      { 36 }
  35.  
  36. {-------------------------------------------------------------------------}
  37.  
  38. IMPLEMENTATION
  39.  
  40. var
  41.   M1,M2,M3,M4 : Word;
  42.  
  43. {-------------------------------------------------------------------------}
  44.  
  45. PROCEDURE MouseCall(VAR M1,M2,M3,M4 : WORD);
  46.  
  47. VAR
  48.   Regs : registers;
  49.  
  50. BEGIN
  51.   WITH Regs DO
  52.     BEGIN
  53.       AX := M1; BX := M2; CX := M3; DX := M4
  54.     END;
  55.   Intr($33,Regs);
  56.   WITH Regs DO
  57.     BEGIN
  58.       M1 := AX; M2 := BX; M3 := CX; M4 := DX
  59.     END
  60. END;
  61.  
  62. {-------------------------------------------------------------------------}
  63.  
  64. FUNCTION GetNumberOfMouseButtons : Integer;
  65.  
  66. BEGIN
  67.   M1 := 0;  { Must reset mouse to count buttons! }
  68.   MouseCall(M1,M2,M3,M4);
  69.   GetNumberOfMouseButtons := M2
  70. END;
  71.  
  72. {-------------------------------------------------------------------------}
  73.  
  74. FUNCTION MouseIsInstalled : Boolean;
  75.  
  76. TYPE
  77.   BytePtr = ^Byte;
  78.  
  79. VAR
  80.   TestVector : BytePtr;
  81.  
  82. BEGIN
  83.   GetIntVec(51,Pointer(TestVector));
  84.   { $CF is the binary opcode for the IRET instruction; }
  85.   { in many BIOSes, the startup code puts IRETs into   }
  86.   { most unused bectors. }
  87.   IF (TestVector = NIL) OR (TestVector^ = $CF) THEN
  88.     MouseIsInstalled := False
  89.   ELSE
  90.     MouseIsInstalled := True
  91. END;
  92.  
  93. {-------------------------------------------------------------------------}
  94.  
  95. FUNCTION IsLogitechMouse : Boolean;
  96.  
  97. TYPE
  98.   Signature = ARRAY[0..13] OF Char;
  99.   SigPtr = ^Signature;
  100.  
  101. CONST LogitechSig : Signature = 'LOGITECH MOUSE';
  102.  
  103. VAR
  104.   TestVector : SigPtr;
  105.   L          : LongInt;
  106.  
  107. BEGIN
  108.   GetIntVec(51,Pointer(TestVector));
  109.   LongInt(TestVector) := LongInt(TestVector) + 16;
  110.   IF TestVector^ = LogitechSig THEN
  111.     IsLogitechMouse := True
  112.   ELSE
  113.     IsLogitechMouse := False
  114. END;
  115.  
  116. {-------------------------------------------------------------------------}
  117.  
  118. PROCEDURE MouseReset;
  119.  
  120. BEGIN
  121.   M1 := 0;
  122.   MouseCall(M1,M2,M3,M4);
  123. END;
  124.  
  125. {-------------------------------------------------------------------------}
  126.  
  127. PROCEDURE ShowMouse;
  128.  
  129. BEGIN
  130.   M1 := 1;
  131.   MouseCall(M1,M2,M3,M4)
  132. END;
  133.  
  134. {-------------------------------------------------------------------------}
  135.  
  136. PROCEDURE HideMouse;
  137.  
  138. BEGIN
  139.   M1 := 2;
  140.   MouseCall(M1,M2,M3,M4)
  141. END;
  142.  
  143. {-------------------------------------------------------------------------}
  144.  
  145. PROCEDURE PollMouse(VAR X,Y : Word; VAR Left,Right,Both : Boolean);
  146.  
  147. BEGIN
  148.   M1 := 3;              { Perform mouse function call 3 }
  149.   MouseCall(M1,M2,M3,M4);
  150.   X := M3; Y := M4;     { Return mouse pointer X,Y position }
  151.   IF (M2 AND $01) = $01 THEN Left := True ELSE Left := False;
  152.   IF (M2 AND $02) = $02 THEN Right := True ELSE Right := False;
  153.   IF (M2 AND $04) = $03 THEN Both := True ELSE Both := False;
  154. END;
  155.  
  156. {-------------------------------------------------------------------------}
  157.  
  158. PROCEDURE MouseToXY(X,Y : Word);
  159.  
  160. BEGIN
  161.   M1 := 4;
  162.   M3 := X; M4 := Y;
  163.   MouseCall(M1,M2,M3,M4)
  164. END;
  165.  
  166. {-------------------------------------------------------------------------}
  167.  
  168. PROCEDURE SetColumnRange(High,Low : Word);
  169.  
  170. BEGIN
  171.   M1 := 7;
  172.   M3 := Low;
  173.   M4 := High;
  174.   MouseCall(M1,M2,M3,M4)
  175. END;
  176.  
  177. {-------------------------------------------------------------------------}
  178.  
  179. PROCEDURE SetRowRange(High,Low : Word);
  180.  
  181. BEGIN
  182.   M1 := 8;
  183.   M3 := Low;
  184.   M4 := High;
  185.   MouseCall(M1,M2,M3,M4)
  186. END;
  187.  
  188. {-------------------------------------------------------------------------}
  189.  
  190. PROCEDURE SetMouseGraphCursorTo(cursormask : cursormasktype; x, y : integer);
  191.  
  192. var
  193.   Regs : Registers;
  194.  
  195. BEGIN
  196.   M1 := 9;
  197.   M2 := x;
  198.   M3 := y;
  199.   regs.DX := ofs(cursormask);
  200.   regs.ES := seg(cursormask);
  201.   WITH Regs DO
  202.     BEGIN
  203.       AX := M1; BX := M2; CX := M3;
  204.     END;
  205.   Intr(51,Regs);
  206. END;
  207.  
  208. {-------------------------------------------------------------------------}
  209.  
  210. PROCEDURE ConditionalOff(x1,y1,x2,y2: Word);  { 16 }
  211.  
  212. var
  213.   Regs : Registers;
  214.  
  215. BEGIN
  216.   WITH Regs DO
  217.     BEGIN
  218.       AX := 16; CX := x1; DX := y1; SI := x2; DI := y2;
  219.     END;
  220.   Intr(51,Regs);
  221. END;
  222.  
  223. {-------------------------------------------------------------------------}
  224.  
  225. FUNCTION GetMouseVersion : string;  {36}
  226.  
  227. var
  228.   verdec : integer;
  229.   s : string;
  230.  
  231.  
  232.   function IntToHex(IntNum: Integer): String;
  233.  
  234.   const
  235.     HexChars: array[0..15] of char = '0123456789ABCDEF';
  236.  
  237.   var
  238.     Temp : byte;
  239.     TempStr : string[2];
  240.  
  241.   begin
  242.     Temp := hi(intNum);
  243.     TempStr := HexChars[Temp shr 4] + HexChars[Temp and $0F];
  244.     Temp := lo(intNum);
  245.     IntToHex := TempStr + HexChars[Temp shr 4] + HexChars[Temp and $0F];
  246.   end;
  247.  
  248.  
  249. BEGIN
  250.   M1 := 36;
  251.   MouseCall(M1,M2,M3,M4);
  252.   verdec := M2;
  253.   s := IntToHex(verdec);
  254.   Insert('.',s,3);
  255.   if s[1] = '0' then s := Copy(s,2,4);
  256.   GetMouseVersion := s;
  257. END;
  258.  
  259. {-------------------------------------------------------------------------}
  260.  
  261. FUNCTION GetMouseType : string;  {36}
  262.  
  263. var
  264.   Mtype : byte;
  265.  
  266. BEGIN
  267.   M1 := 36;
  268.   MouseCall(M1,M2,M3,M4);
  269.   Mtype := hi(M3);
  270.   case Mtype of
  271.     1 : GetMouseType := 'bus mouse';
  272.     2 : GetMouseType := 'serial mouse';
  273.     3 : GetMouseType := 'InPort mouse';
  274.     4 : GetMouseType := 'PS/2 mouse';
  275.     5 : GetMouseType := 'Hewlett-Packard mouse';
  276.   else
  277.     GetMouseType := 'unknown mouse';
  278.   end; {case}
  279.   if IsLogitechMouse then GetMouseType := 'Logitech mouse';
  280. END;
  281.  
  282. {-------------------------------------------------------------------------}
  283.  
  284. FUNCTION GetMouseIRQ : string;  {36}
  285.  
  286. var
  287.   IRQnumber : byte;
  288.  
  289. BEGIN
  290.   M1 := 36;
  291.   MouseCall(M1,M2,M3,M4);
  292.   IRQnumber := lo(M3);
  293.   case IRQnumber of
  294.     0 : GetMouseIRQ := 'PS/2';
  295.     2 : GetMouseIRQ := '2';
  296.     3 : GetMouseIRQ := '3';
  297.     4 : GetMouseIRQ := '4';
  298.     5 : GetMouseIRQ := '5';
  299.     7 : GetMouseIRQ := '7';
  300.   else
  301.     GetMouseIRQ := 'unable to determin IRQ';
  302.   end; {case}
  303. END;
  304.  
  305. {-------------------------------------------------------------------------}
  306.  
  307. PROCEDURE HandMouse;
  308.  
  309. var
  310.   handmasks : array[0..1,0..15] of word;
  311.   Regs : Registers;
  312.  
  313. BEGIN
  314.   handmasks[0,0] := $0;
  315.   handmasks[0,1] := $0;
  316.   handmasks[0,2] := $0;
  317.   handmasks[0,3] := $0;
  318.   handmasks[0,4] := $0;
  319.   handmasks[0,5] := $0;
  320.   handmasks[0,6] := $0;
  321.   handmasks[0,7] := $0;
  322.   handmasks[0,8] := $0;
  323.   handmasks[0,9] := $0;
  324.   handmasks[0,10] := $0;
  325.   handmasks[0,11] := $0;
  326.   handmasks[0,12] := $0;
  327.   handmasks[0,13] := $0;
  328.   handmasks[0,14] := $0;
  329.   handmasks[0,15] := $0;
  330.   handmasks[1,0] := $0;
  331.   handmasks[1,1] := $0;
  332.   handmasks[1,2] := $0;
  333.   handmasks[1,3] := $0;
  334.   handmasks[1,4] := $0;
  335.   handmasks[1,5] := $0;
  336.   handmasks[1,6] := $0;
  337.   handmasks[1,7] := $0;
  338.   handmasks[1,8] := $0;
  339.   handmasks[1,9] := $0;
  340.   handmasks[1,10] := $0;
  341.   handmasks[1,11] := $0;
  342.   handmasks[1,12] := $0;
  343.   handmasks[1,13] := $0;
  344.   handmasks[1,14] := $0;
  345.   handmasks[1,15] := $0;
  346.   M1 := 9;
  347.   M2 := 8;
  348.   M3 := 8;
  349.   regs.DX := ofs(handmasks);
  350.   regs.ES := seg(handmasks);
  351.   WITH Regs DO
  352.     BEGIN
  353.       AX := M1; BX := M2; CX := M3;
  354.     END;
  355.   Intr(51,Regs);
  356. END;
  357.  
  358. {-------------------------------------------------------------------------}
  359.  
  360. PROCEDURE WatchMouse;
  361.  
  362. var
  363.   watch : array[0..1,0..15] of word;
  364.   Regs : Registers;
  365.  
  366. BEGIN
  367.   watch[0,0] := $FFFF;
  368.   watch[0,1] := $F00F;
  369.   watch[0,2] := $F00F;
  370.   watch[0,3] := $F00F;
  371.   watch[0,4] := $F00F;
  372.   watch[0,5] := $C003;
  373.   watch[0,6] := $8001;
  374.   watch[0,7] := $0;
  375.   watch[0,8] := $0;
  376.   watch[0,9] := $0;
  377.   watch[0,10] := $8001;
  378.   watch[0,11] := $C003;
  379.   watch[0,12] := $F00F;
  380.   watch[0,13] := $F00F;
  381.   watch[0,14] := $F00F;
  382.   watch[0,15] := $F00F;
  383.   watch[1,0] := $0;
  384.   watch[1,1] := $5A0;
  385.   watch[1,2] := $5A0;
  386.   watch[1,3] := $420;
  387.   watch[1,4] := $3C0;
  388.   watch[1,5] := $FF0;
  389.   watch[1,6] := $3E7C;
  390.   watch[1,7] := $7E7E;
  391.   watch[1,8] := $7E02;
  392.   watch[1,9] := $7FFE;
  393.   watch[1,10] := $3FFC;
  394.   watch[1,11] := $FF0;
  395.   watch[1,12] := $3C0;
  396.   watch[1,13] := $420;
  397.   watch[1,14] := $5A0;
  398.   watch[1,15] := $5A0;
  399.   M1 := 9;
  400.   M2 := 8;
  401.   M3 := 0;
  402.   regs.DX := ofs(WATCH);
  403.   regs.ES := seg(WATCH);
  404.   WITH Regs DO
  405.     BEGIN
  406.       AX := M1; BX := M2; CX := M3;
  407.     END;
  408.   Intr(51,Regs);
  409. END;
  410.  
  411. {-------------------------------------------------------------------------}
  412.  
  413. BEGIN
  414. END.  {Mouse}
  415.  
  416.