[Back to GRAPHICS SWAG index]  [Back to Main SWAG index]  [Original]

{

 SL> Does someone has a pascalsource for showing a PCX file with a resolution
 SL> of 640x400x256 /or a automatic build-in convertor who wil let the drawing

Sure thing, the following code will load PCX files with 256 colors and variable
height and width (it looks into the header):  (Sorry about the german comments,
but I've got no time to erase them right now :-(( ) }

UNIT uVESAPcx;                                { (c) 1993 by NEBULA-Software }
     { PCX-Darstellungsroutinen f. VESA     } { Olaf Bartelt & Oliver Carow }

INTERFACE                                     { Interface-Teil der Unit     }

{ ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ Typen ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ }
TYPE  pVESAPcx   = ^tVESAPcx;                 { Zeiger auf Objekt           }
      tVESAPcx   = OBJECT                     { Objekt f�r PCX-Dateien      }
                     PROCEDURE load(f : STRING; dx, dy : WORD);
                   END;

{ ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ Variablen ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ }
VAR   vVESAPcx  : pVESAPcx;                   { Instanz des Objekts tPcx    }


IMPLEMENTATION                                { Implementation-Teil d. Unit }

USES uVesa;                                   { Einbinden der Units         }
{ CAN BE FOUND IN SWAG }

{ ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ tVESAPcx ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ }
PROCEDURE  tVESAPcx.load(f : STRING; dx, dy : WORD);
VAR q                          : FILE;
    b                          : ARRAY[0..2047] OF BYTE;
    anz, pos, c, w, h, e, pack : WORD;
    x, y                       : WORD;

LABEL ende_background;

BEGIN
  x := 0; y := 0;

  ASSIGN(q, f); {$I-} RESET(q, 1); {$I+}
  IF IORESULT <> 0 THEN
    GOTO ende_background;

  BLOCKREAD(q, b, 128, anz);
  IF (b[0] <> 10) OR (b[3] <> 8) THEN
  BEGIN
    CLOSE(q);
    EXIT;
  END;
  w := SUCC((b[9] - b[5]) SHL 8 + b[8] - b[4]);
  h := SUCC((b[11] - b[7]) SHL 8 + b[10] - b[6]);
  pack := 0; c := 0; e := y + h;
  REPEAT
    BLOCKREAD(q, b, 2048, anz);
    pos := 0;
    WHILE (pos < anz) AND (y < e) DO
    BEGIN
      IF pack <> 0 THEN
      BEGIN
        FOR c := c TO c + pack DO
          vVesa^.putpixel(x + c+dx, y+dy, b[pos]);
        pack := 0;
      END
      ELSE
        IF (b[pos] AND $C0) = $C0 THEN
          pack := b[pos] AND $3F
        ELSE
        BEGIN
          vVesa^.putpixel(x + c+dx, y+dy, b[pos]);
          INC(c);
        END;
      INC(pos);
      IF c = w THEN
      BEGIN
        c := 0;
        INC(y);
      END;
    END;
  UNTIL (anz = 0) OR (y = e);
  SEEK(q, FILESIZE(q) - 3 SHL 8 - 1);
  BLOCKREAD(q, b, 3 SHL 8 + 1);
  IF b[0] = 12 THEN
    FOR x := 1 TO 3 SHL 8 + 1 DO
      b[x] := b[x] SHR 2;
  CLOSE(q);

  ende_background:
END;


{ ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ Hauptprogramm ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ }
BEGIN
  NEW(vVESAPcx);
END.

Remember to put in *your* putpixel routines there!

scroll from top till bottom.(VGA/SVGAcompat./TPASCAL6.0)

[Back to GRAPHICS SWAG index]  [Back to Main SWAG index]  [Original]