home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / sonderh1 / celldemo.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1987-03-13  |  2.1 KB  |  72 lines
  1. {---------------------------------------------------------------------------}
  2. {              Demonstration der GSX-Cell-Array-Funktion:                   }
  3. { Fuer das hier verwendete 'ColorIndexArray' muss der Typ 'VDI_intin' in    }
  4. { GSXTYPE.PAS wegen der Menge der Daten folgendermassen geaendert werden:   }
  5. {                VDI_intin = ARRAY [1..1200] OF INTEGER;                    }
  6. {---------------------------------------------------------------------------}
  7.  
  8. PROGRAM CellArrayDemo;
  9.  
  10. CONST
  11.   {$I gsxconst.pas}
  12.   CelCols = 60;                                   { unser Cell-Array hat 60 }
  13.   CelRows = 20;                                   { Spalten und 20 Zeilen   }
  14.  
  15. TYPE
  16.   {$I gsxtype.pas}
  17.  
  18. VAR
  19.   {$I gsxvar.pas}
  20.   CArray: VDI_intin;
  21.   CDaten: TEXT;
  22.  
  23. {$I gsxvdi.pas}
  24. {$I gsxlib1.pas}
  25.  
  26. {---------------------------------------------------------------------------}
  27.  
  28. PROCEDURE Read_CArray;
  29.  
  30. VAR i: INTEGER;
  31.  
  32. BEGIN
  33.   Assign(CDaten, 'CELLDEMO.DAT');
  34.   ReSet(CDaten);
  35.   FOR i := 1 TO CelRows*CelCols DO
  36.   BEGIN
  37.     Read(CDaten, CArray[i]);
  38.     IF (i MOD 30) = 0 THEN
  39.     BEGIN
  40.       ReadLn(CDaten);
  41.       Write('.');
  42.     END;
  43.   END;
  44.   WriteLn;  WriteLn;
  45. END;
  46.  
  47. {---------------------------------------------------------------------------}
  48.  
  49. BEGIN
  50.   WriteLn;  Write('Lese Daten des Cell-Arrays...');
  51.   Read_CArray;
  52.   Open_Workstation(Screen);
  53.   IF CellArrays THEN
  54.     BEGIN
  55.       Enter_Graphics;
  56.       Cell_Array( 1000,  1000,  4500,  3500, CArray,
  57.                  CelRows, CelCols, CelCols, Replace);
  58.       Cell_Array( 5000,  1000, 32000,  4000, CArray,
  59.                  CelRows, CelCols, CelCols, Replace);
  60.       Cell_Array( 2000,  7000,  6000, 32000, CArray,
  61.                  CelRows, CelCols, CelCols, Replace);
  62.       Cell_Array(18000, 20000, 28000, 27000, CArray,
  63.                  CelRows, CelCols, CelCols, Replace);
  64.       Cell_Array(12000, 12000, 19000, 15000, CArray,
  65.                  CelRows, CelCols, CelCols, Replace);
  66.     END
  67.   ELSE
  68.     Write('Geraet unterstuetzt keine Cell-Arrays !');
  69.   REPEAT UNTIL KeyPressed;
  70.   Close_Workstation;
  71. END.
  72.