home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1991 / 03 / review / menudemo.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1990-12-12  |  3.1 KB  |  87 lines
  1. PROGRAM MenuDemo;
  2.  Demonstration der Menu- und Maskenfunktionen }
  3.  (c) 1990 Prospero Software }
  4. {$I PASPC}
  5.  
  6. AR f : TEXT; Ch : Char; Sc : Byte; Title, Object : Byte;
  7.    AString : String [20];  AForm : FormPtr;
  8.    AByte   : Byte;         Exit  : Boolean;
  9.  
  10. ROCEDURE Process (Title,Object:Byte);
  11.  VAR f : Text; Hours,Minutes,Seconds,Hundreths : Integer;
  12.      Ch : Char; Scan : Byte;
  13.  BEGIN
  14.    CursorOff;
  15.    CASE Title OF
  16.      1 : CASE Object OF              {   Information ... }
  17.        1 : BEGIN                     { ... Über MenuDemo }
  18.          StartMessage (10,10,59,14); Paper (Red);
  19.          Ink (Yellow); TextFrame (TRUE); ClrScr;
  20.          PutString ('MenuDemo wurde mit Prospero '+
  21.                     'Pascal entwickelt.',2,2);
  22.          GetKeyboard (Ch,Scan); EndMessage;
  23.        END;
  24.        2 : BEGIN                      { ... Über Uhrzeit }
  25.          ScreenFile (f);
  26.          StartMessage (20,10,44,14); Paper (Blue);
  27.          Ink (LightGrey); TextFrame (FALSE); ClrScr;
  28.          REPEAT
  29.            Time (Hours,Minutes,Seconds,Hundreths);
  30.            GotoXY(2,2);
  31.            Write (f,'Es ist jetzt ',Hours:2,':',
  32.            Minutes:2,'.',Seconds:2);
  33.          UNTIL KeyPressed;
  34.          GetKeyboard (Ch,Scan); EndMessage;
  35.        END;
  36.      END;
  37.      2 : CASE Object OF { Optionen }
  38.        1 : IF FormDo (AForm) THEN BEGIN
  39.          ScreenFile (f); Writeln (f);
  40.          Write (f,' Mein Name ist ',AString,'. ');
  41.          IF AByte=1 THEN Write (f,'Ich bin ein Mann.');
  42.          IF AByte=2 THEN Write(f,'Ich bin eine Frau.');
  43.          Writeln(f);
  44.        END;
  45.           { 2 : Sollte nicht vorkommen, da nicht wählbar }
  46.      3 : BEGIN                 {   Beenden des Programms }
  47.        StartMessage (20,20,29,22); Paper (LightGrey);
  48.        Ink (Black); ClrScr; PutString ('ENDE',4,2);
  49.        Beep; EndMessage;
  50.        END;
  51.      END;
  52.    END;
  53.    CursorOn;
  54.  END;
  55.  
  56. BEGIN
  57.   InitScreen;                 { Standardwerte  für  ... }
  58.   MenuCreate ('$P3$I0$U1$V3'+ { Vorder/Hintergrundfarbe }
  59.               '$M3$N0$Y3$Z0$S0$T3 '+        { Pull-down }
  60.               '$W20$HI$  $I4I$I0nformation '+ { Menu-   }
  61.               '$W20$HO$  $I4O$I0ptionen ');   { balken  }
  62.   MenuAdd (1,'$HM Über MenuDemo    M ');
  63.   MenuAdd (1,'$HZ Über die Uhrzeit Z ');
  64.   MenuAdd (2,'$KF$HF Einfache Maske  $AF ');
  65.   MenuAdd (2,'$D--------------------');
  66.   MenuAdd (2,'$KE$HE Ende            $AE ');
  67.   FormCreate (AForm,16,7,49,7,0,7);
  68.   FormString (AForm,'$X2$Y2 Name :-');
  69.   FormEdit   (AForm,11,2,20,FormASCII,AString);
  70.   FormCycle  (AForm,AByte,2,5,' Geschlecht :- ' +
  71.                           '$X18$  MÄNNLICH $  WEIBLICH ');
  72.   MenuDisplay; TextWindow (2,3,79,24); TextFrame (TRUE);
  73.   ScreenFile (f);  Exit := FALSE;
  74.   WHILE Not (Exit) DO
  75.   BEGIN
  76.     GetKeyboard(Ch,Sc);
  77.     IF (Ch = Chr(0)) AND_THEN MenuDo (Sc,Title,Object) THEN
  78.       BEGIN
  79.         Process (Title,Object);
  80.         IF (Title = 2) AND (Object = 3) THEN Exit := TRUE;
  81.         MenuSelect (Title,TRUE); { Markierung AUS }
  82.       END
  83.     ELSE IF Ch IN [Chr(32)..Chr(127)] THEN Write (f,Ch)
  84.     ELSE IF Ch = Chr(13) THEN Writeln (f);
  85.   END;
  86. END.
  87.