home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1990 / 12 / tricks / togray2.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1990-09-11  |  2.3 KB  |  86 lines
  1. (* ------------------------------------------------------ *)
  2. (*                      TOGRAY2.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. VAR
  12.   Driver, Modus : INTEGER;
  13.   Driver_zeiger : POINTER;
  14.   Fehler        : INTEGER;
  15.   Breite, Hoehe : INTEGER;
  16.  
  17. {$L EGAVGA}                   { Bindet den VGA-Treiber ein }
  18.  
  19.   PROCEDURE EgaVGAdriverProc;  EXTERNAL;
  20.  
  21.   PROCEDURE Schreiben;         INTERRUPT;
  22.   VAR
  23.      x,  y : INTEGER;
  24.     xx, yy : INTEGER;
  25.     Raster : INTEGER;
  26.     Mstab  : INTEGER;
  27.     Farbe  : INTEGER;
  28.     Result : INTEGER;
  29.   BEGIN
  30.     Raster := 0;
  31.     Mstab  := 0;
  32.     WHILE (Raster = 0) DO Val(ReadKey, Raster, Result);
  33.     IF (Raster = 1) THEN
  34.       Raster := 3;
  35.     WHILE (Mstab = 0) DO  Val(ReadKey, Mstab, Result);
  36.     x := 0;
  37.     y := 0;
  38.     WHILE (y < Hoehe) DO BEGIN
  39.       WHILE (x < Breite) DO BEGIN
  40.         Farbe := 1;
  41.         FOR xx := 1 TO Raster DO
  42.           FOR yy := 1 TO Raster DO
  43.             IF (GetPixel(x+xx, y+yy)) > 0 THEN Inc(Farbe);
  44.         PutPixel(Trunc(x/Mstab), Trunc(y/Mstab), Farbe);
  45.         IF KeyPressed THEN
  46.           IF (ReadKey = #27) THEN Exit;
  47.         Inc(x, Mstab);
  48.       END;
  49.       x := 1;
  50.       Inc(y, Mstab);
  51.     END;
  52.   END;
  53.  
  54. BEGIN
  55.   Driver := VGA;
  56.   Modus  := VGAHi;
  57.   Breite := 639;
  58.   Hoehe  := 479;
  59.  
  60.   Fehler := RegisterBGIdriver(Addr(EgaVGAdriverProc));
  61.   InitGraph(Driver, Modus, '');
  62.  
  63.   IF (Fehler > -1) THEN BEGIN
  64.     SetIntVec(5, @Schreiben);
  65.     OuttextXY(10, 15, 'ToGray installiert');
  66.     OuttextXY(10, 30, 'Aufruf mit <Prtscr> gefolgt von ');
  67.     OuttextXY(10, 45, 'zweimal einer Zahl zwischen ' +
  68.                       '1 und 9');
  69.     OuttextXY(10, 60, 'Prtscr 1 1 ruft mit ' +
  70.                       'Defaultwerten auf');
  71.     WriteLn;
  72.     WriteLn;
  73.     WriteLn;
  74.     WriteLn;
  75.     Keep(0);
  76.   END;
  77.  
  78.   RestoreCrtMode;
  79.   WriteLn;
  80.   WriteLn('Fehler: nicht installert ');
  81.   Halt(1);
  82.  
  83. END.
  84. (* ------------------------------------------------------ *)
  85. (*                 Ende von TOGRAY2.PAS                   *)
  86.