home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / PROG / PASCAL / MOUSTOOL.ZIP / CGAEXP.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-05-08  |  6.4 KB  |  200 lines
  1. {****************************************************************************}
  2. {*                               MOUSE TOOLS                                *}
  3. {*                        Version 1.0, April 7, 1989                        *}
  4. {*                                                                          *}
  5. {*    Written by:                   Copyright (C) 1989 by Nels Anderson     *}
  6. {*    Nels Anderson                 All Rights Reserved                     *}
  7. {*    92 Bishop Drive                                                       *}
  8. {*    Framingham, MA 01701          Source code for use by registered       *}
  9. {*                                  owner only.  Not to be distributed      *}
  10. {*                                  without express consent of the writer.  *}
  11. {*                                                                          *}
  12. {****************************************************************************}
  13.  
  14. {CGA Demonstration of Mouse Tools}
  15.  
  16. Uses
  17.   Crt,Dos,Graph,Drivers,Fonts,Mouse,Convert,MouseRs2,Box;
  18.  
  19. Const
  20.   CGAGREEN = 1;                {CGA mode colors}
  21.   CGARED = 2;
  22.   CGABROWN = 3;
  23.  
  24. Var
  25.   flag:  BOOLEAN;
  26.   OldExitProc:  POINTER;
  27.   Size,                    {size of map squares}
  28.   Color,                {current drawing color}
  29.   x,y,                    {cursor location}
  30.   LookX,LookY,
  31.   MaxColor,
  32.   MaxX,MaxY,
  33.   i:  INTEGER;
  34.   Xasp,Yasp:  WORD;
  35.  
  36. Const
  37.   mt: array[1..5,1..4] of INTEGER = (    {table of prompts}
  38.   (20,150,46,55),            {limits of 'load a file' prompt}
  39.   (20,150,56,65),            {limits of 'choose a color' prompt}
  40.   (20,150,66,75),            {limits of 'hit a key' prompt}
  41.   (20,150,76,85),            {limits of 'quit' prompt}
  42.   (0,160,25,95) );            {limits of entire menu box}
  43.  
  44. {$F+}
  45. procedure MyExitProc;
  46. begin
  47.   ExitProc := OldExitProc;        {restore exit procedure address}
  48.   CloseGraph;                {exit graphics mode}
  49. end; { MyExitProc }
  50. {$F-}
  51.  
  52. procedure Abort(Msg : string);
  53. begin
  54.   Writeln(Msg, ': ', GraphErrorMsg(GraphResult));
  55.   Halt(1);
  56. end;
  57.  
  58. procedure Initialize;
  59. { Initialize graphics and report any errors that may occur.  Don't forget
  60.   to register the graphics module before calling this routine, i.e.:
  61.  
  62.   if RegisterBGIdriver(@EGAVGADriverProc) < 0 then
  63.     Abort('EGA/VGA');
  64.    Initialize;
  65. }
  66. var
  67.   i,
  68.   GraphDriver,
  69.   Graphmode:  INTEGER;
  70. begin
  71.   { when using Crt and graphics, turn off Crt's memory-mapped writes }
  72.   DirectVideo := False;
  73.   OldExitProc := ExitProc;        {save previous exit proc}
  74.   ExitProc := @MyExitProc;        {insert our exit in chain}
  75.   GraphDriver := CGA;                     { force CGA graphics }
  76.   GraphMode := CGAC2;
  77.   InitGraph(GraphDriver, GraphMode, '');  { activate graphics }
  78.   i := GraphResult;
  79.   if i <> grOk then begin
  80.     Writeln('Cannot initialize graphics, error #',i:2);
  81.     WriteLn(GraphErrorMsg(i));
  82.     Halt(1);
  83.   end;
  84.   Randomize;                { init random number generator }
  85.   MaxColor := GetMaxColor;  { Get the maximum allowable drawing color }
  86.   MaxX := GetMaxX;          { Get screen resolution values }
  87.   MaxY := GetMaxY;
  88.   GetAspectRatio(Xasp,Yasp);
  89. end; { Initialize }
  90.  
  91. procedure FileExample;
  92. { demonstrate selecting a file name }
  93. var
  94.   filename:  STRING;
  95. begin
  96.   filename := '';
  97.   filename := MGetFile('*.exe','Select any file:');
  98.   SetColor(CGAGREEN);
  99.   if filename[0] = #255 then begin    {user aborted}
  100.     OutTextXY(200,100,'Aborted');
  101.   end {if user aborted}
  102.   else begin                {if file name selected...}
  103.     OutTextXY(200,90,'You selected:');
  104.     OutTextXY(200,100,filename);
  105.   end;
  106.   Delay(2000);
  107.   SetFillStyle(SolidFill,0);
  108.   Bar(200,80,319,105);
  109. end; {FileExample procedure}
  110.  
  111. procedure ChooseExample;
  112. { demonstration of selecting from a list }
  113. var
  114.   i:  INTEGER;
  115. const
  116.   ColorQues: array[1..3] of STRING = (    {color question choices}
  117.   'Green','Red','Brown');
  118. begin
  119.   i := MouseQuestion(3,'Select a color',@ColorQues);
  120.   SetColor(CGABROWN);
  121.   OutTextXY(200,100,'Your color is: ');
  122.   SetColor(i);
  123.   case i of
  124.     1: OutTextXY(200,110,'Green');
  125.     2: OutTextXY(200,110,'Red');
  126.     3: OutTextXY(200,110,'Brown');
  127.   end; {case}
  128.   Delay(2000);
  129.   SetFillStyle(SolidFill,0);
  130.   Bar(200,90,319,115);
  131. end; {ChooseExample procedure}
  132.  
  133. procedure HitKeyExample;
  134. { demonstration of key selection }
  135. var
  136.   c:  CHAR;
  137. begin
  138.   c := MouseReadKey('Hit a key or click mouse');
  139.   SetColor(CGAGREEN);
  140.   if c = #0 then begin            {user clicked the mouse}
  141.     OutTextXY(200,100,'Mouse clicked');
  142.   end
  143.   else begin                {user hit a key}
  144.     OutTextXY(200,100,'"'+c+'" key hit');
  145.   end;
  146.   Delay(2000);
  147.   SetFillStyle(SolidFill,0);
  148.   Bar(200,90,319,105);
  149. end; {HitKeyExample}
  150.  
  151. begin {Main routine}
  152.   if RegisterBGIdriver(@CGADriverProc) < 0 then
  153.     Abort('CGA');
  154.   Initialize;                    {initialize graphics}
  155.   SetTextJustify(CenterText,BottomText);
  156.   OutTextXY(160,10,'CGA Mouse Demonstration');
  157.   OutTextXY(160,20,'by Nels Anderson');
  158.   SetTextJustify(LeftText,BottomText);
  159.   OutlineBox(0,25,160,95,3,2);
  160.   Setcolor(2);
  161.   OutTextXY(20,40,'MENU:');
  162.   Setcolor(0);
  163.   OutTextXY(20,55,'Load a file');        {example of MGetFile}
  164.   OutTextXY(20,65,'Choose a color');        {example of MouseQuestion}
  165.   OutTextXY(20,75,'Hit a key');            {example of MouseReadKey}
  166.   OutTextXY(20,85,'Quit');            {example of MouseYN}
  167.  
  168.   if MReset = -1 then begin            {see if mouse installed}
  169.     MLimit(0,319-MW,0,199-MH);            {set mouse limits}
  170.     MPut(0,0);                    {reset mouse coordinates}
  171.   end;
  172.   Mx := 0; My := 0;                {reset mouse cursor}
  173.   Button := 0;
  174.   GetMem(MCurs,ImageSize(0,0,MW,MH));
  175.   MouseCursorOn(Mx,My,FINGER);
  176.   flag := FALSE;
  177.   repeat                    {repeat until quit}
  178.     MStatus(NewButton,NewX,NewY);        {get mouse status}
  179.     if (NewX <> Mx) or (NewY <> My) then begin    {mouse cursor moved!}
  180.       case MouseLocate(NewX,NewY,5,@mt) of
  181.         0: MouseCursor(NewX,NewY,Mx,My,ARROW);    {arrow if outside menu}
  182.         5: MouseCursor(NewX,NewY,Mx,My,HAND);    {hand if not valid selection}
  183.         else MouseCursor(NewX,NewY,Mx,My,FINGER); {valid selection pointed to}
  184.       end; {case}
  185.       Mx := NewX; My := NewY;            {remember new location}
  186.     end;
  187.     if NewButton <> Button then begin        {if button changed...}
  188.       if NewButton > 0 then begin        {if button now down...}
  189.     SetColor(0);
  190.     case MouseLocate(Mx,My,5,@mt) of    {do a command...}
  191.           1: FileExample;            {load a file}
  192.           2: ChooseExample;            {chose a color}
  193.           3: HitKeyExample;            {hit a key}
  194.       4: flag := MouseYN(100,80,'Quit?');    {quit}
  195.         end; {case}
  196.       end;
  197.     end;
  198.   until flag;
  199. end.
  200.