home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / qpdemo / beispiel / grafik.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-08-24  |  2.1 KB  |  85 lines
  1.  
  2. PROGRAM graphik; (* Zeigt alle Grafikmodi *)
  3.  
  4. USES    Crt, MSGraph;
  5. CONST   modes: ARRAY [0..11] OF Integer =
  6.            (_MRes4Color, _MResNoColor, _HResBW, _HercMono,
  7.         _MRes16Color, _HRes16Color, _EResNoColor,_EResColor,
  8.         _VRes2Color, _VRes16Color,_MRes256Color, _OResColor);
  9.  
  10. VAR     vc      : _VideoConfig;
  11.     ch, key : Char;
  12.     which   : Char;
  13.     a       : Integer;
  14.  
  15. PROCEDURE print_menu; (* Auswahlmenü *)
  16. BEGIN
  17.       WriteLn('Wählen Sie einen Grafikmodus');
  18.       WriteLn('Beenden mit "x"');
  19.       WriteLn;
  20.       WriteLn('0 _MRes4Color');
  21.       WriteLn('1 _MResNoColor');
  22.       WriteLn('2 _HResBW');
  23.       WriteLn('3 _HercMono');
  24.       WriteLn('4 _MRes16Color');
  25.       WriteLn('5 _HRes16Color');
  26.       WriteLn('6 _EResNoColor');
  27.       WriteLn('7 _EResColor');
  28.       WriteLn('8 _VRes2Color');
  29.       WriteLn('9 _VRes16Color');
  30.       WriteLn('a _VRes256Color');
  31.       WriteLn('b _OResColor');
  32. END;
  33.  
  34. PROCEDURE show_mode(which:Char); (* Grafik mit dem Modus *)
  35. VAR         nc, i  : Integer;
  36.         height : Integer;
  37.         width  : Integer;
  38.         mode   : String;
  39.         r      : Real;
  40.         e, m   : Integer;
  41.  
  42. BEGIN
  43.         mode := which;
  44.         IF (mode < '0') OR (mode > '9') THEN
  45.           IF mode = 'a' THEN mode := '10'
  46.           ELSE IF mode = 'b' THEN mode := '11'
  47.         ELSE Halt; (* Prozedur verlassen *)
  48.         Val(mode, r, e);
  49.         m := Trunc(r);
  50.         a := _SetVideoMode( modes[m] );
  51.         IF a <> 0 THEN
  52.         BEGIN
  53.           _GetVideoConfig( vc );
  54.           nc := vc.NumColors;
  55.           width := vc.NumXPixels DIV nc;
  56.           height := vc.NumYPixels DIV 2;
  57.           FOR i := 1 TO (nc - 1) DO
  58.           BEGIN
  59.             _SetColor( i );
  60.             _Rectangle( _GFillInterior, i * width,
  61.                       0, ( i + 1 ) * width, height );
  62.           END;
  63.         END
  64.         ELSE
  65.         BEGIN
  66.           WriteLn('Videoadapter ',which,' nicht vorhanden.');
  67.           WriteLn('Weiter mit der Eingabetaste.');
  68.         END;
  69.         ReadLn; (* Warten auf Eingabetaste *)
  70.         a := _SetVideoMode( _DefaultMode );
  71.         print_menu;
  72. END;
  73.  
  74. BEGIN (* Hauptprogramm *)
  75.         key := ' ';
  76.         _ClearScreen( _GClearScreen );
  77.         print_menu;
  78.         WHILE ( key <> 'x' ) DO
  79.         BEGIN
  80.           key := ReadKey;
  81.           show_mode( key );
  82.         END;
  83. END.
  84.  
  85.