home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1990 / 12 / tricks / togray.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1990-09-11  |  2.7 KB  |  87 lines
  1. (* ------------------------------------------------------ *)
  2. (*                      TOGRAY.PAS                        *)
  3. (*  Wandelt Bi-level Bilder in Graustufen-Bilder um.      *)
  4. (*  Belegt Interrupt 8, arbeitet im Modus 640 x 480 x 16  *)
  5. (*          (c) 1990  Dietmar Ring  & TOOLBOX             *)
  6. (* ------------------------------------------------------ *)
  7. {$M 4096,0,48000}
  8.  
  9. USES Graph, Dos, Crt;
  10.  
  11. CONST
  12.   Breite = 639;                         { Bildschirmbreite }
  13.   Hoehe  = 479;                         { Bildschirmhöhe   }
  14.  
  15. VAR
  16.   Driver, Modus : INTEGER;
  17.   Driver_zeiger : POINTER;
  18.   Fehler        : INTEGER;
  19.  
  20. {$L EGAVGA}                   { Bindet den VGA-Treiber ein }
  21.  
  22.   PROCEDURE EgaVGAdriverProc;  EXTERNAL;
  23.  
  24.   PROCEDURE Schreiben;         INTERRUPT;
  25.     { Konvertierungs-Prozedur,           }
  26.     { wird durch Interrupt 5 aufgerufen  }
  27.   VAR
  28.      x,  y : INTEGER;                 { Bildschirmposition }
  29.     xx, yy : INTEGER;                 { Raster             }
  30.     Raster : INTEGER;                 { Rastergröße        }
  31.     Farbe  : INTEGER;                 { Errechnete Farbe   }
  32.     Result : INTEGER;
  33.   BEGIN
  34.     Raster := 0;
  35.     WHILE (Raster = 0) DO BEGIN      { Abfrage Rastergröße }
  36.       VAL(ReadKey, Raster, Result);
  37.     END;
  38.     IF (Raster = 1) THEN
  39.       Raster := 3;                   { Default-Raster      }
  40.  
  41.     FOR y := 0 TO Hoehe DO BEGIN     { Konvertierung       }
  42.       FOR x := 0 TO Breite DO BEGIN
  43.         Farbe := 1;
  44.         FOR xx := 1 TO Raster DO BEGIN
  45.           FOR yy := 1 TO Raster DO BEGIN
  46.             IF (GetPixel(x+xx, y+yy)) > 0 THEN
  47.                          { Für jedes im Raster gesetztes   }
  48.               Inc(Farbe);
  49.                          { Pixel wird Farbe um 1 erhöht    }
  50.           END;
  51.         END;
  52.         PutPixel(x, y, Farbe);
  53.         IF KeyPressed THEN      { Abrage auf Abbruch (ESC) }
  54.           IF (ReadKey = #27) THEN Exit;
  55.       END;
  56.     END;
  57.   END;
  58.  
  59. BEGIN
  60.   Driver := VGA;
  61.   Modus  := VGAHI;
  62.  
  63.   Fehler := RegisterBGIdriver(Addr(EgaVGAdriverProc));
  64.   InitGraph(Driver, Modus, '');
  65.  
  66.   IF (Fehler > -1) THEN BEGIN
  67.     SetIntVec(5, @Schreiben);
  68.     OuttextXY(10, 15, 'ToGray installiert');
  69.     OuttextXY(10, 30, 'Aufruf mit <Prtscr> gefolgt von ' +
  70.                       '<2>, <3>, <4> oder <5>');
  71.     OuttextXY(10, 45, '<Prtscr><1> ruft das Programm ' +
  72.                       'mit Defaultwerten auf');
  73.     WriteLn;
  74.     WriteLn;
  75.     WriteLn;
  76.     Keep(0);
  77.   END;
  78.  
  79.   RestoreCrtMode;
  80.   WriteLn;
  81.   WriteLn('Fehler: nicht installert ');
  82.   Halt(1);
  83.  
  84. END.
  85. (* ------------------------------------------------------ *)
  86. (*                  Ende von TOGRAY.PAS                   *)
  87.