home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / grafik / tiftool / readtif1.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1991-03-08  |  28.5 KB  |  928 lines
  1.  
  2. PROGRAM READTIFF;
  3. {
  4.   Paul Schubert, Rottweiler Str. 8, 6000 Frankfurt 1, 069 / 231145
  5.  
  6.   PROGRAMM ZUM LESEN VON ALDUS / MICROSOFT TIFF- FILES
  7.   IM BILEVEL- UND GRAYSCALE- FORMAT
  8.  
  9.   DANK AN TORSTEN PRIEBE, VON DEM ICH DIE TIFF- SPEZIFIKATION UND
  10.   DIE LISTE DER TAG- NAMEN ERHALTEN HABE
  11.  
  12. }
  13. {$F+}
  14.  
  15.  
  16. {.$DEFINE TEST}
  17.  
  18.  
  19. USES  SELECTD,VIDEO,GRAPH,EGAVGA,
  20.       GETPUT,TIFFUNIT,BUFFILE,
  21.       PARRAY,
  22.       TPDIR,DOS,TPPICK,
  23.       TPCRT,TPDOS,TPSTRING,TPEDIT,
  24.       TPENHKBD,TPWINDOW;
  25.  
  26.  
  27. TYPE  VPARTYP = RECORD
  28.         M    : WORD; { VIDEO- MODE }
  29.         X,Y  : WORD; { GETMAXX, GETMAXY }
  30.       END;
  31.  
  32.  
  33. {$IFDEF TEST}
  34. CONST DEFMASK  : STRING[64] = 'D:\BILDER\*.TIF';
  35. { SONDER- VIDEOMODI FÜR BILEVEL- DARSTELLUNG }
  36.       USEMODE12H : BOOLEAN = TRUE; { VIDEO- MODUS 12H AUF EGA BENUTZEN }
  37.       USE80X60F1 : BOOLEAN = TRUE; { TREIBER 800*600 /  16 BENUTZEN }
  38. { SONDER- VIDEOMODI FÜR GRAYSCALE- UND SPÄTER AUCH FARBBILDER }
  39.       USE64X48F2 : BOOLEAN = TRUE; { TREIBER 640*480 / 256 BENUTZEN }
  40.       USE80X60F2 : BOOLEAN = TRUE; { TREIBER 800*600 / 256 BENUTZEN }
  41. {$ELSE}
  42. CONST DEFMASK  : STRING[64] = '*.TIF';
  43. { SONDER- VIDEOMODI FÜR BILEVEL- DARSTELLUNG }
  44.       USEMODE12H : BOOLEAN = FALSE; { VIDEO- MODUS 12H AUF EGA BENUTZEN }
  45.       USE80X60F1 : BOOLEAN = FALSE; { TREIBER 800*600 /  16 BENUTZEN }
  46. { SONDER- VIDEOMODI FÜR GRAYSCALE- UND SPÄTER AUCH FARBBILDER }
  47.       USE64X48F2 : BOOLEAN = FALSE; { TREIBER 640*480 / 256 BENUTZEN }
  48.       USE80X60F2 : BOOLEAN = FALSE; { TREIBER 800*600 / 256 BENUTZEN }
  49. {$ENDIF}
  50.  
  51. CONST PROGNAME : STRING[12] = 'READTIF1.EXE';
  52.       HEAPMIN    : LONGINT = 4096; { MINIMALER PLATZ, DEN EIN BILD AUF
  53.                                      DEM HEAP LASSEN MUß }
  54.  
  55.  
  56. CONST V          : ARRAY[1..6] OF VPARTYP =
  57.          ((M:$10;X:639;Y:349),   {       EGA 640 * 350 /  16 }
  58.           (M:$12;X:639;Y:479),   { VGA / EGA 640 * 480 /  16 }
  59.           (M:$13;X:319;Y:199),   {       VGA 320 * 200 / 256 }
  60.           (M:$2E;X:639;Y:479),   { EXTRA VGA 640 * 480 / 256 }
  61.           (M:$29;X:799;Y:599),   { VGA / EGA 800 * 600 /  16 }
  62.           (M:$30;X:799;Y:599));  { EXTRA VGA 800 * 600 / 256 }
  63.  
  64.  
  65. VAR   NAME,MASK,NM  : STRING;
  66.       I             : WORD;
  67.       DIRRET        : BYTE;
  68.       GD,GM         : INTEGER;
  69.       GRMAX         : LONGINT;
  70.       RX,RY         : REAL;
  71.  
  72.  
  73. PROCEDURE PIEP;
  74. BEGIN
  75.   SOUND(2500);
  76.   DELAY(80);
  77.   SOUND(800);
  78.   DELAY(120);
  79.   NOSOUND;
  80. END; { PIEP }
  81.  
  82.  
  83. PROCEDURE TICK;
  84. BEGIN
  85.   SOUND(4000);
  86.   DELAY(1);
  87.   NOSOUND;
  88. END; { TICK }
  89.  
  90.  
  91. PROCEDURE WRITECONFIG;
  92. VAR   F          : FILE;
  93.       I,NBL,NBB  : WORD;
  94.       FE         : LONGINT;
  95.       N          : STRING[12];
  96. BEGIN
  97. {$I-}
  98.   ASSIGN(F,PROGNAME);
  99.   RESET(F,1);
  100.   IF IORESULT <> 0 THEN EXIT;
  101.   BLOCKREAD(F,I,2); { EXE - ID }
  102.   BLOCKREAD(F,NBL,2); { BYTES IM LETZTEN BLOCK }
  103.   BLOCKREAD(F,NBB,2); { 512- BYTE- BLOCKS }
  104.   FE := LONGINT(NBB) * 512 - (512 - NBL);
  105.   SEEK(F,FE);
  106.   BLOCKWRITE(F,PROGNAME,SIZEOF(PROGNAME));
  107.   BLOCKWRITE(F,DEFMASK,SIZEOF(DEFMASK));
  108.   BLOCKWRITE(F,USEMODE12H,1);
  109.   BLOCKWRITE(F,USE80X60F1,1);
  110.   BLOCKWRITE(F,USE64X48F2,1);
  111.   BLOCKWRITE(F,USE80X60F2,1);
  112.   BLOCKWRITE(F,USEET4000,1);
  113.   BLOCKWRITE(F,SEGPORT,2);
  114.   BLOCKWRITE(F,HEAPMIN,4);
  115.   BLOCKWRITE(F,V,SIZEOF(V));
  116.   FCLOSE(F);
  117. {$I+}
  118. END; { WRITECONFIG }
  119.  
  120.  
  121. PROCEDURE READCONFIG;
  122. VAR   F          : FILE;
  123.       I,NBL,NBB  : WORD;
  124.       FE         : LONGINT;
  125.       N          : STRING[12];
  126. BEGIN { READCONFIG }
  127. {$I-}
  128.   ASSIGN(F,PROGNAME);
  129.   RESET(F,1);
  130.   IF IORESULT <> 0 THEN EXIT;
  131.   BLOCKREAD(F,I,2); { EXE - ID }
  132.   BLOCKREAD(F,NBL,2); { BYTES IM LETZTEN BLOCK }
  133.   BLOCKREAD(F,NBB,2); { 512- BYTE- BLOCKS }
  134.   FE := LONGINT(NBB) * 512 - (512 - NBL);
  135.   SEEK(F,FE);
  136.   N := '';
  137.   BLOCKREAD(F,N[0],13);
  138.   IF (IORESULT <> 0) OR (N <> PROGNAME) THEN BEGIN
  139.     FCLOSE(F);
  140.     WRITECONFIG;
  141.     RESET(F,1);
  142.     SEEK(F,FE);
  143.   END ELSE BEGIN
  144.     BLOCKREAD(F,DEFMASK,SIZEOF(DEFMASK));
  145.     BLOCKREAD(F,USEMODE12H,1);
  146.     BLOCKREAD(F,USE80X60F1,1);
  147.     BLOCKREAD(F,USE64X48F2,1);
  148.     BLOCKREAD(F,USE80X60F2,1);
  149.     BLOCKREAD(F,USEET4000,1);
  150.     BLOCKREAD(F,SEGPORT,2);
  151.     BLOCKREAD(F,HEAPMIN,4);
  152.     BLOCKREAD(F,V,SIZEOF(V));
  153.   END;
  154.   FCLOSE(F);
  155. {$I+}
  156. END; { READCONFIG }
  157.  
  158.  
  159. FUNCTION JANEINABFRAGE(X,Y:BYTE;VAR WERT:BOOLEAN):CHAR;
  160. CONST JANEIN = ['J','Y','N',CHAR($80+72),CHAR($80+80),^[];
  161. VAR   CH1  : CHAR;
  162. BEGIN
  163.   READCHARACTER('J/N ?',Y,X,$0F,JANEIN,CH1);
  164.   IF CH1 IN ['J','Y'] THEN WERT := TRUE;
  165.   IF CH1 = 'N'        THEN WERT := FALSE;
  166.   JANEINABFRAGE := CH1;
  167. END; { JANEINABFRAGE }
  168.  
  169.  
  170. PROCEDURE WERTABFRAGE(X,Y,WID:BYTE;MI,MA:WORD;VAR WERT:WORD);
  171. VAR   I    : WORD;
  172.       ESC  : BOOLEAN;
  173. BEGIN
  174.   I := WERT;
  175.   READWORD('',Y,X,WID,$07,$0F,MI,MA,ESC,I);
  176.   IF NOT ESC THEN WERT := I;
  177. END; { WERTABFRAGE }
  178.  
  179.  
  180. PROCEDURE CONFIG;
  181. VAR   I        : WORD;
  182.       CH1,CH2  : CHAR;
  183.       ESC      : BOOLEAN;
  184.       IPF      : BYTE;
  185. BEGIN { CONFIG }
  186.   READCONFIG;
  187.   CLRSCR;
  188.   IF NOT ADDEDITCOMMAND(RSUSER0,1,72 SHL 8,0) THEN BEGIN END;
  189.   IF NOT ADDEDITCOMMAND(RSUSER1,1,80 SHL 8,0) THEN BEGIN END;
  190.   IF NOT ADDEDITCOMMAND(RSUSER2,1,9,0) THEN BEGIN END;
  191.   FORCEUPPER := TRUE;
  192.  
  193.   IPF := 3;
  194.   REPEAT
  195.     CH1 := #0;
  196.     CH2 := #0;
  197.     RSCHWORD := 0;
  198.     TEXTATTR := $4E;
  199.     GOTOXY(1,1);
  200.     CLREOL;
  201.     WRITE('  <Esc> = Konfiguration Ende');
  202.     TEXTATTR := $07;
  203.     GOTOXY(1,3); WRITE('  Konfigurieren Programm ',PROGNAME);
  204.     GOTOXY(1,5); WRITE('Default- Suchmaske : ',DEFMASK);
  205.     GOTOXY(1,7); WRITE('Bei EGA VideoMode 12H verwenden : ');
  206.     IF USEMODE12H THEN WRITE(' JA ') ELSE WRITE('NEIN');
  207.     CLREOL;
  208.     GOTOXY(1,9); WRITE('   Video- Modi : MAXX-1  MAXY-1        verwenden');
  209.     TEXTATTR := $1B;
  210.     GOTOXY(1,23); WRITE(' Auswählen der Eingabefelder durch Cursor auf/ab');
  211.     CLREOL;
  212.     GOTOXY(1,24); WRITE(' Die Abfrage J/N ? akzeptiert J oder Y für Ja, N für Nein');
  213.     CLREOL;
  214.     GOTOXY(1,25); WRITE(' Eingabe von HEX- Werten erfolgt durch Voranstellen von $ (z.B. $5E)');
  215.     CLREOL;
  216.     TEXTATTR := $07;
  217.     FOR I := 4 TO 6 DO BEGIN
  218.       GOTOXY(8,7+I);
  219.       WRITE(HEXB(V[I].M),'H (',V[I].M,'), ',V[I].X:4,' * ',V[I].Y:4,'  ');
  220.       CASE I OF
  221.         4 : BEGIN
  222.               WRITE(' 256 Farben ');
  223.               IF USE64X48F2 THEN WRITE(' JA ') ELSE WRITE('NEIN');
  224.             END;
  225.         5 : BEGIN
  226.               WRITE('  16 Farben ');
  227.               IF USE80X60F1 THEN WRITE(' JA ') ELSE WRITE('NEIN');
  228.             END;
  229.         6 : BEGIN
  230.               WRITE(' 256 Farben ');
  231.               IF USE80X60F2 THEN WRITE(' JA ') ELSE WRITE('NEIN');
  232.             END;
  233.       END; { CASE I }
  234.       CLREOL;
  235.     END; { NEXT I }
  236.     GOTOXY(1,15); WRITE('VGA- Chip ET4000       : ');
  237.     IF USEET4000 THEN WRITE(' JA ') ELSE WRITE('NEIN');
  238.     CLREOL;
  239.     GOTOXY(1,16); WRITE('Segment- Port- Adresse : ',HEXW(SEGPORT),' (',SEGPORT,')');
  240.     GOTOXY(1,17); WRITE('minimaler freier HEAP  : ',HEAPMIN);
  241.     CASE IPF OF
  242. {$V-}
  243.       2 : READSTRING('',5,22,PRED(SIZEOF(DEFMASK)),$07,$0F,$0E,ESC,DEFMASK);
  244. {$V+}
  245.       3 : CH1 := JANEINABFRAGE(40,7,USEMODE12H);
  246.  
  247.       4 : CH1 := JANEINABFRAGE(48,11,USE64X48F2);
  248.       5 : CH1 := JANEINABFRAGE(48,12,USE80X60F1);
  249.       6 : CH1 := JANEINABFRAGE(48,13,USE80X60F2);
  250.  
  251.       7 : WERTABFRAGE(13,11,3,  0, 255,V[4].M);
  252.       8 : WERTABFRAGE(19,11,4,319,1199,V[4].X);
  253.       9 : WERTABFRAGE(26,11,4,199,1023,V[4].Y);
  254.  
  255.      10 : WERTABFRAGE(13,12,3,  0, 255,V[5].M);
  256.      11 : WERTABFRAGE(19,12,4,319,1199,V[5].X);
  257.      12 : WERTABFRAGE(26,12,4,199,1023,V[5].Y);
  258.  
  259.      13 : WERTABFRAGE(13,13,3,  0, 255,V[6].M);
  260.      14 : WERTABFRAGE(19,13,4,319,1199,V[6].X);
  261.      15 : WERTABFRAGE(26,13,4,199,1023,V[6].Y);
  262.  
  263.      16 : CH1 := JANEINABFRAGE(31,15,USEET4000);
  264.      17 : WERTABFRAGE(32,16,4,  0,$3FF,SEGPORT);
  265.      18 : READLONGINT('',17,26,8,$07,$0F,512,65536,ESC,HEAPMIN);
  266.     END; { CASE }
  267.  
  268.     IF CH1 = #0 THEN CH1 := CHAR(LO(RSCHWORD));
  269.     IF CH2 = #0 THEN CH2 := CHAR(HI(RSCHWORD));
  270.     CASE CH2 OF
  271.       #72 : IF IPF > 2  THEN DEC(IPF);
  272.       #80 : IF IPF < 18 THEN INC(IPF);
  273.     END; { CASE HI(RSCHWORD }
  274.   UNTIL CH1 = ^[;
  275.   WRITECONFIG;
  276.   CLRSCR;
  277. END; { CONFIG }
  278.  
  279.  
  280. FUNCTION DIRECTORY(VAR MASK:STRING):STRING;
  281. CONST DIRCOLORS : PICKCOLORARRAY = ($1B,$1E,$1E,$50,$1F,$50);
  282. { NORMAL, RAND, ÜBERSCHRIFT, CURSOR, DIRECTORIES, CURSOR AUF DIRECTORIES }
  283. VAR   CH1  : CHAR;
  284. BEGIN
  285.   PICKSRCH := STRINGALTSRCH {STRINGPICKSRCH} {CHARPICKSRCH} {CHARPICKNOW};
  286.   GOTOXY(1,4);
  287. {                               XLO,YLO,YHI,SPALTEN      }
  288.   CASE GETFILENAME(MASK,ANYFILE,1,18,25,5,DIRCOLORS,NAME) OF
  289.     0 : BEGIN
  290.           DIRRET := 0;
  291.           IF PICKCHAR = #$C4 THEN BEGIN
  292.             CONFIG;
  293.             MASK := DEFMASK;
  294.             NAME := '*';
  295.           END;
  296.         END;
  297. 1,2,3 : BEGIN
  298.           WRITELN(MASK+' PFAD NICHT GEFUNDEN');
  299.           NAME := '*';
  300.           MASK := DEFAULTDRIVE + ':\*.TIF';
  301.           INC(DIRRET);
  302.           IF DIRRET > 2 THEN BEGIN
  303.             WRITELN;
  304.             WRITELN('Konfigurieren J/N ? ');
  305.             REPEAT
  306.               CH1 := UPCASE(READKEY);
  307.             UNTIL CH1 IN ['Y','J','N',^[];
  308.             IF (CH1 = 'N') OR (CH1 = ^[) THEN HALT;
  309.             CONFIG;
  310.             MASK := DEFMASK;
  311.           END;
  312.         END;
  313.     4 : BEGIN
  314.           WRITELN('ZU WENIG SPEICHER');
  315.           NAME := '';
  316.         END;
  317.   ELSE
  318.     WRITELN('DOS ERROR');
  319.     NAME := '';
  320.   END; { CASE }
  321.   DIRECTORY := NAME;
  322. END; { DIRECTORY }
  323.  
  324.  
  325. FUNCTION KANNICHNICH(VA:BYTE):BOOLEAN;
  326. CONST KNT  : ARRAY[1..6] OF STRING =
  327.       ('Dies Kompressionsverfahren kann nicht gelesen werden',
  328.        'Grayscale- Bilder müssen 4 oder 8 Bits per Sample haben',
  329.        'RGB- Bilder können nur mit 8 Bit / Pixel angezeigt werden',
  330.        'Eskönnen keine Palette- Farbbilder angezeigt werden',
  331.        'Für Graphikanzeige wird eine EGA- oder VGA- Karte benötigt',
  332.        'Grayscale- und Farbbilder können nur auf VGA- Karte gezeigt werden'
  333.       );
  334. VAR   CH1  : CHAR;
  335.       ERR  : BYTE;
  336. BEGIN
  337.   ERR := 0;
  338.   IF (COMPR <> 1) AND (COMPR <> $8005) AND (COMPR <> 2) THEN ERR := 1;
  339.   IF (TIFCL = 2) AND NOT (BPS[1] IN [4,8]) THEN ERR := 2;
  340.   IF (TIFCL = 4) AND NOT (BPS[1] = 8) THEN ERR := 3;
  341.   IF TIFCL = 3 THEN ERR := 4;
  342.   IF NOT (VA IN [4,5,7..12]) THEN ERR := 5;
  343.   IF (TIFCL > 1) AND NOT (VA IN [7..12]) THEN ERR := 6;
  344.  
  345.   IF ERR = 0 THEN BEGIN
  346.     KANNICHNICH := FALSE;
  347.   END ELSE BEGIN
  348.     KANNICHNICH := TRUE;
  349.     TEXTATTR := $CE;
  350.     GOTOXY(1,23); CLREOL;
  351.     GOTOXY(1,24); CLREOL;
  352.     GOTOXY(1,25); CLREOL;
  353.     GOTOXY(3,24);
  354.     WRITE(#7,KNT[ERR]);
  355.     CH1 := READKEY; IF CH1 = #0 THEN CH1 := READKEY;
  356.   END;
  357. END; { KANNICHNICH }
  358.  
  359.  
  360. PROCEDURE ZEIGEBILD;
  361. CONST MAXLIN     = 3500;
  362.       MSK   : ARRAY[0..7] OF BYTE = ($80,$40,$20,$10,8,4,2,1);
  363.       MSK2  : ARRAY[0..3] OF BYTE = ($C0,$30,$0C,$03);
  364.  
  365. {
  366.  XO / YO = X/Y- OFFSET IN FILE FÜR ANZEIGE
  367.  SCW = BILDSCHIRMBREITE IN BYTES
  368.  BW  = BILDBREITE IN BYTES
  369.  AL  = AKTULELLE LÄNGE DES FILES; IST < IMGHIG,
  370.        WENN NICHT ALLES IN DEN SPEICHER PASST
  371.  SCH = BILDSCHIRMHÖHE; IST < GETMAXY, WENN AL < BILDSCHIRMLÄNGE IST
  372.  MW  = MOVE- BREITE IN BYTES; IST = SCW, WENN BW >= SCW, ANSONSTEN BW
  373.  RW  = READ- BREITE IN BYTES; IST IMGWID SHR 1 BEI 4- BIT GRAYSCALE
  374.  
  375.  PP,PP1 = ZWISCHENVARIABLE FÜR PACKBITS DEKOMPRESSION
  376.  
  377.  P   = VGA- PALETTE    FÜR RGB- PALETTE- WANDLUNG
  378.  PZ  = PALETTE- ZEIGER FÜR RGB- PALETTE- WANDLUNG
  379.  COL = ZWISCHENBUFFER FÜR PIXELINFORMATION FÜR RGB- BILDER
  380.  
  381. AUS TIFFUNIT :
  382.  STP = STRIP- NR.      DES IN ARBEIT BEFINDLICHEN STREIFENS
  383.  SBC = STRIP BYTECOUNT DES IN ARBEIT BEFINDLICHEN STREIFENS
  384. }
  385. VAR   XO,YO              : INTEGER;
  386.       VA,VM              : BYTE; { VIDEOADAPTER / VIDEOMODE }
  387.       TA,TM,O            : BYTE;
  388.       I,J,K,BW,SCH,AL,
  389.       SCW,MW,RW,STP,
  390.       W                  : WORD;
  391.       CH1,CH2,CH3        : CHAR;
  392.       CHG,HLP,SW         : BOOLEAN;
  393.       B                  : ARRAY[0..MAXLIN] OF BYTEARRPTR;
  394.       B0                 : PTRARRAY ABSOLUTE B;
  395.       BB                 : BYTEARRPTR;
  396.       L                  : LONGINT;
  397.       P                  : VGAPALETTETYPE;
  398.       PP,PP1             : BYTE;
  399.       PZ                 : WORD;
  400.       COL                : COLORVALUE;
  401.  
  402.       BV                 : BYTE;
  403.       BITS,BITC          : WORD;
  404.  
  405. { ERMITTELN DER FARBNUMMER AUS DEN 8- BIT- RGB- WERTEN,
  406.   GGF. BILDEN EINES NEUEN PALETTE- EINTRAGS }
  407. FUNCTION PAL(C:COLORVALUE):BYTE;
  408. VAR   I  : WORD;
  409. BEGIN
  410.   C.R := C.R SHR 2;
  411.   C.G := C.G SHR 2;
  412.   C.B := C.B SHR 2;
  413.  
  414.   PAL := 0;
  415.   IF (C.R = 0) AND (C.G = 0) AND (C.B = 0) THEN EXIT;
  416.   PAL := 15;
  417.   IF (C.R = $3F) AND (C.G = $3F) AND (C.B = $3F) THEN EXIT;
  418.   IF PZ < 1 THEN EXIT; { PALETTE- ÜBERLAUF }
  419.   FOR I := 255 DOWNTO PZ DO BEGIN
  420.     IF (C.R = P[I].R) AND (C.G = P[I].G) AND (C.B = P[I].B) THEN BEGIN
  421.       PAL := I;
  422.       EXIT;
  423.     END;
  424.   END; { NEXT I }
  425.   IF PZ = 1 THEN BEGIN
  426.     PAL := 0;
  427.   END ELSE BEGIN
  428.     DEC(PZ);
  429.     IF PZ = 15 THEN PZ := 14;
  430.     P[PZ] := C;
  431.     PAL := PZ;
  432.     VGASETCOLOR(PZ,P[PZ]);
  433.   END;
  434. END; { PAL }
  435.  
  436. FUNCTION MAX(W1,W2:WORD):WORD;
  437. BEGIN
  438.   IF W1 > W2 THEN MAX := W1 ELSE MAX := W2;
  439. END; { MAX }
  440.  
  441. PROCEDURE SHOWLINE(NR:WORD);
  442. BEGIN
  443.   PARRPTR(B0,NR+YO);
  444.   CASE TIFCL OF
  445.     1 : IF (NR + YO) <= PRED(AL) THEN BEGIN
  446.           MOVE(B[NR+YO]^[XO],MEM[$A000:NR*SCW],MW);
  447.         END;
  448.   2,4 : IF (NR + YO) <= PRED(AL) THEN BEGIN
  449.           IF SCW > 320 THEN BEGIN
  450.             L := LONGINT(SCW) * LONGINT(NR);
  451.             SETSEG(L SHR 16);
  452.             J := ((L + MW) AND $FFFF);
  453.             IF J < MW THEN BEGIN
  454. { EINEN SEGMENTÜBERSCHNEIDENDEN MOVE IN 2 SCHRITTEN AUSFÜHREN }
  455.               K := MW - J;
  456.               MOVE(B[NR+YO]^[XO],MEM[$A000:NR*SCW],K);
  457.               SETSEG(SUCC(L SHR 16));
  458.               MOVE(B[NR+YO]^[XO+K],MEM[$A000:0],J);
  459.             END ELSE MOVE(B[NR+YO]^[XO],MEM[$A000:NR*SCW],MW);
  460.           END ELSE BEGIN
  461.             MOVE(B[NR+YO]^[XO],MEM[$A000:NR*SCW],MW);
  462.           END;
  463.         END;
  464.   END; { CASE TIFCL }
  465. END; { SHOWLINE }
  466.  
  467.  
  468. BEGIN { ZEIGEBILD }
  469.   TA := TEXTATTR;
  470.   TM := LASTMODE;
  471.   DIRECTVIDEO := FALSE;
  472.   VA := HI(VIDADAP);
  473.   IF KANNICHNICH(VA) THEN EXIT;
  474.  
  475. { DIVERSE VIDEO- PARAMETER NACH ART DES BILDES EINSTELLEN }
  476.   CASE TIFCL OF
  477.     1 : BEGIN
  478.           IF VA IN [4,5] THEN BEGIN
  479. { EGA }
  480.             VM := 1;  { EGA 640 * 350 / 16 }
  481.             IF (IMGHIG > 400) AND USE80X60F1 THEN VM := 5; { EGAVGA / 800 * 600 }
  482.           END ELSE BEGIN
  483. { VGA }
  484.             VM := 2; { VGA 640 * 480 / 16 }
  485.             IF (IMGHIG > 530) AND USE80X60F1 THEN VM := 5; { EGAVGA / 800 * 600 }
  486.           END;
  487.           SCW := SUCC(V[VM].X) SHR 3; { SCREENWIDTH IN BYTES }
  488.           BW := IMGWID SHR 3;
  489.           IF (IMGWID AND 7) <> 0 THEN INC(BW);
  490.           RW := BW;
  491.           SETVMODE(V[VM].M); { GRAPHIK INITIALISIEREN }
  492.           TEXTATTR := $0F;
  493.         END;
  494.   2,4 : BEGIN
  495.           VM := 3; { VGA 320 * 200 / 256 }
  496.           IF IMGHIG > 250 THEN BEGIN
  497.             IF USE64X48F2 THEN VM := 4; { VGA 640 * 480 / 256 }
  498.             IF (IMGHIG > 530) AND USE80X60F2
  499.                           THEN VM := 6; { VGA 800 * 600 / 256 }
  500.           END;
  501.           SCW := SUCC(V[VM].X); { SCREENWIDTH IN BYTES }
  502.           SETVMODE(V[VM].M); { GRAPHIK INITIALISIEREN }
  503.           CASE BPS[1] OF
  504.             4 : BEGIN
  505.                   RW := IMGWID SHR 1;
  506.                   IF (IMGWID AND 1) <> 0 THEN INC(RW);
  507.                   GRAYSCALE16;
  508.                   TEXTATTR := $0F;
  509.                 END;
  510.             8 : BEGIN
  511.                   RW := IMGWID;
  512.                   GRAYCURVE256;
  513.                   TEXTATTR := $FF;
  514.                 END;
  515.           END; { CASE BPS[1] }
  516.           BW := IMGWID;
  517. { TIFF- CLASS 3 = RGB }
  518.           IF TIFCL = 4 THEN BEGIN
  519.             RW := RW * 3;
  520. { PALETTE- VARIABLE VORBEREITEN }
  521.             P[0].R  := 0;   P[0].G  := 0;   P[0].B  := 0;
  522.             P[15].R := $3F; P[15].G := $3F; P[15].B := $3F;
  523.             VGASETCOLOR(15,P[15]);
  524.             PZ := 256;
  525.             TEXTATTR := $0F;
  526.           END;
  527.         END;
  528.   END; { CASE TIFCL }
  529.   IF BW < SCW THEN MW := BW ELSE MW := SCW;
  530.   CHG := TRUE;
  531.   HLP := TRUE;
  532.   XO  := 0;
  533.   YO  := 0;
  534.  
  535. { BILD EINLESEN }
  536.   GETMEM(BB,MAX(RW,BW));
  537.   AL  := PARRINIT(IMGHIG,BW,HEAPMIN);
  538.  
  539.   STP := 1;
  540.   BSEEK(1,TIFF,STRI[STP].O); { SEEK(TIFF,STRI[STP].O); }
  541.   SBC := STRI[STP].B;
  542.   FOR I := 0 TO PRED(IMGHIG) DO BEGIN
  543.     IF (I <= AL) THEN BEGIN
  544.       PARRNEW(B0,I);
  545.       CASE COMPR OF
  546.         1 : BEGIN { KEINE KOMPRESSION }
  547.               BGET(1,TIFF,@BB^,RW);
  548.               DEC(SBC,RW);
  549.             END;
  550. { KOMPRESSION CCITT GROUP 3, 1- DIMENSIONAL }
  551.         2 : BEGIN
  552.               BITC := 0;
  553.               BBC  := 0;
  554.               SW   := FALSE; { EINE ZEILE BEGINNT IMMER MIT WHITERUN }
  555.               J := 0;
  556.               K := 0;
  557.               FILLCHAR(BB^,MAX(BW,RW),#0);
  558.               REPEAT
  559.                 LIESCCITTRUN(SW,BITS,BV);
  560.                 INC(BITC,BITS);
  561.                 WHILE BITS > 0 DO BEGIN
  562.                   IF (K = 0) AND (BITS > 7) THEN BEGIN
  563.                     IF BV = 0 THEN FILLCHAR(BB^[J],BITS SHR 3,#$FF);
  564.                     INC(J,BITS SHR 3);
  565.                     BITS := BITS AND 7;
  566.                   END ELSE BEGIN
  567.                     IF BV = 0 THEN BB^[J] := BB^[J] OR MSK[K];
  568.                     INC(K);
  569.                     IF K > 7 THEN BEGIN
  570.                       INC(J);
  571.                       K := 0;
  572.                     END;
  573.                     DEC(BITS);
  574.                   END;
  575.                 END; { WHILE BITS > 0 }
  576.                 SW := NOT SW;
  577.               UNTIL BITC >= IMGWID; { JEWEILS 1 ZEILE LESEN }
  578.             END;
  579.       ELSE { CASE COMPR }
  580. { KOMPRESSION PACKBITS }
  581.         J := 0;
  582.         REPEAT
  583.           BGET(1,TIFF,@PP,1); { BLOCKREAD(TIFF,PP,1,K); }
  584.           DEC(SBC);
  585.           IF PP <> 128 THEN BEGIN
  586.             IF PP < 128 THEN BEGIN
  587.               BGET(1,TIFF,@BB^[J],SUCC(PP));
  588.               DEC(SBC,SUCC(PP));
  589.               INC(J,SUCC(PP));
  590.             END ELSE BEGIN
  591.               PP := SUCC(-PP);
  592.               BGET(1,TIFF,@PP1,1); { BLOCKREAD(TIFF,PP1,1); }
  593.               FILLCHAR(BB^[J],PP,CHAR(PP1));
  594.               DEC(SBC,1);
  595.               INC(J,PP);
  596.             END;
  597.           END;  { IF PP = 128 }
  598.         UNTIL J >= RW;
  599.       END; { ELSECASE COMPR }
  600.  
  601. { 4- BIT PER SAMPLE AUF 8 BIT PRO PIXEL DEHNEN }
  602.       IF BPS[1] = 4 THEN BEGIN
  603.         K := PRED(BW);
  604.         FOR J := PRED(RW) DOWNTO 0 DO BEGIN
  605.           BB^[K] := (BB^[J]) AND $0F;
  606.           IF K > 0 THEN BEGIN
  607.             DEC(K);
  608.             BB^[K] := (BB^[J]) SHR 4;
  609.             DEC(K);
  610.           END;
  611.         END; { NEXT J }
  612.       END; { IF BPS[1] = 4 }
  613. { RGB- DATEN IN PALETTE- DATEN UMARBEITEN }
  614.       IF TIFCL = 4 THEN BEGIN
  615.         K := 0;
  616.         FOR J := 0 TO PRED(BW) DO BEGIN
  617.           MOVE(BB^[K],COL,3); INC(K,3);
  618.           BB^[J] := PAL(COL);
  619.         END; { NEXT J }
  620.       END; { IF TIFCL = 4 }
  621.  
  622. { ANZEIGE DER GELESENEN ZEILE }
  623.       MOVE(BB^,B[I]^[0],BW);
  624.       IF I <= V[VM].Y THEN BEGIN
  625.         SHOWLINE(I);
  626.       END ELSE BEGIN
  627.         IF I MOD 50 = 0 THEN TICK; { LEBENSZEICHEN GEBEN }
  628.       END;
  629.  
  630.       IF (STRI[1].B > 0) AND (SBC <= 0) THEN BEGIN
  631.         INC(STP);
  632.         BSEEK(1,TIFF,STRI[STP].O); { SEEK(TIFF,STRI[STP].O); }
  633.         SBC := STRI[STP].B;
  634.       END;
  635.     END; { IF (I < MAXLIN) USW. }
  636.   END; { NEXT I - EINE ZEILE VON FILE EINLESEN }
  637. { DAS BILD IST KOMPLETT EINGELESEN }
  638.   SETSEG(0);
  639.   PIEP;
  640.  
  641. { BILD ANZEIGEN }
  642.   IF AL < V[VM].Y THEN SCH := PRED(AL) ELSE SCH := V[VM].Y;
  643.   REPEAT
  644.     IF CHG THEN BEGIN
  645.       FOR I := 0 TO SCH DO SHOWLINE(I);
  646.       SETSEG(0);
  647.     END; { IF CHG }
  648. { GGF. HILFETEXT ANZEIGEN }
  649.     IF HLP THEN BEGIN
  650.       GOTOXY(1,1);
  651.       IF V[VM].X < 639 THEN BEGIN
  652.         WRITE('<Esc> = Ende');
  653.         IF (IMGWID > SUCC(V[VM].X)) OR (AL > SUCC(V[VM].Y)) THEN BEGIN
  654.           WRITE(', Cursortasten = Scrollen');
  655.           GOTOXY(1,2);
  656.           WRITE('<Ctrl>-Cursortasten = schnell Scrollen');
  657.         END;
  658.       END ELSE BEGIN
  659.         WRITE('<Esc> = Ende');
  660.         IF (IMGWID > SUCC(V[VM].X)) OR (AL > SUCC(V[VM].Y)) THEN BEGIN
  661.           WRITE(', Cursortasten = Scrollen, <Ctrl>-Cursortasten = schnell Scrollen   ');
  662.         END;
  663.       END; { ELSEIF V[VM].X < 639 }
  664.       GOTOXY(1,4);
  665.       WRITE('<F5> = vertikal spiegeln');
  666.       GOTOXY(1,5);
  667.       WRITE('<F6> = horizontal spiegeln');
  668.       IF (TIFCL < 3) THEN BEGIN
  669.         GOTOXY(1,6);
  670.         WRITE('<F7> = invertieren');
  671.       END;
  672.       GOTOXY(1,8);
  673.       WRITE(SUCC(V[VM].X),' * ',SUCC(V[VM].Y),'   MEMAVAIL = ',MEMAVAIL);
  674.       IF AL <> IMGHIG THEN BEGIN
  675.         GOTOXY(1,25);
  676.         WRITE(' Speicherplatz für ',AL,' von ',IMGHIG,' Zeilen ');
  677.       END;
  678.       HLP := FALSE;
  679.     END; { IF HLP }
  680. { JETZT WIRD SICH UM DIE TASTATUR GEKÜMMERT }
  681.     CH1 := READKEY; IF CH1 = #0 THEN CH2 := READKEY ELSE CH2 := #0;
  682. {
  683.   NACH ERKANNTEM TASTENDRUCK DEN TASTATURBUFFER LEEREN
  684.   DAS VERHINDERT 'NACHLAUFEN' BEI LANGSAMEN BILDSCHIRMOPERATIONEN
  685. }
  686.     WHILE KEYPRESSED DO CH3 := READKEY;
  687.     CHG := TRUE;
  688.     CASE CH2 OF
  689. {F1}  #59 : BEGIN
  690.               HLP := TRUE;
  691.               CHG := FALSE;
  692.             END;
  693. { PALETTE ANZEIGEN }
  694. {F2}  #60 : BEGIN
  695.               IF (TIFCL = 2) AND (BPS[1] = 8) THEN GRAYCURVE256;
  696.               FOR I := 0 TO 20 DO BEGIN
  697.                 FOR J := 0 TO 255 DO MEM[$A000:I*SUCC(V[VM].X)+J] := J;
  698.               END;
  699.               CHG := FALSE;
  700.             END;
  701. {F3}  #61 : IF (TIFCL = 2) AND (BPS[1] = 8) THEN BEGIN
  702.               GRAYSCALE256;
  703.               FOR I := 0 TO 20 DO BEGIN
  704.                 FOR J := 0 TO 255 DO MEM[$A000:I*SUCC(V[VM].X)+J] := J;
  705.               END;
  706.               CHG := FALSE;
  707.             END;
  708. {F5}  #63 : BEGIN
  709.               FOR I := 0 TO PRED(AL) SHR 1 DO BEGIN
  710.                 PARRPTR(B0,I);
  711.                 PARRPTR2(B0,PRED(AL)-I);
  712.                 MOVE(B[I]^,BB^,BW);
  713.                 MOVE(B[PRED(AL)-I]^,B[I]^,BW);
  714.                 MOVE(BB^,B[PRED(AL)-I]^,BW);
  715.               END; { NEXT I }
  716.             END;
  717. {F6}  #64 : BEGIN
  718.               FOR I := 0 TO PRED(AL) DO BEGIN
  719.                 PARRPTR(B0,I);
  720.                 MOVE(B[I]^,BB^,BW);
  721.                 FOR J := 0 TO PRED(BW) DO BEGIN
  722.                   IF TIFCL = 1 THEN BEGIN
  723.                     FOR K := 0 TO 7 DO BEGIN
  724.                       O := (O SHR 1) AND $7F;
  725.                       O := O OR (BB^[J] AND $80);
  726.                       BB^[J] := BB^[J] SHL 1;
  727.                     END;
  728.                     B[I]^[PRED(BW)-J] := O;
  729.                   END ELSE BEGIN
  730.                     B[I]^[PRED(BW)-J] := BB^[J];
  731.                   END;
  732.                 END; { NEXT J }
  733.                 IF I MOD 20 = 0 THEN TICK; { LEBENSZEICHEN GEBEN }
  734.               END; { NEXT I }
  735.             END;
  736. {F7}  #65 : IF TIFCL < 3 THEN BEGIN
  737.               IF BPS[1] = 4 THEN K := $0F ELSE K := $FF;
  738.               FOR I := 0 TO PRED(AL) DO BEGIN
  739.                 PARRPTR(B0,I);
  740.                 FOR J := 0 TO PRED(BW) DO B[I]^[J] := B[I]^[J] XOR K;
  741.                 IF I MOD 40 = 0 THEN TICK; { LEBENSZEICHEN GEBEN }
  742.               END; { NEXT I }
  743.             END;
  744. { FILE SCHREIBEN }
  745. {F10} #68 : IF (BPS[1] IN [1,8]) AND
  746.                (AL = IMGHIG) AND
  747.                (COMPR = 1) THEN BEGIN
  748.               GOTOXY(1,3);
  749.               WRITE(#7,'File schreiben ?');
  750.               CH1 := UPCASE(READKEY); IF CH1 = #0 THEN BEGIN
  751.                 CH1 := READKEY;
  752.                 CH1 := #0;
  753.               END;
  754.               IF CH1 IN ['J','Y'] THEN BEGIN
  755.                 WRITE(' --- moment bitte --- ');
  756.   FSEEK(TIFF,STRI[1].O); { SEEK(TIFF,STRI[1].O); }
  757.                 FOR I := 0 TO PRED(IMGHIG) DO BEGIN
  758.                   PARRPTR(B0,I);
  759.                   FPUT(TIFF,@B[I]^[0],RW);
  760.                 END; { NEXT I }
  761.               END;
  762.             END ELSE BEGIN
  763.               WRITE(#7#7#7);
  764.             END;
  765. {UP}  #72 : IF PRED(AL) > SCH THEN BEGIN
  766.               DEC(YO,8);
  767.               IF YO < 0 THEN YO := 0;
  768.             END;
  769. {DN}  #80 : IF PRED(AL) > SCH THEN BEGIN
  770.               INC(YO,8);
  771.               IF (YO + V[VM].Y) >= AL THEN YO := PRED(AL - V[VM].Y);
  772.             END;
  773. {LE}  #75 : IF IMGWID > V[VM].X THEN BEGIN
  774.               IF XO > 0 THEN DEC(XO);
  775.             END;
  776. {RI}  #77 : IF IMGWID > V[VM].X THEN BEGIN
  777.               IF (XO + SCW) < BW THEN INC(XO);
  778.             END;
  779. {HO}  #71 : IF PRED(AL) > SCH THEN BEGIN
  780.               IF XO <> 0 THEN XO := 0
  781.                          ELSE YO := 0;
  782.               IF (YO + V[VM].Y) > AL THEN YO := PRED(AL - V[VM].Y);
  783.             END ELSE CHG := FALSE;
  784. {EN}  #79 : BEGIN
  785.               IF IMGWID > V[VM].X THEN BEGIN
  786.                 IF XO <> (BW - SCW) THEN BEGIN
  787.                   XO := BW - SCW;
  788.                 END ELSE BEGIN
  789.                   IF PRED(AL) > SCH THEN YO := PRED(AL - V[VM].Y);
  790.                 END;
  791.               END ELSE BEGIN
  792.                 IF PRED(AL) > SCH THEN YO := PRED(AL - V[VM].Y);
  793.               END;
  794.             END;
  795. {CUP}#141,
  796. {PU}  #73 : IF PRED(AL) > SCH THEN BEGIN
  797.               DEC(YO,V[VM].Y SHR 1);
  798.               IF YO < 0 THEN YO := 0;
  799.             END ELSE CHG := FALSE;
  800. {CDN}#145,
  801. {PD}  #81 : IF PRED(AL) > SCH THEN BEGIN
  802.               INC(YO,V[VM].Y SHR 1);
  803.               IF (YO + V[VM].Y) >= AL THEN YO := PRED(AL - V[VM].Y);
  804.             END ELSE CHG := FALSE;
  805. {CLE}#115 : IF IMGWID > V[VM].X THEN BEGIN
  806.               DEC(XO,SCW SHR 1);
  807.               IF XO < 0 THEN XO := 0;
  808.             END ELSE CHG := FALSE;
  809. {CRI}#116 : IF IMGWID > V[VM].X THEN BEGIN
  810.               INC(XO,SCW SHR 1);
  811.               IF XO > (BW - SCW) THEN XO := BW - SCW;
  812.             END ELSE CHG := FALSE;
  813.     ELSE
  814.       IF CH1 <> ' ' THEN CHG := FALSE;
  815.     END; { CASE CH2 }
  816.   UNTIL CH1 = ^[;
  817. { <Esc> = ENDE ZEIGEBILD }
  818.   PARRDISPOSE(B0);
  819.   FREEMEM(BB,MAX(BW,RW));
  820.   TEXTMODE(LASTMODE);
  821.   TEXTATTR := TA;
  822. END; { ZEIGEBILD }
  823.  
  824.  
  825. BEGIN
  826.   CLRSCR;
  827.  
  828.   GD := REGISTERBGIDRIVER(@EGAVGADRIVER);
  829.   IF GD < 0 THEN BEGIN
  830.     WRITELN('FEHLER REGISTERBGIDRIVER #',GD);
  831.     HALT(1);
  832.   END;
  833.  
  834.   DIRRET := 0;
  835.   READCONFIG;
  836.  
  837.   EXPLODE := FALSE;
  838.   IF NOT ADDPICKCOMMAND(PKSUSER0,1,68 SHL 8,0) THEN BEGIN END;
  839.  
  840.   NAME := '*';
  841.   IF PARAMCOUNT = 0 THEN BEGIN
  842.     MASK := DEFMASK;
  843.   END ELSE BEGIN
  844.     MASK := PARAMSTR(1);
  845.     I := POS('.TIF',MASK);
  846.     IF I = (LENGTH(MASK) - 3) THEN BEGIN
  847.       NAME := MASK;
  848.       WHILE (LENGTH(MASK) > 0) AND (MASK[LENGTH(MASK)] <> '\') DO DELETE(MASK,LENGTH(MASK),1);
  849.       MASK := MASK + '*.TIF';
  850.     END ELSE BEGIN
  851.       IF MASK[LENGTH(MASK)] <> '\' THEN MASK := MASK + '\';
  852.       MASK := MASK + '*.TIF';
  853.     END;
  854.   END;
  855.   IF MASK[2] <> ':' THEN MASK := DEFAULTDRIVE + ':' + MASK;
  856.  
  857.   NM := '';
  858.   REPEAT
  859.     IF NAME = '*' THEN BEGIN
  860.       TEXTATTR := $4E;
  861.       GOTOXY(1,1);
  862.       CLREOL;
  863.       WRITE(NM,'    <Esc> = Programm Ende, <Ret> = Auswahl, <F10> = Config');
  864.       TEXTATTR := $07;
  865.       GOTOXY(1,4);
  866.       NAME := DIRECTORY(MASK);
  867.       IF (NAME <> '*') AND (NAME <> '') THEN BEGIN
  868.         MASK := JUSTPATHNAME(NAME);
  869.         IF MASK[LENGTH(MASK)] <> '\' THEN MASK := MASK + '\';
  870.         MASK := MASK + '*.TIF';
  871.       END;
  872.     END;
  873.     IF (NAME <> '*') AND (NAME <> '') THEN BEGIN
  874.       NM := NAME;
  875.       CLRSCR;
  876.       CASE ZEIGETIFF(NAME,TRUE) OF
  877.          ^[ : NAME := '';
  878.         ' ' : BEGIN
  879.                 ZEIGEBILD;
  880.                 DIRECTVIDEO := TRUE;
  881.                 TEXTATTR := $07;
  882.                 CLOSETIFF;
  883.                 CLRSCR;
  884.                 IF ZEIGETIFF(NAME,FALSE) = ' ' THEN {};
  885.                 CLOSETIFF;
  886.                 NAME := '*';
  887.               END;
  888.         '1' : BEGIN
  889.                 CLRSCR;
  890.                 WRITELN(STRC:6,' Strips : ');
  891.                 FOR I := 1 TO STRC DO WRITE(STRI[I].O:6,STRI[I].B:8,' ║');
  892.                 IF READKEY = ' ' THEN {};
  893.  
  894.                 IF GRCC > 0 THEN BEGIN
  895.                   DIRECTVIDEO := FALSE;
  896.                   DETECTGRAPH(GD,GM);
  897.                   INITGRAPH(GD,GM,'');
  898.                   GOTOXY(1,1);
  899.                   WRITELN('Gray Response Curve  <',GRU,'>  (',GRCC,')');
  900.                   GRMAX := 0;
  901.                   FOR I := 1 TO GRCC DO BEGIN
  902.                     IF GRC[I] > GRMAX THEN GRMAX := GRC[I];
  903.                   END;
  904.                   RX := GETMAXX;      RX := RX / GRCC;
  905.                   RY := GETMAXY - 20; RY := RY / GRMAX;
  906.                   MOVETO(0,GETMAXY - ROUND(GRC[1] * RY));
  907.                   FOR I := 1 TO GRCC DO
  908.                     LINETO(ROUND(RX * I),GETMAXY - ROUND(GRC[I] * RY));
  909.  
  910.                   IF READKEY = ' ' THEN {};
  911.                   CLOSEGRAPH;
  912.                   DIRECTVIDEO := TRUE;
  913.                 END;
  914.  
  915.                 CLOSETIFF;
  916.               END;
  917.       ELSE
  918.         CLOSETIFF;
  919.         NAME := '*';
  920.       END; { CASE ZEIGETIFF }
  921.     END;
  922.   UNTIL NAME = '';
  923.   GOTOXY(1,25);
  924.   TEXTATTR := $07;
  925. END.
  926.  
  927.  
  928.