home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
World of Shareware - Software Farm 2
/
wosw_2.zip
/
wosw_2
/
PASCAL
/
AMOUSE10.ZIP
/
DEMO.PAS
< prev
Wrap
Pascal/Delphi Source File
|
1992-08-14
|
12KB
|
278 lines
{▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒}
{▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒ Demo ▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒}
{▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒}
{▒ This is a simple DEMO program that shows general mouse function, ▒}
{▒ and demonstrates basic mouse programming using the aRmouse unit. Easy! ▒}
{▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒▒}
{$R-,L-,D-,S-,E-,A+,N-,G-,F-}
uses aRmouse,crt,dos;
const
push = true;
release = false;
Esc = #27;
Enter = #13;
main = 1;
pressed = 2;
nopressed = 3;
BlackAndWhite : boolean = false;
NoArrow : boolean = false;
color : array [false..true,main..nopressed] of integer=(
(Lightcyan,LightGray,LightCyan),(LightGray,White,LightGray));
BackGround : integer = Blue;
var ch : char;
i : integer;
x,y : byte;
who : EventStatus;
s : string;
CurrentArrow : ImageArrowName;
{$i Demo.inc} { <-Service Rutine : Time, SetCursor, NormalCursor,
Atr, HiddenCursor}
procedure Button( n : integer; status : boolean);
{-Draw Button n=1 - left; n=2 - centr; n=3 - right status=push/release}
procedure WriteXY(s:string;x,y:integer);
begin
Gotoxy(x,y);
Write(s);
end;
var
x : integer;
begin
if NumberOfButtons=3 then x:=28+(n-1)*6
else if n=1 then x:=30 else x:=38;
if Status=Release then
begin
Atr(color[BlackAndWhite,NoPressed],BackGround);
writeXY('┌───┐',x,6);
writeXY('│███│',x,7);
writeXY('│███│',x,8);
writeXY('│███│',x,9);
writeXY('└───┘',x,10);
end
else
begin
Atr(color[BlackAndWhite,Pressed],BackGround);
writeXY('▄▄▄▄▄',x,6);
writeXY('▌▄▄▄▐',x,7);
writeXY('▌███▐',x,8);
writeXY('▌▀▀▀▐',x,9);
writeXY('▀▀▀▀▀',x,10);
end;
Atr(color[BlackAndWhite,Main],BackGround);
end;
Procedure PushButton(status : EventStatus);
{-Draw Pushed Button}
begin
if ord(Status) and 1 = 1 then Button(1,Push);
if ord(Status) and 2 = 2 then Button(3,Push);
if ord(Status) and 4 = 4 then Button(2,Push);
end;
Procedure ReleaseButtons;
{-Draw all release Button}
var I : integer;
begin
if MouseReady then for i :=1 to 3 do Button(i,Release);
end;
Procedure DemoImageArrow;
begin
if (WhereArrowy>4)and(WhereArrowy<6) then
if WhereArrowx>73 then SelectNotPressedImage(DragArrowR) else
if WhereArrowx>69 then SelectNotPressedImage(DragArrowL) else
if WhereArrowx>65 then SelectNotPressedImage(ClockArrow) else
if WhereArrowx>61 then SelectNotPressedImage(HandArrow) else
if WhereArrowx>57 then SelectNotPressedImage(Hand1Arrow) else
if WhereArrowx>53 then SelectNotPressedImage(Hand3Arrow) else
if WhereArrowx>49 then SelectNotPressedImage(NormalArrow);
if (WhereArrowy>6)and(WhereArrowy<9) then
if WhereArrowx>73 then SelectNotPressedImage(Clock2Arrow) else
if WhereArrowx>69 then SelectNotPressedImage(DragArrow) else
if WhereArrowx>65 then SelectNotPressedImage(PencilArrow) else
if WhereArrowx>61 then SelectNotPressedImage(FootArrow) else
if WhereArrowx>57 then SelectNotPressedImage(Big2Arrow) else
if WhereArrowx>53 then SelectNotPressedImage(SightArrow) else
if WhereArrowx>49 then SelectNotPressedImage(PlusArrow);
end;
Procedure SetImageArrow;
begin
if (WhereArrowy>4)and(WhereArrowy<6) then
if WhereArrowx>73 then CurrentArrow:=DragArrowR else
if WhereArrowx>69 then CurrentArrow:=DragArrowL else
if WhereArrowx>65 then CurrentArrow:=ClockArrow else
if WhereArrowx>61 then CurrentArrow:=HandArrow else
if WhereArrowx>57 then CurrentArrow:=Hand1Arrow else
if WhereArrowx>53 then CurrentArrow:=Hand3Arrow else
if WhereArrowx>49 then CurrentArrow:=NormalArrow;
if (WhereArrowy>6)and(WhereArrowy<9) then
if WhereArrowx>73 then CurrentArrow:=Clock2Arrow else
if WhereArrowx>69 then CurrentArrow:=DragArrow else
if WhereArrowx>65 then CurrentArrow:=PencilArrow else
if WhereArrowx>61 then CurrentArrow:=FootArrow else
if WhereArrowx>57 then CurrentArrow:=Big2Arrow else
if WhereArrowx>53 then CurrentArrow:=SightArrow else
if WhereArrowx>49 then CurrentArrow:=PlusArrow;
end;
procedure DemoImage;
{-This procidure demo arrow image }
begin
if (WhereArrowx>49)and(WhereArrowx<77)and(WhereArrowy>4)and(WhereArrowy<9) then DemoImageArrow
else SelectNotPressedImage(CurrentArrow);
end;
procedure SelectImage;
{-This procidure select new arrow image }
begin
if (WhereArrowx>49)and(WhereArrowx<77)and(WhereArrowy>4)and(WhereArrowy<9) then SetImageArrow;
end;
{$F+}
Procedure ShowTime;
{-This procidure work into procedure GetEvent until
mouse button released}
begin
textcolor(color[BlackAndWhite,NoPressed]);
Time;
PushButton(CurrentStatus);
end;
{$F-}
{$F+}
procedure ShowTimeAndSwitchImage;
{-This procidure work into procedure GetEvent while not
mouse button released}
begin
textcolor(color[BlackAndWhite,Pressed]);
Time;
textcolor(color[BlackAndWhite,Main]);
DemoImage;
end;
{$F-}
Procedure DrawScreen;
{-Draw Screen Image}
begin
gotoxy(1,2);
Atr(color[BlackAndWhite,Main],BackGround);
writeln(' DEMO of available mouse functions The C O L L E C T I O N of arrows. Press');
writeln(' ╔╩╗ double click of left button for select.');
writeln(' ╠═╣ ▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄ ');
writeln(' ╔════════╩═╩════════╗ █ █ █ █ █ █ █ █ ');
writeln(' ║ ║ █▄▄▄█▄▄▄█▄▄▄█▄▄▄█▄▄▄█▄▄▄█▄▄▄█ ');
writeln(' ║ ║ █▀▀▀█▀▀▀█▀▀▀█▀▀▀█▀▀▀█▀▀▀█▀▀▀█ ');
writeln(' ║ ║ █ █ █ █ █ █ █ █ ');
writeln(' ║ ║ ▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀ ');
writeln(' Double click = ENTER─>║ ║<───── One click = ESC');
If not MouseReady then
writeln(' ║MOUSE NOT INSTALLED║ Double click = #127')
else
writeln(' ║ ║ Double click = #127');
if (NumberOfButtons=2)or(NumberOfButtons=0) then
begin
writeln(' ║ ║');
writeln(' ║ ║');
writeln(' ║ ║');
writeln(' ║ ║');
end
else
begin
writeln(' ║ ^ ║');
writeln(' ║ │ ║');
writeln(' ║Double click = #255║');
writeln(' ║ for center button ║');
end;
If not AMouse then
writeln(' ║ NO GRAPHIC EFFECT ║')
else
writeln(' ║ ║');
writeln(' ╚═══════════════════╝');
writeln(' Press any key or mouse button');
writeln;
writeln(' Pressing of Button results in character under cursor and X,Y positions');
writeln(' Pressing of any KBD key results in Mouse to be sleeping until move');
writeln(' Press KBD Key <Esc> for EXIT');
Atr(color[BlackAndWhite,Main],BackGround);
ReleaseButtons;
end;
{░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░}
{░░░░█████████████████████████████████████████████████████████████████████░░░░}
{░░░░█ MAIN PROGRAMM for DEMO ARMOUSE UNIT █░░░░}
{░░░░█████████████████████████████████████████████████████████████████████░░░░}
{░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░}
begin { Unit ArMouse initiate Arrow before }
for i:=1 to paramcount do
begin
if paramstr(i) = '/b' then begin
BlackAndWhite:=true;
BackGround:=Black;
end
else if paramstr(i) = '/n' then begin
NoArrow:=true;
AMouse:=false;
end
else if paramstr(i) = '/e' then begin
DoneArrowMouse;
SwitchToEGA:=true;
ReInitArrowMouse;
if NoArrow then AMouse:=False;
end
else begin
writeln('Syntax : demo [/b] [/n] [/e]');
halt;
end;
end;
CurrentArrow:=NormalArrow; { Select image for demo }
Atr(color[BlackAndWhite,Main],BackGround);
{ Set Attribute }
Window(1,1,80,24);
ClrScr;
Window(1,1,80,25); { Prepare Screen }
HiddenCursor; { Set Key Board cursor invisible }
DrawScreen; { Draw MOUSE and text }
repeat { Main Cycle }
who:=GetEvent(ch, x, y, ShowTimeAndSwitchImage, ShowTime);
{ While not Event work 2 procedures }
{ 1) ShowTimeAndSwitchImage }
{ (until button not pressed) }
{ 2) ShowTime }
{ (while all button not released)}
case who of
Left_Button : s:= 'LeftButtonPressed ';
Right_Button : s:= 'RightButtonPressed ';
Both_Button : s:= 'BothButtonsPressed ';
Center_Button : s:= 'CenterButtonPressed ';
Left_Center_Button : s:= 'LeftAndCenterButtonsPressed ';
Right_Center_Button : s:= 'RightAndCenterButtonsPressed';
All3_Button : s:= 'All3ButtonsPressed ';
KBD_Key : s:= 'KBDKeyPressed ';
KBD_Special_Key : s:= 'KBDSpecialKeyPressed ';
end; { Who pressed for write }
ReleaseButtons; { Draw Released Buttons }
if (ch=Enter) and (Who=Left_Button) then SelectImage;
{ Select image arrow if double click}
GoToXY(1,23);
Atr(color[BlackAndWhite,Main],BackGround);
if (ch=Enter)or(ch=#255) then write(' ',s,' Character under cursor/KBD=[#',ord(ch),'] x=',x,' y=',y,' ')
else Write(' ',s,' Character under cursor/KBD=[',ch,'] x=',x,' y=',y,' ');
{ Write result to last line }
until (ch=Esc)and(who=KBD_Key);{ End Main Cycle}
DoneArrowMouse; { Disable Event Handler at all..}
NormalCursor; { Set cursor visible }
end.