home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / magazine / insidetp / 1990_05 / mouse.pas < prev    next >
Pascal/Delphi Source File  |  1990-04-16  |  3KB  |  173 lines
  1. UNIT Mouse;
  2.  
  3. {Program:   Master Mouse Routine Library}
  4.  
  5. INTERFACE
  6.  
  7. USES DOS;
  8.  
  9. CONST
  10.  
  11.   {Button press definitions}
  12.  
  13.    PrL = 1;
  14.    PrR = 2;
  15.    PrLr = 3;
  16.    PrM = 4;
  17.    PrLM = 5;
  18.    PrMR = 6;
  19.    PrAll = 7;
  20.    PrNone = 0;
  21.  
  22.   {Button definitions}
  23.  
  24.    ButtonLeft = 0;
  25.    ButtonRight = 1;
  26.    ButtonMiddle = 2;
  27.  
  28.  
  29. FUNCTION ThereIsAMouse: Boolean;
  30. FUNCTION MouseReset: Boolean;
  31. FUNCTION GetMouseStatus
  32.          (VAR MPosX, MPosY: Byte): Byte;
  33.  
  34. PROCEDURE ClearButton (Button: Byte);
  35. PROCEDURE MouseOn;
  36. PROCEDURE MouseOff;
  37. PROCEDURE SetMouseSoftCursor
  38.    (MouseChar, MouseFGColor, MouseBGColor: Byte);
  39.  
  40. IMPLEMENTATION
  41.  
  42. CONST
  43.    MouseIntr = $33;
  44.  
  45. VAR
  46.    MouseVisible             : Boolean;
  47.    MHMax, MVMax, MHCell, MVCell     : Word;
  48.    Regs : Registers;
  49.  
  50. PROCEDURE MouseHandler (A, B, C, D: Byte);
  51.    BEGIN
  52.       WITH Regs DO
  53.             BEGIN
  54.                 ax := A;
  55.                 bx := B;
  56.                 cx := C;
  57.                 dx := D;
  58.                 Intr(MouseIntr, Regs)
  59.             END
  60.    END;
  61.  
  62. FUNCTION GetButtonUpStatus
  63.   (Button: Byte;VAR MPosX, MPosY: Word): Boolean;
  64.  
  65.    BEGIN
  66.       WITH Regs DO
  67.             BEGIN
  68.                 ax := 6;
  69.                 bx := Button;
  70.                 MouseHandler(ax, bx, 0, 0);
  71.                 MPosX := cx DIV MHCell + 1;
  72.                 MPosY := dx DIV MVCell + 1;
  73.                 IF ax = 0 THEN
  74.                     GetButtonUpStatus := TRUE
  75.                 ELSE
  76.                     GetButtonUpStatus := FALSE
  77.             END
  78.    END;
  79.  
  80. PROCEDURE ClearButton (Button: Byte);
  81. VAR
  82.    MPosX,MPosY: Word;
  83.  
  84.    BEGIN
  85.       REPEAT UNTIL
  86.           GetButtonUpStatus(Button, MPosX,MPosY)
  87.    END;
  88.  
  89. FUNCTION GetMouseStatus
  90.          (VAR MPosX, MPosY: Byte): Byte;
  91.    BEGIN
  92.       WITH Regs DO
  93.             BEGIN
  94.                 ax := 3;
  95.                 MouseHandler(ax, 0, 0, 0);
  96.                 GetMouseStatus := bx;
  97.                 MPosX := cx DIV MHCell + 1;
  98.                 MPosY := dx DIV MVCell + 1
  99.             END
  100.    END;
  101.  
  102. PROCEDURE MouseOff;
  103.    BEGIN
  104.       IF MouseVisible THEN
  105.             BEGIN
  106.                 MouseHandler(2, 0, 0, 0);
  107.                 MouseVisible := FALSE
  108.             END
  109.    END;
  110.  
  111. PROCEDURE MouseOn;
  112.    BEGIN
  113.       IF NOT MouseVisible THEN
  114.             BEGIN
  115.                 MouseHandler(1, 0, 0, 0);
  116.                 MouseVisible := TRUE
  117.             END
  118.    END;
  119.  
  120. FUNCTION MouseReset: Boolean;
  121.    BEGIN
  122.       MHMax := 639; {Max virtual horizontal pos}
  123.       MVMax := 199; {Max virtual vertical pos}
  124.       MHCell := 8;  {Mouse horizontal cell width}
  125.       MVCell := 8;  {Mouse vertical cell height}
  126.       MouseHandler(0, 0, 0, 0);
  127.       IF Regs.ax = 0 THEN
  128.          MouseReset := FALSE
  129.       ELSE
  130.          MouseReset := TRUE;
  131.             MouseVisible := FALSE
  132.    END;
  133.  
  134. PROCEDURE SetMouseSoftCursor
  135.    (MouseChar, MouseFGColor, MouseBGColor: Byte);
  136.    BEGIN
  137.       MouseOn;
  138.       Regs.ax := 10;
  139.       Regs.bx := 0; {Select software cursor}
  140.    {Screen Mask Value (don't change character)}
  141.       Regs.cx := $8800;
  142.       Regs.dx := $8800 + MouseBGColor * 4096 +
  143.                   MouseFGColor * 256 + MouseChar;
  144.       Intr($33,Regs);
  145.       MouseOff
  146.    END;
  147.  
  148. FUNCTION ThereIsAMouse: Boolean;
  149. CONST
  150.    IRET = 207;
  151. VAR
  152.    MouseSegment : Word ABSOLUTE $0000:$00CE;
  153.    MouseOffset : Word ABSOLUTE $0000:$00CC;
  154.    MouseInstruction: Byte;
  155.    BEGIN
  156.       IF (MouseSegment = 0) AND
  157.            (MouseOffset = 0) THEN
  158.          ThereIsAMouse := FALSE
  159.       ELSE
  160.             BEGIN
  161.                 MouseInstruction :=
  162.                    MEM[MouseSegment:MouseOffset];
  163.                 IF MouseInstruction = IRET THEN
  164.                     ThereIsAMouse := FALSE
  165.                 ELSE
  166.                     ThereIsAMouse := TRUE
  167.             END
  168.    END;
  169.  
  170. {No initialization section}
  171.  
  172. END.
  173.