home *** CD-ROM | disk | FTP | other *** search
/ PC Media 23 / PC MEDIA CD23.iso / share / prog / dclib500 / gifunit.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-01-04  |  22.4 KB  |  582 lines
  1. unit GifUnit;
  2. { GifUtl.pas - (c)Copyright 1993 Sean Wenzel
  3. Users are given the right to use/modify and distribute this source code as
  4. long as credit is given where due.  I would also ask that anyone who makes
  5. use of this source/program drop me a line at my CompuServe address of
  6. 71736,1245.  Just curious...
  7.  
  8. The unit was written using Borland Pascal v7.0 but I think it should work
  9. with Turbo Pascal down to 5.5 at the most (or least?).
  10. This unit has only been tested on my system - an Everex Tempo 386DX
  11. with its built in SVGA adapter.  If anyone finds/fixes any bugs please
  12. let me know. (Feel free to send a copy of any code too)
  13. I have also only tested 3 or 4 256,16, and 2 color interlaced and non-
  14. interlaced images. (was enough for my needs)
  15.  
  16.  
  17. Some of the code is very loosely based on DECODER.C (availble online)
  18. so credit should be given to Steven A. Bennett and Steve Wilhite
  19.  
  20. The unit is set up to use BGI256.BGI (inlcuded) which is available on CIS
  21. in the BPASCAL forum library.  The graphics initialization tries to start
  22. up in 640 by 480 mode.  If an error occurs it'll go down to 320x200
  23. automatically (well - it should).  For higher res modes change the variable
  24. GraphMode in the InitGraphics procedure to 3 for 800x600 and 4 for 1024x768.
  25.  
  26. A sample program (GIF.PAS) is provided to demostrate the use of this unit.
  27. Basically declare a pointer to the TGIF object then initialize it using a
  28. line such as TheGif := New(PGif, Init('agif'));  You can then check
  29. TheGif^.Status for any errors and/or view the GIF headers and ColorTables.
  30. To switch to Graphics mode and show the GIF image use TheGif^.Decode(True)
  31. True tells it to beep when done(or boop if some sort of error occured).
  32. When finished use Dispose(TheGif, Done) to switch back to textmode and get
  33. rid of the object.
  34.  
  35.  
  36. If anyone cares to speed up the image decoding I'd suggest writing
  37. TGIF.NextCode in assembler.  The routine is the most heavily called in the
  38. unit while decoding and on my sytem took up about 5 seconds out of 12 when
  39. I profiled it. (send me a copy if you can)
  40.  
  41. I have practically commented every line so that the source should be very
  42. readable and easy to follow.  Great for learning about GIF's and LZW
  43. decompression.
  44.  
  45.  
  46. Any problems or suggestions drop me a line
  47.  
  48. Good luck...
  49.                                                 -Sean
  50.  
  51. (almost forgot)
  52. "The Graphics Interchange Format(c) is the Copyright property of
  53.  CompuServe Incorporated. GIF(sm) is a Service Mark property of
  54.  CompuServe Incorporated."
  55.  
  56. }
  57.  
  58.  
  59. {$R-}   {  range checking off }  { Put them on if you like but it slows down the}
  60. {$S-} { stack checking off }  { decoding  (almost doubles it!) }
  61. {$I-} { i/o checking off }
  62.  
  63. interface
  64.  
  65. uses Objects;
  66.  
  67. type
  68.     TDataSubBlock = record
  69.         tamano: byte;     { size of the block -- 0 to 255 }
  70.         Datos: array[1..255] of byte; { the Datos }
  71.     end;
  72.  
  73. const
  74.     BlockTerminator: byte = 0; { terminates stream of Datos blocks }
  75.  
  76. type
  77.     TCabezas = record
  78.         Signatura: array[0..2] of char; { contains 'GIF' }
  79.         Version: array[0..2] of char;   { '87a' or '89a' }
  80.     end;
  81.  
  82.     TLogicalScreenDescriptor = record
  83.         ScreenWidth: word;              { logical screen width }
  84.         ScreenHeight: word;  { logical screen height }
  85.         PackedFields: byte;     { packed fields - see below }
  86.         BackGroundColorIndex: byte;     { index to global color table }
  87.         AspectRatio: byte;      { actual ratio = (AspectRatio + 15) / 64 }
  88.     end;
  89.  
  90. const
  91. { logical screen descriptor packed field masks }
  92.     lsdGlobalColorTable = $80;  { set if global color table follows L.S.D. }
  93.     lsdColorResolution = $70;               { Color resolution - 3 bits }
  94.     lsdSort = $08;                                                  { set if global color table is sorted - 1 bit }
  95.     lsdColorTableSize = $07;                { size of global color table - 3 bits }
  96.                                                             { Actual size = 2^value+1    - value is 3 bits }
  97.  
  98. type
  99.     TColorItem = record     { one item a a color table }
  100.         Rojo: byte;
  101.         Green: byte;
  102.         Blue: byte;
  103.     end;
  104.  
  105.     TColorTable = array[0..255] of TColorItem;      { the color table }
  106.  
  107. const
  108.     ImageSeperator: byte = $2C;
  109.  
  110. type
  111.     TImageDescriptor = record
  112.         Seperator: byte;                         { fixed value of ImageSeperator }
  113.         ImageLeftPos: word; {Column in pixels in respect to left edge of logical screen }
  114.         ImageTopPos: word;{row in pixels in respect to top of logical screen }
  115.         ImageWidth: word;       { width of image in pixels }
  116.         ImageHeight: word;      { height of image in pixels }
  117.         PackedFields: byte; { see below }
  118.     end;
  119. const
  120.     { image descriptor bit masks }
  121.         idLocalColorTable = $80; { set if a local color table follows }
  122.         idInterlaced = $40;                      { set if image is interlaced }
  123.         idSort = $20;                                            { set if color table is sorted }
  124.         idReserved = $0C;                                { reserved - must be set to $00 }
  125.         idColorTableSize = $07;  { size of color table as above }
  126.  
  127.     Trailer: byte = $3B;    { indicates the end of the GIF Datos stream }
  128.  
  129. { other extension blocks not currently supported by this unit
  130.     - Graphic Control extension
  131.     - Comment extension           I'm not sure what will happen if these blocks
  132.     - Plain text extension        are encounteRojo but it'll be interesting
  133.     - application extension }
  134.  
  135. const
  136.     ExtensionIntroducer: byte = $21;
  137.     MAXSCREENWIDTH = 800;
  138.  
  139. type
  140.     TExtensionBlock = record
  141.         Introducer: byte;                               { fixed value of ExtensionIntroducer }
  142.         ExtensionLabel: byte;
  143.         BlockSize: byte;
  144.     end;
  145.  
  146.     PCodeItem = ^TCodeItem;
  147.     TCodeItem = record
  148.         Code1, Code2: byte;
  149.     end;
  150.  
  151. const
  152.     MAXCODES = 4095;        { the maximum number of different codes 0 inclusive }
  153.  
  154.  
  155.  
  156. type
  157.     { This is the actual gif object }
  158.     PGif = ^TGif;
  159.     TGif = object(TObject)
  160.         Stream: PBufStream;                                                                     { the file stream for the gif file }
  161.         Header: TCabezas;                                                                                { gif file header }
  162.         LogicalScreen: TLogicalScreenDescriptor;  { gif screen descriptor }
  163.         GlobalColorTable: TColorTable;            { global color table }
  164.         LocalColorTable: TColorTable;             { local color table }
  165.         ImageDescriptor: TImageDescriptor;        { image descriptor }
  166.         UseLocalColors: boolean;                  { true if local colors in use }
  167.         Interlaced: boolean;                                                           { true if image is interlaced }
  168.         LZWCodeSize: byte;                                       { minimum size of the LZW codes in bits }
  169.         ImageData: TDataSubBlock;                { variable to store incoming gif Datos }
  170.         TableSize: word;                                                 { number of entrys in the color table }
  171.         BitsLeft, BytesLeft: integer;{ bits left in byte - bytes left in block }
  172.         BadCodeCount: word;          { bad code counter }
  173.         CurrCodeSize: integer;       { Current size of code in bits }
  174.         ClearCode: integer;          { Clear code value }
  175.         EndingCode: integer;         { ending code value }
  176.         Slot: word;                                     { position that the next new code is to be added }
  177.         TopSlot: word;      { highest slot position for the current code size }
  178.         HighCode: word;     { highest code that does not require decoding }
  179.         NextByte: integer;      { the index to the next byte in the Datosblock array }
  180.         CurrByte: byte;                 { the current byte }
  181.         DecodeStack: array[0..MAXCODES] of byte; { stack for the decoded codes }
  182.         Prefix: array[0..MAXCODES] of word;                     { array for code prefixes }
  183.         Suffix: array[0..MAXCODES] of byte;             { array for code suffixes }
  184.         LineBuffer: array[0..MAXSCREENWIDTH] of byte; { array for buffer line output }
  185.         CurrentX, CurrentY: integer;                                            { current screen locations }
  186.         Status: word;                                                                      { status of the decode }
  187.         InterlacePass: byte;    { interlace pass number }
  188.         constructor Init(AGIFName: string);
  189.         destructor Done; virtual;
  190.         procedure Error(What: integer);
  191.         procedure InitCompressionStream;        { initializes info for decode }
  192.         procedure ReadSubBlock;                          { reads a Datos subblock from the stream }
  193.         function NextCode: word;                                        { returns the next available code }
  194.         procedure Decode(Beep: boolean);        { the actual LZW decoding routine }
  195.         procedure DrawLine;                     { writes the drawline buffer to screen }
  196.         procedure InicioGraficos(D,M:integer);{ Inicio de graficos }
  197.     end;
  198.  
  199. var
  200.    D, M : integer;
  201.  
  202. const
  203. { error constants }
  204.     geNoError = 0;                          { no errors found }
  205.     geNoFile = 1;         { gif file not found }
  206.     geNotGIF = 2;         { file is not a gif file }
  207.     geNoGlobalColor = 3;  { no Global Color table found }
  208.     geImagePreceded = 4;  { image descriptor preceeded by other unknown Datos }
  209.     geEmptyBlock = 5;                       { Block has no Datos }
  210.     geUnExpectedEOF = 6;  { unexpected EOF }
  211.     geBadCodeSize = 7;    { bad code size }
  212.     geBadCode = 8;                          { Bad code was found }
  213.     geBitSizeOverflow = 9; { bit size went beyond 12 bits }
  214.  
  215. implementation
  216.  
  217. uses Graph, Crt;
  218.  
  219. Const
  220.      Au1 : string = #13#10 +
  221.                     'Librería Visualizar Formato GIF Versión 1.00 a 18/12/1993'+
  222.                     #13#10 +
  223.                     'Shareware 1993 David Carrero Fernández-Baillo'+
  224.                     #13#10 +
  225.                     'Créditos:'+
  226.                     #13#10 +
  227.                     'Esta Librería es (c)Copyright 1993 Sean Wenzel'+
  228.                     #13#10;
  229. var
  230.    Autor1 : string;
  231.  
  232. function Power(A, N: real): real;       { returns A raised to the power of N }
  233. begin
  234.     Power := exp(N * ln(A));
  235. end;
  236.  
  237.  
  238. { TGif }
  239. constructor TGif.Init(AGIFName: string);
  240. begin
  241.     inherited Init;
  242.     if Pos('.',AGifName) = 0 then     { if the filename has no extension add one }
  243.         AGifName := AGifName + '.GIF';
  244.     Stream := New(PBufStream, Init(AGifName, stOpen, 2048));
  245.     Stream^.Read(Header, sizeof(Header));                                            { read the header }
  246.     if Header.Signatura <> 'GIF' then Error(geNotGIF);                              { is vaild Signatura }
  247.     Stream^.Read(LogicalScreen, sizeof(LogicalScreen));
  248.     if LogicalScreen.PackedFields and lsdGlobalColorTable = lsdGlobalColorTable then
  249.     begin
  250.         TableSize := trunc(Power(2,(LogicalScreen.PackedFields and lsdColorTableSize)+1));
  251.         Stream^.Read(GlobalColorTable, TableSize*sizeof(TColorItem)); { read Global Color Table }
  252.     end
  253.     else
  254.         Error(geNoGlobalColor);
  255.     Stream^.Read(ImageDescriptor, sizeof(ImageDescriptor)); { read image descriptor }
  256.     if ImageDescriptor.Seperator <> ImageSeperator then                     { verify that it is the descriptor }
  257.         Error(geImagePreceded);
  258.     if ImageDescriptor.PackedFields and idLocalColorTable = idLocalColorTable then
  259.     begin                                                                           { if local color table }
  260.         TableSize := trunc(Power(2,(ImageDescriptor.PackedFields and idColorTableSize)+1));
  261.         Stream^.Read(LocalColorTable, TableSize*sizeof(TColorItem)); { read Local Color Table }
  262.         UseLocalColors := True;
  263.     end
  264.     else
  265.         UseLocalColors := false;
  266.     if ImageDescriptor.PackedFields and idInterlaced = idInterlaced then
  267.     begin
  268.         Interlaced := true;
  269.         InterlacePass := 0;
  270.     end;
  271.     if (Stream = nil) or (Stream^.Status <> stOk) then{ check for stream error }
  272.         Error(geNoFile);
  273.     Status := 0;
  274. end;
  275.  
  276. destructor TGif.Done;
  277. begin
  278.     CloseGraph;
  279.     TextMode(LastMode);
  280.     if Stream <> nil then
  281.         Dispose(Stream, Done);
  282.     inherited Done;
  283. end;
  284.  
  285. procedure TGif.Error(What: integer);
  286. begin
  287.     Status := What;
  288. end;
  289.  
  290. procedure TGif.InitCompressionStream;
  291. var
  292.     I: integer;
  293. begin
  294.     InicioGraficos(D,M);                           { Initialize the graphics display }
  295.     Stream^.Read(LZWCodeSize, sizeof(byte));{ get minimum code size }
  296.     if not (LZWCodeSize in [2..9]) then     { valid code sizes 2-9 bits }
  297.         Error(geBadCodeSize);
  298.  
  299.     CurrCodeSize := succ(LZWCodeSize); { set the initial code size }
  300.     ClearCode := 1 shl LZWCodeSize;    { set the clear code }
  301.     EndingCode := succ(ClearCode);     { set the ending code }
  302.     HighCode := pred(ClearCode);                     { set the highest code not needing decoding }
  303.     BytesLeft := 0;                    { clear other variables }
  304.     BitsLeft := 0;
  305.     CurrentX := 0;
  306.     CurrentY := 0;
  307. end;
  308.  
  309. procedure TGif.ReadSubBlock;
  310. begin
  311.     Stream^.Read(ImageData.tamano, sizeof(ImageData.tamano)); { get the Datos block size }
  312.     if ImageData.tamano = 0 then Error(geEmptyBlock); { check for empty block }
  313.     Stream^.Read(ImageData.Datos, ImageData.tamano);   { read in the block }
  314.     NextByte := 1;                                  { reset next byte }
  315.     BytesLeft := ImageData.tamano;                                                                            { reset bytes left }
  316. end;
  317.  
  318. const
  319.     CodeMask: array[0..12] of longint = (  { bit masks for use with Next code }
  320.         0,
  321.         $0001, $0003,
  322.         $0007, $000F,
  323.         $001F, $003F,
  324.         $007F, $00FF,
  325.         $01FF, $03FF,
  326.         $07FF, $0FFF);
  327.  
  328. function TGif.NextCode: word; { returns a code of the proper bit size }
  329. var
  330.     Ret: longint;                                                                 { temporary return value }
  331. begin
  332.     if BitsLeft = 0 then                                                            { any bits left in byte ? }
  333.     begin                                   { any bytes left }
  334.         if BytesLeft <= 0 then                                                   { if not get another block }
  335.             ReadSubBlock;
  336.         CurrByte := ImageData.Datos[NextByte]; { get a byte }
  337.         inc(NextByte);                        { set the next byte index }
  338.         BitsLeft := 8;                        { set bits left in the byte }
  339.         dec(BytesLeft);                       { decrement the bytes left counter }
  340.     end;
  341.     ret := CurrByte shr (8 - BitsLeft);                     { shift off any previosly used bits}
  342.     while CurrCodeSize > BitsLeft do        { need more bits ? }
  343.     begin
  344.         if BytesLeft <= 0 then                                                          { any bytes left in block ? }
  345.             ReadSubBlock;                       { if not read in another block }
  346.         CurrByte := ImageData.Datos[NextByte]; { get another byte }
  347.         inc(NextByte);                        { increment NextByte counter }
  348.         ret := ret or (CurrByte shl BitsLeft);{ add the remaining bits to the return value }
  349.         BitsLeft := BitsLeft + 8;                                               { set bit counter }
  350.         dec(BytesLeft);                     { decrement bytesleft counter }
  351.     end;
  352.     BitsLeft := BitsLeft - CurrCodeSize;  { subtract the code size from bitsleft }
  353.     ret := ret and CodeMask[CurrCodeSize];{ mask off the right number of bits }
  354.     NextCode := ret;
  355. end;
  356.  
  357. { this procedure initializes the graphics mode and actually decodes the
  358.     GIF image }
  359. procedure TGif.Decode(Beep: boolean);
  360. var
  361.     SP: integer; { index to the decode stack }
  362.  
  363. { local procedure that decodes a code and puts it on the decode stack }
  364. procedure DecodeCode(var Code: word);
  365. begin
  366.     while Code > HighCode do { rip thru the prefix list placing suffixes }
  367.     begin                    { onto the decode stack }
  368.         DecodeStack[SP] := Suffix[Code]; { put the suffix on the decode stack }
  369.         inc(SP);                         { increment decode stack index }
  370.         Code := Prefix[Code];            { get the new prefix }
  371.     end;
  372.     DecodeStack[SP] := Code;        { put the last code onto the decode stack }
  373.     inc(SP);                                                                        { increment the decode stack index }
  374. end;
  375.  
  376. var
  377.     TempOldCode, OldCode: word;
  378.     BufCnt: word;           { line buffer counter }
  379.     Code, C: word;
  380.     CurrBuf: word;  { line buffer index }
  381. begin
  382.     InicioGraficos(D,M);                                                   { Initialize the graphics mode and RGB palette }
  383.     InitCompressionStream;    { Initialize decoding paramaters }
  384.     OldCode := 0;
  385.     SP := 0;
  386.     BufCnt := ImageDescriptor.ImageWidth; { set the Image Width }
  387.     CurrBuf := 0;
  388.  
  389.     C := NextCode;                                          { get the initial code - should be a clear code }
  390.     while C <> EndingCode do  { main loop until ending code is found }
  391.     begin
  392.         if C = ClearCode then   { code is a clear code - so clear }
  393.         begin
  394.             CurrCodeSize := LZWCodeSize + 1;{ reset the code size }
  395.             Slot := EndingCode + 1;                                 { set slot for next new code }
  396.             TopSlot := 1 shl CurrCodeSize;  { set max slot number }
  397.             while C = ClearCode do
  398.                 C := NextCode;                  { read until all clear codes gone - shouldn't happen }
  399.             if C = EndingCode then
  400.             begin
  401.                 Error(geBadCode);   { ending code after a clear code }
  402.                 break;                                                  { this also should never happen }
  403.             end;
  404.             if C >= Slot { if the code is beyond preset codes then set to zero }
  405.                 then c := 0;
  406.             OldCode := C;
  407.             DecodeStack[sp] := C;                                   { output code to decoded stack }
  408.             inc(SP);                                                       { increment decode stack index }
  409.         end
  410.         else   { the code is not a clear code or an ending code so it must }
  411.         begin  { be a code code - so decode the code }
  412.             Code := C;
  413.             if Code < Slot then     { is the code in the table? }
  414.             begin
  415.                 DecodeCode(Code);                                       { decode the code }
  416.                 if Slot <= TopSlot then
  417.                 begin                                                         { add the new code to the table }
  418.                     Suffix[Slot] := Code;                   { make the suffix }
  419.                     PreFix[slot] := OldCode;        { the previous code - a link to the Datos }
  420.                     inc(Slot);                                                              { increment slot number }
  421.                     OldCode := C;                                                   { set oldcode }
  422.                 end;
  423.                 if Slot >= TopSlot then { have reached the top slot for bit size }
  424.                 begin                   { increment code bit size }
  425.                     if CurrCodeSize < 12 then { new bit size not too big? }
  426.                     begin
  427.                         TopSlot := TopSlot shl 1;       { new top slot }
  428.                         inc(CurrCodeSize)                                       { new code size }
  429.                     end
  430.                     else
  431.                         Error(geBitSizeOverflow); { encoder made a boo boo }
  432.                 end;
  433.             end
  434.             else
  435.             begin           { the code is not in the table }
  436.                 if Code <> Slot then                    { code is not the next available slot }
  437.                     Error(geBadCode);  { so error out }
  438.  
  439.                 { the code does not exist so make a new entry in the code table
  440.                  and then translate the new code }
  441.                 TempOldCode := OldCode;  { make a copy of the old code }
  442.                 while OldCode > HighCode do { translate the old code and place it }
  443.                 begin                                   { on the decode stack }
  444.                     DecodeStack[SP] := Suffix[OldCode]; { do the suffix }
  445.                     OldCode := Prefix[OldCode];         { get next prefix }
  446.                 end;
  447.                 DecodeStack[SP] := OldCode;     { put the code onto the decode stack }
  448.                                                                         { but DO NOT increment stack index }
  449.                 { the decode stack is not incremented because because we are only
  450.                     translating the oldcode to get the first character }
  451.                 if Slot <= TopSlot then
  452.                 begin                 { make new code entry }
  453.                     Suffix[Slot] := OldCode;                 { first char of old code }
  454.                     Prefix[Slot] := TempOldCode; { link to the old code prefix }
  455.                     inc(Slot);                   { increment slot }
  456.                 end;
  457.                 if Slot >= TopSlot then { slot is too big }
  458.                 begin                   { increment code size }
  459.                     if CurrCodeSize < 12 then
  460.                     begin
  461.                         TopSlot := TopSlot shl 1;       { new top slot }
  462.                         inc(CurrCodeSize)                                       { new code size }
  463.                     end
  464.                     else
  465.                         Error(geBitSizeOverFlow);
  466.                 end;
  467.                 DecodeCode(Code); { now that the table entry exists decode it }
  468.                 OldCode := C;     { set the new old code }
  469.             end;
  470.         end;
  471.         { the decoded string is on the decode stack so pop it off and put it
  472.          into the line buffer }
  473.         while SP > 0 do
  474.         begin
  475.             dec(SP);
  476.             LineBuffer[CurrBuf] := DecodeStack[SP];
  477.             inc(CurrBuf);
  478.             dec(BufCnt);
  479.             if BufCnt = 0 then  { is the line full ? }
  480.             begin
  481.                 DrawLine;
  482.                 CurrBuf := 0;
  483.                 BufCnt := ImageDescriptor.ImageWidth;
  484.             end;
  485.         end;
  486.     C := NextCode;  { get the next code and go at is some more }
  487.     end;            { now that wasn't all that bad was it? }
  488.     if Beep then
  489.         if Status = 0 then
  490.         begin
  491.             Sound(660);     { Beep if status is ok }
  492.             Delay(50);
  493.             NoSound;
  494.         end
  495.         else
  496.         begin
  497.             Sound(110); { Boop if status is not ok }
  498.             Delay(200);
  499.             NoSound;
  500.         end;
  501. end;
  502.  
  503. procedure TGif.DrawLine;
  504. var
  505.     I: integer;
  506. begin
  507.     for I := 0 to ImageDescriptor.ImageWidth do
  508.         PutPixel(I, CurrentY, LineBuffer[I]);
  509.     inc(CurrentY);
  510.  
  511.     if InterLaced then     { Interlace support }
  512.     begin
  513.         case InterlacePass of
  514.             0: CurrentY := CurrentY + 7;
  515.             1: CurrentY := CurrentY + 7;
  516.             2: CurrentY := CurrentY + 3;
  517.             3: CurrentY := CurrentY + 1;
  518.         end;
  519.         if CurrentY >= ImageDescriptor.ImageHeight then
  520.         begin
  521.             inc(InterLacePass);
  522.             case InterLacePass of
  523.                 1: CurrentY := 4;
  524.                 2: CurrentY := 2;
  525.                 3: CurrentY := 1;
  526.             end;
  527.         end;
  528.     end;
  529. end;
  530.  
  531. procedure TGif.InicioGraficos(D,M:integer); { Inicio de graficos }
  532.  
  533. var
  534.     GraphDriver: integer;
  535.     GraphMode: integer;
  536.     ErrorCode: integer;
  537.     I: integer;
  538.  
  539. Begin
  540.     Case D of
  541.         0 : GraphDriver := InstallUserDriver('vga256', nil);
  542.         1 : GraphDriver := InstallUserDriver('svga256', nil);
  543.         2 : GraphDriver := InstallUserDriver('IBM8514', nil);
  544.     else
  545.        GraphDriver := InstallUserDriver('vga256', nil);
  546.     end;
  547.     Case M of
  548.        0 : GraphMode := 0;
  549.        1 : GraphMode := 1;
  550.        2 : GraphMode := 2;
  551.        3 : GraphMode := 3;
  552.        4 : GraphMode := 4;
  553.        5 : GraphMode := 5;
  554.        6 : GraphMode := 6;
  555.        7 : GraphMode := 7;
  556.     else
  557.          GraphMode := 2;
  558.     end;
  559.  
  560.     InitGraph(GraphDriver, GraphMode, '\tp\bgi');
  561.     ErrorCode := GraphResult;
  562.     if ErrorCode <> grOk then
  563.     begin
  564.         Writeln('Error en Gráficos: ', GraphErrorMsg(ErrorCode));
  565.         Halt(99);
  566.     end;
  567.  
  568.     { the following loop sets up the RGB palette }
  569.     if not UseLocalColors then
  570.         for I := 0 to TableSize - 1 do
  571.             SetRGBPalette(I, GlobalColorTable[I].Rojo div 4, GlobalColorTable[i].Green
  572.                 div 4, GlobalColorTable[I].Blue div 4)
  573.     else
  574.         for I := 0 to TableSize - 1 do
  575.             SetRGBPalette(I, LocalColorTable[I].Rojo div 4, LocalColorTable[i].Green
  576.                 div 4, LocalColorTable[I].Blue div 4);
  577. end;
  578.  
  579. begin
  580.      Autor1 := au1;
  581. end.
  582.