home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / grafik / vgakit / tga / tga32.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1991-08-14  |  2.2 KB  |  103 lines
  1.  
  2. PROGRAM TGA32;
  3. {
  4.   UMWANDELN EINES TARGA 24- BIT FILES IN EIN TARGA 16- BIT FILE
  5. }
  6.  
  7.  
  8. TYPE  RGBTYP = RECORD R,G,B : BYTE END;
  9.  
  10.  
  11. TYPE  HDRTYP = RECORD
  12.         FILL              : ARRAY[1..6] OF WORD;
  13.         WID               : WORD;
  14.         HIG               : WORD;
  15.         TYP               : BYTE;
  16.         FLAGS             : BYTE;
  17.       END;
  18.  
  19.  
  20. VAR   I,J,K    : INTEGER;
  21.       BB       : BYTE;
  22.       W,W2     : WORD;
  23.       BUF      : ARRAY[0..$3FFF] OF RGBTYP;
  24.       BUF2     : ARRAY[0..$3FFF] OF WORD ABSOLUTE BUF;
  25.       F1,F2    : FILE;
  26.       S,N1,N2  : STRING;
  27.       HDR      : HDRTYP;
  28.       BPP      : BYTE;
  29.  
  30.  
  31. FUNCTION LIESHDR:BOOLEAN;
  32. BEGIN
  33.   LIESHDR := FALSE;
  34.   BLOCKREAD(F1,HDR,SIZEOF(HDR));
  35.   WITH HDR DO BEGIN
  36.     IF FILL[1] <> 0 THEN EXIT;
  37.     IF FILL[2] <> 2 THEN EXIT;
  38.     IF FILL[3] <> 0 THEN EXIT;
  39.     IF FILL[4] <> 0 THEN EXIT;
  40.     IF FILL[5] <> 0 THEN EXIT;
  41.     IF FILL[6] <> 0 THEN EXIT;
  42.  
  43.     IF TYP = $18 THEN BEGIN
  44.       BPP := 3;
  45.       LIESHDR := TRUE;
  46.       EXIT;
  47.     END;
  48.     IF TYP = $10 THEN BEGIN
  49.       BPP := 2;
  50.       LIESHDR := TRUE;
  51.       EXIT;
  52.     END;
  53.   END; { WITH HDR }
  54. END; { LIESHDR }
  55.  
  56.  
  57. BEGIN
  58.   IF PARAMCOUNT < 2 THEN HALT;
  59.   N1 := PARAMSTR(1);
  60.   N2 := PARAMSTR(2);
  61.   IF POS('.',N1) = 0 THEN N1 := N1 + '.TGA';
  62.   IF POS('.',N2) = 0 THEN N2 := N2 + '.TGA';
  63.  
  64.   ASSIGN(F1,N1);
  65.   RESET(F1,1);
  66.   BPP := 0;
  67.   IF NOT LIESHDR THEN BEGIN
  68.     WRITELN(N1,' hat keinen gültigen Header');
  69.     HALT;
  70.   END;
  71.   IF BPP <> 3 THEN BEGIN
  72.     WRITELN(N1,' ist kein 24- Bit TARGA- File');
  73.     HALT;
  74.   END;
  75.  
  76.   ASSIGN(F2,N2);
  77.   REWRITE(F2,1);
  78.   HDR.TYP := $10;
  79.   BLOCKWRITE(F2,HDR,SIZEOF(HDR));
  80.  
  81.   REPEAT
  82.     BLOCKREAD(F1,BUF,SIZEOF(BUF),W);
  83.     IF W > 0 THEN BEGIN
  84. (*
  85. WRITE(W:6,W DIV 3:6,'        ');
  86. *)
  87.       FOR I := 0 TO (PRED(W) DIV 3) DO BEGIN
  88.         WITH BUF[I] DO BEGIN
  89.           W2 :=        (WORD(B) AND $F8) SHL 7;
  90.           W2 := W2 OR ((WORD(G) AND $F8) SHL 2);
  91.           W2 := W2 OR  (WORD(R) AND $F8) SHR 3;
  92.         END; { WITH }
  93.         BUF2[I] := W2;
  94.       END; { NEXT I }
  95.       BLOCKWRITE(F2,BUF,(W DIV 3) SHL 1);
  96.     END;
  97.   UNTIL (W < SIZEOF(BUF));
  98.   CLOSE(F2);
  99.   CLOSE(F1);
  100.  
  101. END.
  102.  
  103.