home *** CD-ROM | disk | FTP | other *** search
/ Collection of Hack-Phreak Scene Programs / cleanhpvac.zip / cleanhpvac / FNTPAK32.ZIP / PASCAL.EXE / DEMOMOUS.PAS < prev    next >
Pascal/Delphi Source File  |  1995-08-16  |  7KB  |  214 lines
  1. {*************************************************************************
  2.  
  3.    DemoMous.PAS                        Copyright 1994 Rob W. Smetana
  4.  
  5.    Demonstrate how to:
  6.  
  7.      1.  Change MOUSE CURSOR SHAPES in TEXT MODE!
  8.  
  9.      2.  Control the COLOR of the mouse cursor.
  10.  
  11.      3.  Use other Font Pak mouse routines:
  12.  
  13.           - Initialize the mouse:          Function rsThereIsAMouse
  14.           - Turn mouse cursor on/off:      Procedure rsShowcursor
  15.                                            Procedure rsHidecursor
  16.           - Poll for mouse movement/click: Function rsButtonPressed
  17.  
  18.      4.  Using Font_Pak.Pas to declare all Font Pak routines -- except
  19.          callable OBJ fonts.
  20.  
  21.  
  22.    IMPORTANT:  Most assembler routines REQUIRE that parameters be passed
  23.                by value.  BUT... 1 routine, rsButtonPressed, requires
  24.                that TWO parameters be passed by REFERENCE -- so we can
  25.                update those parameters.
  26.  
  27. *************************************************************************}
  28.  
  29.  
  30. uses CRT, Font_Pak;             {use Font_Pak.Pas to declare everything}
  31.  
  32. var
  33.   Block, WhichShape, ASCIICode, FG, BG: Integer;    { mouse cursor shapes   }
  34.   Button, LastButton, Row, Col, GFXorText: Integer; { mouse movement/clicks }
  35.   LastRow, LastCol: Integer;                        { track mouse movement  }
  36.   Ch : Char;
  37.  
  38. Procedure DisplayGrid;                  { Put a grid on the screen }
  39.  
  40. Begin
  41.  
  42.   rsHidecursor;                         { turn cursor off when updating screen }
  43.   WriteLn (' Notice the mouse cursor.  And watch what happens to it as you move the mouse');
  44.   WriteLn (' around the CENTER of this grid.  Also, HOLD DOWN a button and move around.');
  45.  
  46.   For Row := 6 to 22 do
  47.       begin
  48.         gotoxy(39,Row);
  49.         Write ('│');
  50.       end;
  51.  
  52.   gotoxy(8,13);
  53.   WriteLn ('───────────────────────────────┼───────────────────────────────');
  54.   rsShowcursor;                         { make the mouse cursor visible }
  55.  
  56. end;
  57.  
  58.  
  59. begin
  60.  
  61.   TextAttr := 31; ClrScr;
  62.  
  63.   fpInitialize; ClrScr;                  {needed in shareware versions only}
  64.  
  65.   FG := Num16Shapes; BG := Num8Shapes;   {use FG and BG temporarily}
  66.  
  67.   WriteLn ('  There are ',FG,' 16-point mouse shapes you may choose from.  There are also');
  68.   WriteLn ('  ',BG,' 8-point shapes.  Press a key to continue.');
  69.   Ch := ReadKey;
  70.  
  71.   ClrScr;
  72.   Block := 0;                           {Use Block temporarily}
  73.   Block := rsThereIsAMouse;             {Is there a mouse? If so, initialize.}
  74.  
  75.   If Block = 0 then                     {0 = no mouse, -1 = there is a mouse }
  76.      Begin
  77.        WriteLn ('Sorry. This demo requires a mouse/mouse driver.  I found none.');
  78.        Ch := ReadKey;
  79.        Halt;
  80.      End;
  81.  
  82.  
  83.   DisplayGrid;                          { display a grid }
  84.  
  85.  
  86.   { now pre-load 4 mouse cursor shapes by changing the shapes of ASCII 1-4 }
  87.  
  88.   Block := 0;                           { use Block 0               }
  89.  
  90.   For ASCIICode := 1 to 4 do
  91.     Begin
  92.       WhichShape := ASCIICode;
  93.       rsLoadMouseCursor (Block, WhichShape, ASCIICode);
  94.    end;
  95.  
  96.  
  97.  { Now loop and change MOUSE CURSOR SHAPES and COLORS.  Press any key to end.}
  98.  
  99.   FG :=15;                              { if you hold down a button, we'll   }
  100.   BG :=4;                               { change mouse colors to white on red}
  101.  
  102.   { First show what the normal mouse cursor looks like. }
  103.  
  104.   Gotoxy(16,4);  Write ('Here''s the NORMAL cursor.    Click a mouse button.');
  105.  
  106.   GFXorText := 0;                       { 0 tells rsButtonPressed to return  }
  107.                                         { text-mode Row & Col; <>0 = Graphics}
  108.  
  109.   { Set GFXorText := 0 to tell rsButtonPressed to return text-mode   }
  110.   { Row & Col; <> 0 = return graphics coordinates.  Use ONLY 0 here! }
  111.   { This demo requires 25 row x 80 column screen coordinates.        }
  112.  
  113.   GFXorText := 0;
  114.  
  115.   rsShowCursor;                         { turn ON the mouse cursor }
  116.   Button := 0;
  117.   Repeat
  118.      Button := rsButtonPressed (Row, Col, GFXorText);
  119.   Until Button > 0;
  120.  
  121.   { Initialize LastRow and LastCol before we enter our main loop. }
  122.  
  123.   LastRow := Row;  LastCol := Col;
  124.  
  125.   Gotoxy(5,25);  Write ('                                       ');
  126.   Gotoxy(16,4);WriteLn ('     Press Escape or Enter to end this demo.       ');
  127.   Gotoxy(60,25);  Write ('Row:      Col:    ');
  128.  
  129.   {
  130.     Loop until you press a key.  While looping, track where the mouse
  131.     cursor is and if a button is pressed.  Change the shape and color
  132.     of the mouse cursor accordingly.
  133.   }
  134.  
  135.   LastButton := 0;                      {wait for a button press to show 1st cursor}
  136.  
  137.   ASCIICode := 1;
  138.   rsSetTextCursorC (ASCIICode);
  139.  
  140.   Repeat
  141.  
  142.     Button := rsButtonPressed (Row, Col, GFXorText);
  143.  
  144.     {If we move the mouse or press a button, change shapes or colors.}
  145.  
  146.     If (LastButton > 0) and ((LastRow <> Row) or (LastCol <> Col)) then
  147.        Begin
  148.  
  149.          Gotoxy(65,25); Write (Row,' ');
  150.          Gotoxy(75,25); Write (Col,' ');
  151.  
  152.          If Row > 12 then               { use a downward pointing arrow }
  153.  
  154.             Begin
  155.                If Col > 39
  156.                   then ASCIICode := 4
  157.                else
  158.                   ASCIICode := 2;
  159.             end
  160.  
  161.          else                           { use an upward pointing arrow }
  162.             Begin
  163.                If Col > 39
  164.                   then ASCIICode := 3
  165.                else
  166.                   ASCIICode := 1;
  167.             end;
  168.  
  169.         { Tell the mouse driver to use ASCII char. ASCIICode as cursor shape }
  170.  
  171.          rsSetTextCursorC (ASCIICode);
  172.  
  173.          LastRow := Row;
  174.          LastCol := Col;
  175.        end;
  176.  
  177.     {
  178.       If a button was pressed (or is held down) change the cursor color.
  179.       Note:  The mouse will flicker if you hold it down.  We could
  180.       eliminate flicker, but doing so wouldn't let us show you how the
  181.       mouse shape/color changes if you move across a grid boundary.
  182.     }
  183.  
  184.     If Button > 0 then
  185.  
  186.        Begin
  187.  
  188.        { use different colors while the button is held down }
  189.        rsSetTextCursor  (FG, BG, ASCIICode);
  190.  
  191.        If Button <> LastButton then
  192.  
  193.          Begin
  194.  
  195.          LastButton := Button;
  196.          Gotoxy(5,25);  Write ('You pressed ');
  197.  
  198.          case Button of
  199.               1: Write ('the Left button.  ');
  200.               2: Write ('the Right button. ');
  201.               4: Write ('the Middle button.');
  202.               3: Write ('2 buttons.        ');
  203.          end; {case}
  204.  
  205.          end;
  206.        end;
  207.  
  208.   Until Keypressed;
  209.  
  210.   rsHidecursor;                         { turn it off }
  211.   TextMode(3);                          { an easy way to restore default font }
  212.  
  213. end.
  214.