home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / grafik / tiftool / video.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1990-10-21  |  4.2 KB  |  202 lines
  1.  
  2. UNIT VIDEO;
  3. {$F+}
  4.  
  5. INTERFACE
  6.  
  7.  
  8. USES  DOS;
  9.  
  10.  
  11. type  ColorValue     = record
  12.         R,G,B : BYTE;
  13.       END;
  14.  
  15.       VGAPaletteType = array[0..255] of ColorValue;
  16.  
  17.  
  18. CONST USEET4000  : BOOLEAN = TRUE; { VGA- CHIP ET4000 ODER ANDERER }
  19.       SEGPORT    : WORD    = $3CD; { PORTADRESSE FÜR SEGMENTADRESSE }
  20.  
  21.  
  22. FUNCTION  CPU_TYPE:INTEGER;
  23. FUNCTION  VIDADAP:WORD;
  24. FUNCTION  VADAPTERTEXT(I:BYTE):STRING;
  25.  
  26. PROCEDURE WTSYNCH;
  27. PROCEDURE SETVMODE(MODE:BYTE);
  28. procedure VGASetAllPalette(var P : VGAPaletteType);
  29. procedure VGASetPalette(VON,BIS:BYTE;var P : VGAPaletteType);
  30. procedure VGASetCOLOR(NR:BYTE;COL:COLORVALUE);
  31. procedure VGAGetAllPalette(var P : VGAPaletteType);
  32. PROCEDURE GRAYSCALE16;
  33. PROCEDURE GRAYSCALE256;
  34. PROCEDURE SETSEG(NR:BYTE);
  35. PROCEDURE SETCPER(MASKE:BYTE);
  36.  
  37.  
  38. IMPLEMENTATION
  39.  
  40.  
  41. FUNCTION CPU_TYPE:INTEGER; EXTERNAL;
  42. {$L GETCPU}
  43. FUNCTION VIDADAP:WORD; EXTERNAL;
  44. {$L VIDEOID}
  45.  
  46.  
  47. PROCEDURE WTSYNCH;
  48. BEGIN
  49.   REPEAT UNTIL (PORT[$3DA] AND 8) = 0;
  50.   REPEAT UNTIL (PORT[$3DA] AND 8) <> 0;
  51. END;
  52.  
  53.  
  54. FUNCTION VADAPTERTEXT(I:BYTE):STRING;
  55. BEGIN
  56.   CASE LO(I) OF
  57.      0 : VADAPTERTEXT := 'nicht vorhanden';
  58.      1 : VADAPTERTEXT := 'MDA Monochrom Display Adapter';
  59.      2 : VADAPTERTEXT := 'CGA Color Graphics Adapter';
  60.    3,9 : VADAPTERTEXT := 'reservierter DCC';
  61.      4 : VADAPTERTEXT := 'EGA Enhanced Graphics Adapter Color Mode';
  62.      5 : VADAPTERTEXT := 'EGA Enhanced Graphics Adapter Monochrom Mode';
  63.      6 : VADAPTERTEXT := 'PGA Professional Graphics Controller';
  64.      7 : VADAPTERTEXT := 'VGA Video Graphics Array mit Monochrom Display';
  65.      8 : VADAPTERTEXT := 'VGA Video Graphics Array mit Color Display';
  66.     10 : VADAPTERTEXT := 'MCGA mit digitalem Color Display';
  67.     11 : VADAPTERTEXT := 'MCGA mit analogem Monochrom Diaplay';
  68.     12 : VADAPTERTEXT := 'MCGA mit analogem Color Display';
  69.     64 : VADAPTERTEXT := 'HGC Hercules Graphics Card';
  70.   ELSE
  71.     VADAPTERTEXT := 'nicht erkannt';
  72.   END; { CASE I }
  73. END; { VADAPTERTEXT }
  74.  
  75.  
  76. PROCEDURE SETVMODE(MODE:BYTE);
  77. VAR   R  : REGISTERS;
  78. BEGIN
  79.   R.AH := 0;
  80.   R.AL := MODE;
  81.   INTR($10,R);
  82. END;
  83.  
  84.  
  85. procedure VGASetAllPalette(var P : VGAPaletteType);
  86. var   R  : REGISTERS;
  87. begin
  88.   with R do
  89.   begin
  90.     AX := $1012;
  91.     BX := 0;
  92.     CX := 256;
  93.     ES := Seg(P);
  94.     DX := Ofs(P);
  95.   end;
  96.   Intr($10, R);
  97. end; { VGASetAllPalette }
  98.  
  99.  
  100. procedure VGASetPalette(VON,BIS:BYTE;var P : VGAPaletteType);
  101. var   R  : REGISTERS;
  102. begin
  103.   with R do
  104.   begin
  105.     AX := $1012;
  106.     BX := VON;
  107.     CX := SUCC(BIS-VON);
  108.     ES := Seg(P);
  109.     DX := Ofs(P);
  110.   end;
  111.   Intr($10, R);
  112. end; { VGASetAllPalette }
  113.  
  114.  
  115. procedure VGASetCOLOR(NR:BYTE;COL:COLORVALUE);
  116. var   REG  : REGISTERS;
  117. begin
  118.   with REG do
  119.   begin
  120.     AX := $1010;
  121.     BX := NR;
  122.     CH := COL.G;
  123.     CL := COL.B;
  124.     DH := COL.R;
  125.   end;
  126.   Intr($10,REG);
  127. end; { VGASetCOLOR }
  128.  
  129.  
  130. procedure VGAGetAllPalette(var P : VGAPaletteType);
  131. var   R  : REGISTERS;
  132. begin
  133.   with R do begin
  134.     AX := $1017;
  135.     BX := 0;
  136.     CX := 256;
  137.     ES := Seg(P);
  138.     DX := Ofs(P);
  139.   end;
  140.   Intr($10, R);
  141. end; { VGASetAllPalette }
  142.  
  143.  
  144. PROCEDURE GRAYSCALE16;
  145. VAR   VP  : ^VGAPALETTETYPE;
  146.       I   : BYTE;
  147. BEGIN
  148. { 16- STUFIGE GRAUSKALA EINSTELLEN }
  149.   GETMEM(VP,SIZEOF(VGAPALETTETYPE));
  150.   VGAGETALLPALETTE(VP^);
  151.   FOR I := 0 TO 15 DO BEGIN
  152.     VP^[I].R := I SHL 2;
  153.     VP^[I].G := I SHL 2;
  154.     VP^[I].B := I SHL 2;
  155.   END;
  156.   VGASETALLPALETTE(VP^);
  157.   FREEMEM(VP,SIZEOF(VGAPALETTETYPE));
  158. END;
  159.  
  160.  
  161. PROCEDURE GRAYSCALE256;
  162. VAR   VP  : ^VGAPALETTETYPE;
  163.       I   : BYTE;
  164. BEGIN
  165. { 256- STUFIGE GRAUSKALA EINSTELLEN }
  166.   GETMEM(VP,SIZEOF(VGAPALETTETYPE));
  167.     FOR I := 0 TO 255 DO BEGIN
  168.     VP^[I].R := I SHR 2;
  169.     VP^[I].G := I SHR 2;
  170.     VP^[I].B := I SHR 2;
  171.   END;
  172.   VGASETALLPALETTE(VP^);
  173.   FREEMEM(VP,SIZEOF(VGAPALETTETYPE));
  174. END;
  175.  
  176.  
  177. PROCEDURE SETSEG(NR:BYTE);
  178. BEGIN
  179.   IF USEET4000 THEN BEGIN
  180.     PORT[SEGPORT] := NR + NR SHL 4;
  181.   END ELSE BEGIN
  182.     PORT[SEGPORT] := (NR + NR SHL 3) OR $40;
  183.   END;
  184. END; { SETSEG }
  185.  
  186.  
  187. PROCEDURE SETCPER(MASKE:BYTE);
  188. VAR   R  : REGISTERS;
  189. BEGIN
  190.   WITH R DO BEGIN
  191.     AH := $10;
  192.     AL := 0;
  193.     BH := MASKE;
  194.     BL := $12;
  195.     INTR($10,R);
  196.   END; { WITH R }
  197. END; { SETCPER }
  198.  
  199.  
  200. END.
  201.  
  202.