home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / RMOUSE11.ZIP / DEMO.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-10-09  |  12.9 KB  |  307 lines
  1. {▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒}
  2. {▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒ Demo ▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒}
  3. {▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒}
  4. {▒  This  is  a simple  DEMO  program that shows   general mouse function,  ▒}
  5. {▒  and demonstrates basic mouse programming using the aRmouse unit. Easy!  ▒}
  6. {▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒}
  7. {$R-,L-,D-,S-,E-,A+,N-,G-,F-}
  8. uses Rmouse,crt,dos;
  9.  
  10. const
  11.     push             = true;
  12.     release          = false;
  13.     Esc              = #27;
  14.     Enter            = #13;
  15.     main             = 1;
  16.     pressed          = 2;
  17.     nopressed        = 3;
  18.     BlackAndWhite    : boolean = false;
  19.     NoArrow          : boolean = false;
  20.     color            : array [false..true,main..nopressed] of integer=(
  21.                        (Lightcyan,LightGray,LightCyan),(LightGray,White,LightGray));
  22.     BackGround       : integer = Blue;
  23.     OldScrMode       : integer = -1;
  24.  
  25. var ch               : char;
  26.     i,j              : integer;
  27.     x,y              : byte;
  28.     who              : EventStatus;
  29.     s                : string;
  30.     CurrentArrow     : ImageArrowName;
  31.     r                : registers;
  32.     ScrMode          : byte;
  33.  
  34. {$i Demo.inc}        { <-Service Rutine : Time, SetCursor, NormalCursor,
  35.                                            Atr,  HiddenCursor}
  36.  
  37.  
  38. procedure Button( n : integer; status : boolean);
  39.  {-Draw Button n=1 - left; n=2 - centr; n=3 - right status=push/release}
  40.  
  41. procedure WriteXY(s:string;x,y:integer);
  42. begin
  43.  Gotoxy(x,y);
  44.  Write(s);
  45. end;
  46.  
  47. var
  48.   x     : integer;
  49. begin
  50.  if NumberOfButtons=3 then x:=28+(n-1)*6
  51.  else if n=1 then x:=30 else x:=38;
  52.  if Status=Release then
  53.  begin
  54.   Atr(color[BlackAndWhite,NoPressed],BackGround);
  55.    writeXY('┌───┐',x,6);
  56.    writeXY('│███│',x,7);
  57.    writeXY('│███│',x,8);
  58.    writeXY('│███│',x,9);
  59.    writeXY('└───┘',x,10);
  60.  end
  61.  else
  62.  begin
  63.    Atr(color[BlackAndWhite,Pressed],BackGround);
  64.    writeXY('▄▄▄▄▄',x,6);
  65.    writeXY('▌▄▄▄▐',x,7);
  66.    writeXY('▌███▐',x,8);
  67.    writeXY('▌▀▀▀▐',x,9);
  68.    writeXY('▀▀▀▀▀',x,10);
  69.  end;
  70.   Atr(color[BlackAndWhite,Main],BackGround);
  71. end;
  72.  
  73. Procedure PushButton(status : EventStatus);
  74.   {-Draw Pushed Button}
  75. begin
  76.   if ord(Status) and 1 = 1 then Button(1,Push);
  77.   if ord(Status) and 2 = 2 then Button(3,Push);
  78.   if ord(Status) and 4 = 4 then Button(2,Push);
  79. end;
  80.  
  81. Procedure ReleaseButtons;
  82.    {-Draw all release Button}
  83. var I     : integer;
  84. begin
  85.   if MouseReady then for i :=1 to 3 do Button(i,Release);
  86. end;
  87.  
  88.  
  89. Procedure DemoImageArrow;
  90. begin
  91.    if (WhereArrowy>4)and(WhereArrowy<6) then
  92.       if WhereArrowx>73 then SelectNotPressedImage(DragArrowR) else
  93.       if WhereArrowx>69 then SelectNotPressedImage(DragArrowL) else
  94.       if WhereArrowx>65 then SelectNotPressedImage(ClockArrow) else
  95.       if WhereArrowx>61 then SelectNotPressedImage(HandArrow) else
  96.       if WhereArrowx>57 then SelectNotPressedImage(Hand1Arrow) else
  97.       if WhereArrowx>53 then SelectNotPressedImage(Hand3Arrow) else
  98.       if WhereArrowx>49 then SelectNotPressedImage(NormalArrow);
  99.    if (WhereArrowy>6)and(WhereArrowy<9) then
  100.       if WhereArrowx>73 then SelectNotPressedImage(Clock2Arrow) else
  101.       if WhereArrowx>69 then SelectNotPressedImage(DragArrow) else
  102.       if WhereArrowx>65 then SelectNotPressedImage(PencilArrow) else
  103.       if WhereArrowx>61 then SelectNotPressedImage(FootArrow) else
  104.       if WhereArrowx>57 then SelectNotPressedImage(Big2Arrow) else
  105.       if WhereArrowx>53 then SelectNotPressedImage(SightArrow) else
  106.       if WhereArrowx>49 then SelectNotPressedImage(PlusArrow);
  107. end;
  108.  
  109. Procedure SetImageArrow;
  110. begin
  111.    if (WhereArrowy>4)and(WhereArrowy<6) then
  112.       if WhereArrowx>73 then CurrentArrow:=DragArrowR else
  113.       if WhereArrowx>69 then CurrentArrow:=DragArrowL else
  114.       if WhereArrowx>65 then CurrentArrow:=ClockArrow else
  115.       if WhereArrowx>61 then CurrentArrow:=HandArrow else
  116.       if WhereArrowx>57 then CurrentArrow:=Hand1Arrow else
  117.       if WhereArrowx>53 then CurrentArrow:=Hand3Arrow else
  118.       if WhereArrowx>49 then CurrentArrow:=NormalArrow;
  119.    if (WhereArrowy>6)and(WhereArrowy<9) then
  120.       if WhereArrowx>73 then CurrentArrow:=Clock2Arrow else
  121.       if WhereArrowx>69 then CurrentArrow:=DragArrow else
  122.       if WhereArrowx>65 then CurrentArrow:=PencilArrow else
  123.       if WhereArrowx>61 then CurrentArrow:=FootArrow else
  124.       if WhereArrowx>57 then CurrentArrow:=Big2Arrow else
  125.       if WhereArrowx>53 then CurrentArrow:=SightArrow else
  126.       if WhereArrowx>49 then CurrentArrow:=PlusArrow;
  127. end;
  128.  
  129.  
  130. procedure DemoImage;
  131.    {-This procidure demo arrow image }
  132. begin
  133.   if (WhereArrowx>49)and(WhereArrowx<77)and(WhereArrowy>4)and(WhereArrowy<9) then DemoImageArrow
  134.   else SelectNotPressedImage(CurrentArrow);
  135. end;
  136.  
  137.  
  138. procedure SelectImage;
  139.    {-This procidure select new arrow image }
  140. begin
  141.   if (WhereArrowx>49)and(WhereArrowx<77)and(WhereArrowy>4)and(WhereArrowy<9) then SetImageArrow;
  142. end;
  143.  
  144. {$F+}
  145. Procedure ShowTime;
  146.    {-This procidure work into procedure GetEvent until
  147.      mouse button released}
  148. begin
  149.  textcolor(color[BlackAndWhite,NoPressed]);
  150.  Time;
  151.  PushButton(CurrentStatus);
  152. end;
  153. {$F-}
  154.  
  155. {$F+}
  156. procedure ShowTimeAndSwitchImage;
  157.    {-This procidure work into procedure GetEvent while not
  158.      mouse button released}
  159. begin
  160.  textcolor(color[BlackAndWhite,Pressed]);
  161.  Time;
  162.  textcolor(color[BlackAndWhite,Main]);
  163.  DemoImage;
  164. end;
  165. {$F-}
  166.  
  167. Procedure DrawScreen;
  168.    {-Draw Screen Image}
  169. begin
  170.   gotoxy(1,2);
  171.   Atr(color[BlackAndWhite,Main],BackGround);
  172.   writeln(' DEMO of available mouse functions    The C O L L E C T I O N  of arrows. Press');
  173.   writeln('                                  ╔╩╗ double click of left  button  for select.');
  174.   writeln('                                  ╠═╣           ▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄ ');
  175.   writeln('                         ╔════════╩═╩════════╗  █   █   █   █   █   █   █   █ ');
  176.   writeln('                         ║                   ║  █▄▄▄█▄▄▄█▄▄▄█▄▄▄█▄▄▄█▄▄▄█▄▄▄█ ');
  177.   writeln('                         ║                   ║  █▀▀▀█▀▀▀█▀▀▀█▀▀▀█▀▀▀█▀▀▀█▀▀▀█ ');
  178.   writeln('                         ║                   ║  █   █   █   █   █   █   █   █ ');
  179.   writeln('                         ║                   ║  ▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀ ');
  180.   writeln('   Double click = ENTER─>║                   ║<───── One click    = ESC');
  181.   If not MouseReady then
  182.    writeln('                         ║MOUSE NOT INSTALLED║       Double click = #127')
  183.   else
  184.    writeln('                         ║                   ║       Double click = #127');
  185.   if (NumberOfButtons=2)or(NumberOfButtons=0) then
  186.   begin
  187.    writeln('                         ║                   ║');
  188.    writeln('                         ║                   ║');
  189.    writeln('                         ║                   ║');
  190.    writeln('                         ║                   ║');
  191.   end
  192.   else
  193.   begin
  194.    writeln('                         ║         ^         ║');
  195.    writeln('                         ║         │         ║');
  196.    writeln('                         ║Double click = #255║');
  197.    writeln('                         ║ for center button ║');
  198.   end;
  199.   If not AMouse then
  200.    writeln('                         ║ NO GRAPHIC EFFECT ║')
  201.   else
  202.    writeln('                         ║                   ║');
  203.   writeln('                         ╚═══════════════════╝');
  204.   writeln('                      Press any key or mouse button');
  205.   writeln;
  206.   writeln('  Pressing of Button results in character under cursor and X,Y positions');
  207.   writeln('  Pressing of any KBD key results in Mouse to  be  sleeping  until  move');
  208.   writeln('                      Press KBD Key <Esc> for EXIT');
  209.   Atr(color[BlackAndWhite,Main],BackGround);
  210.   ReleaseButtons;
  211. end;
  212.  
  213. {░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░}
  214. {░░░░█████████████████████████████████████████████████████████████████████░░░░}
  215. {░░░░█               MAIN PROGRAMM for DEMO ARMOUSE UNIT                 █░░░░}
  216. {░░░░█████████████████████████████████████████████████████████████████████░░░░}
  217. {░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░}
  218.  
  219. begin                             { Unit ArMouse initiate Arrow before }
  220.   for i:=1 to paramcount do
  221.   begin
  222.     if paramstr(i) = '/b' then begin
  223.                             BlackAndWhite:=true;
  224.                             BackGround:=Black;
  225.                           end
  226.     else if paramstr(i) = '/n' then begin
  227.                                       NoArrow:=true;
  228.                                       AMouse:=false;
  229.                                      end
  230.          else if paramstr(i) = '/e' then begin
  231.                                       DoneArrowMouse;
  232.                                       SwitchToEGA:=true;
  233.                                       ReInitArrowMouse;
  234.                                       if NoArrow then AMouse:=False;
  235.                                     end
  236.               else if copy(paramstr(i),1,2) = '/m' then begin
  237.                                            val(copy(paramstr(i),3,10),ScrMode,j);
  238.                                            if j=0 then
  239.                                            begin
  240.                                              DoneArrowMouse;
  241.                                              r.ah:=$0F;
  242.                                              intr($10,r);
  243.                                              OldScrMode:=r.al;
  244.                                              r.ah:=$0;
  245.                                              r.al:=ScrMode;
  246.                                              intr($10,r);
  247.                                              ReInitArrowMouse;
  248.                                            end;
  249.                                            if NoArrow then AMouse:=False;
  250.                                          end
  251.                     else begin
  252.                            writeln('Syntax : demo [/b] [/n] [/e] [mXX]');
  253.                            writeln('       /b   ... black and white mode on');
  254.                            writeln('       /n   ... normal (not grathic) mouse cursor for VGA/EGA');
  255.                            writeln('       /e   ... switch to EGA mode with VGA adapter');
  256.                            writeln('       /mXX ... switch screen to XX mode (for demo 132x25,');
  257.                            writeln('                80x43,...)');
  258.                            halt;
  259.                          end;
  260.   end;
  261.   CurrentArrow:=NormalArrow;      { Select image for demo             }
  262.   Atr(color[BlackAndWhite,Main],BackGround);
  263.                                   { Set Attribute                     }
  264.   Window(1,1,80,24);
  265.   ClrScr;
  266.   Window(1,1,80,25);              { Prepare Screen                    }
  267.   HiddenCursor;                   { Set Key Board cursor invisible    }
  268.   DrawScreen;                     { Draw MOUSE and text               }
  269.   repeat                          { Main Cycle                        }
  270.  
  271.     who:=GetEvent(ch, x, y, ShowTimeAndSwitchImage, ShowTime);
  272.  
  273.                                   { While not Event work 2 procedures }
  274.                                   { 1) ShowTimeAndSwitchImage         }
  275.                                   {    (until button not pressed)     }
  276.                                   { 2) ShowTime                       }
  277.                                   {    (while all button not released)}
  278.    case who of
  279.      Left_Button                  : s:= 'LeftButtonPressed           ';
  280.      Right_Button                 : s:= 'RightButtonPressed          ';
  281.      Both_Button                  : s:= 'BothButtonsPressed          ';
  282.      Center_Button                : s:= 'CenterButtonPressed         ';
  283.      Left_Center_Button           : s:= 'LeftAndCenterButtonsPressed ';
  284.      Right_Center_Button          : s:= 'RightAndCenterButtonsPressed';
  285.      All3_Button                  : s:= 'All3ButtonsPressed          ';
  286.      KBD_Key                      : s:= 'KBDKeyPressed               ';
  287.      KBD_Special_Key              : s:= 'KBDSpecialKeyPressed        ';
  288.    end;                           { Who pressed for write             }
  289.    ReleaseButtons;                { Draw Released Buttons             }
  290.    if (ch=Enter) and (Who=Left_Button) then SelectImage;
  291.                                   { Select image arrow if double click}
  292.    GoToXY(1,23);
  293.    Atr(color[BlackAndWhite,Main],BackGround);
  294.    if (ch=Enter)or(ch=#255)  then write(' ',s,' Character under cursor/KBD=[#',ord(ch),'] x=',x,' y=',y,'  ')
  295.    else  Write(' ',s,' Character under cursor/KBD=[',ch,'] x=',x,' y=',y,'    ');
  296.                                   { Write result to last line         }
  297.   until (ch=Esc)and(who=KBD_Key);{ End Main Cycle}
  298.   DoneArrowMouse;                 { Disable Event Handler at all..}
  299.   NormalCursor;                   { Set cursor visible            }
  300.   if OldScrMode<>-1 then
  301.   begin
  302.    r.ah:=$0;
  303.    r.al:=OldScrMode;
  304.    intr($10,r);
  305.   end;
  306. end.
  307.