home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / magazine / insidetp / 1990_05 / calmouse.pas < prev    next >
Pascal/Delphi Source File  |  1990-04-16  |  3KB  |  161 lines
  1. PROGRAM CalMouse; {Exercise the mouse}
  2.  
  3. USES DOS,mouse,CRT;
  4.  
  5. VAR
  6.    Buttons, MPosX, MPosY, MouseCharacter,
  7.    FGColor, BGColor : Byte;
  8.  
  9. PROCEDURE CursorOn; {Flips cursor on}
  10. VAR Regs : Registers;
  11.    BEGIN
  12.       WITH Regs DO
  13.             BEGIN
  14.                 AH := 3;
  15.                 BH := 0;
  16.                 Intr($10,Regs);
  17.                 CH := CH AND $0F;
  18.                 AH := 1;
  19.                 Intr($10,Regs)
  20.             END
  21.    END;
  22.  
  23. PROCEDURE CursorOff; {Turns cursor off}
  24. VAR Regs : Registers;
  25.    BEGIN
  26.       WITH Regs DO
  27.             BEGIN
  28.                 AH := 3;
  29.                 BH := 0;
  30.                 Intr($10,Regs);
  31.                 CH := CH OR $20;
  32.                 AH := 1;
  33.                 Intr($10,Regs)
  34.             END
  35.    END;
  36.  
  37. PROCEDURE RevVideo; {Ignores intensity}
  38.    BEGIN
  39.       TextColor(BGColor); TextBackground(FGColor)
  40.    END;
  41.  
  42. PROCEDURE DspButtons (Buttons, PX, PY: Byte);
  43.    BEGIN
  44.       GotoXY(49,24);
  45.       CASE Buttons OF
  46.             PrMR:      Write('Middle & right');
  47.             PrNone:  Write('None          ');
  48.             PrL:      Write('Left          ');
  49.             PrR:      Write('Right         ');
  50.             PrLr:      Write('Left & right  ');
  51.             PrM:      Write('Middle        ');
  52.             PrLM:      Write('Left & middle ');
  53.             PrAll:      Write('All           ');
  54.             ELSE      Write('Unknown ',Buttons:3)
  55.         END;
  56.  
  57.         GotoXY(70, 24); Write(PX:2);
  58.         GotoXY(79, 24); Write(PY:2)
  59.    END;
  60.  
  61. FUNCTION IsMono: Boolean;
  62.    BEGIN
  63.       IsMono := (Lastmode = Mono)
  64.    END;
  65.  
  66. PROCEDURE SetUpGrid;
  67. VAR
  68.    I : Byte;
  69.    BEGIN
  70.       GotoXY(1, 1);
  71.       FOR I := 1 TO 8 DO Write('1234567890');
  72.       GotoXY(1, 2);
  73.       FOR I := 2 TO 25 DO
  74.             BEGIN
  75.                 GotoXY(1,I); Write(I:2)
  76.             END;
  77.       GotoXY(41, 24); Write('Buttons: ');
  78.       GotoXY(63, 24); Write(' XPos= ');
  79.       GotoXY(72, 24); Write('  YPos=')
  80.    END;
  81.  
  82.    {Main PROGRAM}
  83.  
  84.    BEGIN
  85.       Randomize;
  86.  
  87.       IF IsMono THEN
  88.             FGColor := LightGray
  89.       ELSE
  90.          BEGIN
  91.             TextMode(CO80);
  92.             FGColor := Cyan
  93.          END;
  94.  
  95.       TextColor(FGColor);
  96.       BGColor := Black;
  97.       TextBackground(BGColor);
  98.  
  99.       ClrScr;
  100.       RevVideo;
  101.       IF ThereIsAMouse THEN
  102.             BEGIN
  103.                 WriteLn('Mouse Installed');
  104.                 IF NOT MouseReset THEN
  105.                     BEGIN
  106.                         WriteLn
  107.                   ('Error, no mouse reset');
  108.                         NormVideo; Halt(1)
  109.                     END
  110.                 ELSE
  111.                     WriteLn('Mouse Reset')
  112.                 END
  113.         ELSE
  114.             BEGIN
  115.                 WriteLn('No mouse Installed');
  116.                 NormVideo; Halt(1)
  117.             END;
  118.         Delay(1000);
  119.       CursorOff;
  120.       NormVideo;
  121.       ClrScr;
  122.       RevVideo;
  123.       SetUpGrid;
  124.       GotoXY(1,23);
  125.  
  126.       Write('(Press Left Button to change mouse');
  127.       Write(', Right Button to Quit)           ');
  128.       Write('            ');
  129.       MouseOn;
  130.       ClearButton(ButtonLeft);
  131.       Buttons := PrNone;
  132.       WHILE Buttons <> PrR DO
  133.             BEGIN
  134.                 Buttons:=GetMouseStatus(MPosX, MPosY);
  135.                 DspButtons(Buttons, MPosX, MPosY);
  136.                 IF Buttons = PrL THEN
  137.                     BEGIN
  138.                         MouseCharacter := Random(255);
  139.                         IF NOT IsMono THEN
  140.                             BEGIN
  141.                                 FGColor := Random(7);
  142.                                 BGColor := Random(7)
  143.                             END;
  144.                         SetMouseSoftCursor
  145.                     (MouseCharacter, FGColor, BGColor);
  146.                         MouseOn; GotoXY(40,2);
  147.                         Write('MouseCharacter: ',
  148.                            MouseCharacter:3);
  149.                     GotoXY(40,3);
  150.                     Write('MouseFGColor: ',FGColor:1);
  151.                     GotoXY(40,4);
  152.                     Write('MouseBGColor: ',BGColor:1);
  153.                     ClearButton(ButtonLeft)
  154.                     END
  155.             END;
  156.           MouseOff;
  157.           CursorOn;
  158.           NormVideo;
  159.           ClrScr
  160.    END.
  161.