home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Shareware Overload
/
ShartewareOverload.cdr
/
progm
/
minigen.zip
/
MOUSTEST.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1988-03-14
|
8KB
|
334 lines
Program Mouse_Test(Input,Output);
Uses
Dos,
Crt,
Graph,
MgMouse;
Const
NewCursor : MG_MouseCursor =
(($FFFF,$FFFF,$0000,$0000,$FFFF,$FFFF,$0000,$0000,
$FFFF,$FFFF,$0000,$0000,$FFFF,$FFFF,$0000,$0000),
($0000,$0000,$FFFF,$FFFF,$0000,$0000,$FFFF,$FFFF,
$0000,$0000,$FFFF,$FFFF,$0000,$0000,$FFFF,$FFFF));
Var
Ch,Choice : Char;
ChooseDefaultCursor : Boolean;
Procedure PollTheMouse;
Begin
Writeln;
Writeln('PollTheMouse');
Repeat
MousePoll;
ClrEol;
If LeftButtonPressed then
Writeln('LeftButtonPressed ',M1,' ',M2,' ',M3,' ',M4);
If RightButtonPressed then
Writeln('RightButtonPressed ',M1,' ',M2,' ',M3,' ',M4);
If MiddleButtonPressed then
Writeln('MiddleButtonPressed ',M1,' ',M2,' ',M3,' ',M4);
Until KeyPressed;
While KeyPressed do
Ch := ReadKey;
End; {PollTheMouse}
Procedure ReadLeftButton;
Begin
Writeln;
Writeln('MouseLeftButtonInfo');
Repeat {** Get info. on left button **}
MouseButtonPressed(Left);
ClrEol;
If LeftButtonPressed then
Writeln('LeftButton ',M1,' ',M2,' ',M3,' ',M4);
Until KeyPressed;
While KeyPressed do
Ch := ReadKey;
End; {LeftButton}
Procedure ReadRightButton;
Begin
Writeln;
Writeln('MouseRightButtonInfo');
Repeat {** Get info. on right button **}
MouseButtonPressed(Right);
ClrEol;
If RightButtonPressed then
Writeln('RightButton ',M1,' ',M2,' ',M3,' ',M4);
Until KeyPressed;
While KeyPressed do
Ch := ReadKey;
End; {ReadRightButton}
Procedure ReadMiddleButton;
Begin
Writeln;
Writeln('MouseMiddleButtonInfo');
Repeat {** Get info. on right button **}
MouseButtonPressed(Middle);
ClrEol;
If MiddleButtonPressed then
Writeln('MiddleButton ',M1,' ',M2,' ',M3,' ',M4);
Until KeyPressed;
While KeyPressed do
Ch := ReadKey;
End; {ReadMiddleButton}
Procedure Move_The_Mouse;
Begin
Writeln;
Writeln('MouseMoveCursor : ');
Write(' Ready, Set, ');
Ch := ReadKey;
MouseMoveCursor(256,0);
Writeln('Gone!');
End; {Move_The_Mouse}
Procedure Box_Him_Up;
Begin
Writeln;
Writeln('Restricting the mouse to a box.');
MouseBox(80,400,24,96);
Ch := ReadKey;
MouseBox(0,632,0,192);
Writeln(' Let him out again.');
Ch := ReadKey;
End; {Box_Him_Up}
Procedure Wait_Press;
Var
WaitFor,ExitOn : Byte;
Begin
Writeln;
Writeln('Wait for ''?'' to be PRESSED :');
Writeln(' 1) Left button');
Writeln(' 2) Right button');
Writeln(' 3) Middle button');
Write ('==> ');
Repeat
Choice := ReadKey;
Until (Choice in ['1','2','3']);
Write(Choice);
Case Choice of
'1' : WaitFor := Left;
'2' : WaitFor := Right;
'3' : WaitFor := Middle;
End;
Writeln;
Writeln('Exit routine on :');
Writeln(' 1) Left button');
Writeln(' 2) Right button');
Writeln(' 3) Middle button');
Write ('==> ');
Repeat
Ch := ReadKey;
Until (Ch in ['1','2','3']) and
(Ch <> Choice);
Write(Ch);
Case Ch of
'1' : ExitOn := Left;
'2' : ExitOn := Right;
'3' : ExitOn := Middle;
End;
Writeln;
Writeln(' Waiting...');
MouseWaitPressed(WaitFor,ExitOn);
If LeftButtonPressed then
Writeln('Left button pressed');
If RightButtonPressed then
Writeln('Right button pressed');
If MiddleButtonPressed then
Writeln('Middle button pressed');
Ch := ReadKey;
End; {Wait_Press}
Procedure Wait_Release;
Var
WaitFor,ExitOn : Byte;
Begin
Writeln;
Writeln('Wait for ''?'' to be RELEASED :');
Writeln(' 1) Left button');
Writeln(' 2) Right button');
Writeln(' 3) Middle button');
Write ('==> ');
Repeat
Choice := ReadKey;
Until (Choice in ['1','2','3']);
Writeln(Choice);
Case Choice of
'1' : WaitFor := Left;
'2' : WaitFor := Right;
'3' : WaitFor := Middle;
End;
Writeln('Exit routine on :');
Writeln(' 1) Left button');
Writeln(' 2) Right button');
Writeln(' 3) Middle button');
Write ('==> ');
Repeat
Ch := ReadKey;
Until (Ch in ['1','2','3']) and
(Ch <> Choice);
Writeln(Ch);
Case Ch of
'1' : ExitOn := Left;
'2' : ExitOn := Right;
'3' : ExitOn := Middle;
End;
Case WaitFor of
Left : Writeln('Press the Left button');
Right : Writeln('Press the Right button');
Middle : Writeln('Press the Middle button');
end;
MouseWaitPressed(WaitFor,ExitOn);
Writeln(' Waiting...');
MouseWaitReleased(WaitFor,ExitOn);
If LeftButtonReleased then
Writeln('Left button released')
Else
Writeln('Left button pressed');
If RightButtonReleased then
Writeln('Right button released')
Else
Writeln('Right button pressed');
If MiddleButtonReleased then
Writeln('Middle button released')
Else
Writeln('Middle button pressed');
Writeln(' Done...');
Ch := ReadKey;
End; {Wait_Release}
Procedure DefaultGraphicsCursor;
Var
GrDriver,GrMode : Integer;
Begin
Case ChooseDefaultCursor of
True : Begin
ChooseDefaultCursor := False;
MouseCursorOff;
ClrScr;
GrDriver := 0;
GrMode := 0;
InitGraph(GrDriver,GrMode,'');
If (GraphResult <> 0) then
Begin
Writeln('GraphResult = ',GraphResult);
Ch := ReadKey;
MouseCursorOn;
Exit;
End;
MouseCursorOn;
While not KeyPressed do;
While KeyPressed do
Ch := ReadKey;
MouseCursorOff;
RestoreCrtMode;
MouseCursorOn;
End;
False : Begin
MouseCursorOff;
ClrScr;
GrDriver := 0;
GrMode := 0;
InitGraph(GrDriver,GrMode,'');
If (GraphResult <> 0) then
Begin
Writeln('GraphResult = ',GraphResult);
Ch := ReadKey;
MouseCursorOn;
Exit;
End;
MouseSetGraphicsCursor('D',0,0);
MouseCursorOn;
While not KeyPressed do;
While KeyPressed do
Ch := ReadKey;
MouseCursorOff;
RestoreCrtMode;
MouseSetTextCursor(0,0,$0F18);
MouseCursorOn;
End;
End;
End; {DefaultGraphicsCursor}
Procedure SetUpGraphicsCursor;
Var
GrDriver,GrMode : Integer;
Begin
MouseCursorOff;
ClrScr;
GrDriver := 0;
GrMode := 0;
InitGraph(GrDriver,GrMode,'');
If (GraphResult <> 0) then
Begin
Writeln('GraphResult = ',GraphResult);
Ch := ReadKey;
MouseCursorOn;
Exit;
End;
MouseSetGraphicsCursor('U',8,8);
MouseCursorOn;
While not KeyPressed do;
While KeyPressed do
Ch := ReadKey;
MouseCursorOff;
RestoreCrtMode;
MouseSetTextCursor(0,0,$0F18);
MouseCursorOn;
End; {SetUpGraphicsCursor}
Begin
ChooseDefaultCursor := True;
UserGraphCursor := NewCursor;
TextMode(BW80);
If MouseReset then {** Initialize the mouse **}
Writeln('MouseReset : ',M1,' ',M2,' ',M3,' ',M4)
Else
Begin
Writeln('Mouse driver cannot be detected.');
Halt;
End;
MouseCursorOn; {** Show the mouse cursor **}
Writeln('MouseCursorOn : ',M1,' ',M2,' ',M3,' ',M4);
Writeln;
Repeat
Writeln('Mouse Demo Menu : ');
Writeln(' A) Poll the Mouse. F) Restrict mouse to a Box ');
Writeln(' B) Left Button Pressed G) Wait for a button PRESS ');
Writeln(' C) Right Button Pressed H) Wait for a button RELEASE ');
Writeln(' D) Middle Button Pressed. I) Show default graphics cursor');
Writeln(' E) Move the Mouse J) Show user graphics cursor');
Writeln(' (Q)uit ');
Choice := Upcase(ReadKey);
Case Choice of
'A' : PollTheMouse;
'B' : ReadLeftButton;
'C' : ReadRightButton;
'D' : ReadMiddleButton;
'E' : Move_The_Mouse;
'F' : Box_Him_Up;
'G' : Wait_Press;
'H' : Wait_Release;
'I' : DefaultGraphicsCursor;
'J' : SetUpGraphicsCursor;
End;
MouseCursorOff;
ClrScr;
MouseCursorOn;
Until (Choice = 'Q');
MouseCursorOff; {** Turn of the mouse cursor **}
Writeln('MousCursorOff');
Writeln;
Writeln('End of Mouse demo. Any key to exit. ');
Writeln;
Ch := ReadKey;
ClrScr;
End.