htmlgif1.pas

查看html文件的控件

// some things, though, will always be needed

new(fSignature);
if (fSignature = nil) then OutOfMemoryError;
fSignature^.rSignature := '------';

new(fScreenDescriptor);
if (fScreenDescriptor = nil) then OutOfMemoryError;
fillchar(fScreenDescriptor^, sizeof(TGifScreenDescriptor), 0);

fImageDescriptorList := TList.Create;
fColorTableList      := TList.Create;
fPaletteList         := TList.Create;

end;


destructor TGif.Destroy;
begin

// clean up most of the data

FreeImage;

// and then the left-overs

dispose(fSignature);
dispose(fScreenDescriptor);

fImageDescriptorList.Free;
fColorTableList.Free;
fPaletteList.Free;

// and the ancestor

inherited;
end;

{ ---------------------------------------------------------------------------- }
{ release all memory used to store image data }

procedure TGif.FreeImage;
var
    i:    integer;
    id:     PGifImageDescriptor;
    ct:     PGifColorTable;
begin

// temp input/output stream

if (fIOStream <> nil) then fIOStream.Free;
fIOStream := nil;

// temp encoded data

if (fDataStream <> nil) then fDataStream.Free;
fDataStream:= nil;

// temp list of image extensions

if (fExtension <> nil) then FreeExtensionList(fExtension);
fExtension := nil;

// signature record stays, but is cleared

if (fSignature = nil) then new(fSignature);
fSignature^.rSignature := '------';

// ditto the screen descriptor

if (fScreenDescriptor = nil) then new(fScreenDescriptor);
fillchar(fScreenDescriptor^, sizeof(TGifScreenDescriptor), 0);

// delete all items from image list, but leave the list

if (fImageDescriptorList = nil) then fImageDescriptorList := TList.Create;
for i := 0 to (fImageDescriptorList.Count - 1) do
    begin
    id := fImageDescriptorList.Items[i];
    if (id <> nil) then
        begin
        if (id^.rExtensionList <> nil) then FreeExtensionList(id^.rExtensionList);
        if (id^.rPixelList     <> nil) then freemem(id^.rPixelList);
        if (id^.rBitmap        <> nil) then id^.rBitmap.Free;

        dispose(id);
        end;
    end;
fImageDescriptorList.Clear;

// release color tables, but keep the list

if (fColorTableList = nil) then fColorTableList := TList.Create;
for i := 0 to (fColorTableList.Count - 1) do
    begin
    ct := fColorTableList.Items[i];
    if (ct <> nil) then dispose(ct);
    end;
fColorTableList.Clear;

// once again, keep the palette list object, but not the data

if (fPaletteList = nil) then fPaletteList := TList.Create;
fPaletteList.Clear;

// don't need the zip/unzip data block

if (fZipData <> nil) then dispose(fZipData);
fZipData := nil;
end;


{ ---------------------------------------------------------------------------- }
{ READ and WRITE A GIF ------------------------------------------------------- }

{ ---------------------------------------------------------------------------- }
{ read a GIF definition from a stream }

procedure TGif.LoadFromStream(Source: TStream);
var
    done:   boolean;
    b:      byte;
begin

// release old image that may be here ...

FreeImage;

// no error yet

GIF_ErrorCode := 0;
GIF_ErrorString := '';

// make a local copy of the source data
// memory streams are faster and easier to manipulate than file streams

fIOStream := TMemoryStream.Create;
Source.Position := 0;
fIOStream.LoadFromStream(Source);

// local temp vars

fDataStream := TMemoryStream.Create;        // data to be un-zipped
fExtension  := nil;                         // extensions to an image


// read the signature GIF87A or GIF89A

ReadSignature;

// read the logical screen descriptor

ReadScreenDescriptor;

// read extensions and image data until end of file

done := false;
while (not done) do
  try  {LDB}
    if (fIOStream.Position >= fIOStream.Size) then
      //GIF_Error(9);    {LDB} 
      b := 0             {LDB}

    else fIOStream.Read(b, 1);    {LDB}         // image separator

    if (b = 0) then                             // just skip this?
        begin
        b := 0;
        Done := True;   {LDB}
        end
    else if (b = kGifTerminator) then           // got it all
        begin
        done := true;
        end
    else if (b = kGifImageSeparator) then       // next bitmap
        begin
        ReadImageDescriptor;
        end
    else if (b = kGifExtensionSeparator) then   // special operations
        begin
        ReadExtension(Done);
        end
    else                                        // unknown
        begin
        GIF_Error(4);
        end;
  except  {LDB}  
    if GetImageCount > 0 then
      Done := True     {use what images we have}
    else
      Raise;
    end;

// must have an image

if (fImageDescriptorList.Count = 0) then GIF_Error(18);  

// no longer need the source data in memory

fIOStream.Free;
fDataStream.Free;
FreeExtensionList(fExtension);

fIOStream   := nil;
fDataStream := nil;
fExtension  := nil;
end;


function TGif.GetHeight: integer;
begin
GetHeight := fScreenDescriptor^.rHeight;
end;

function TGif.GetWidth: integer;
begin
GetWidth := fScreenDescriptor^.rWidth;
end;

{ ---------------------------------------------------------------------------- }
{ TRANSPARENT is assument to be the same for all images; i.e., if the first }
{ image is transparent, they they are all transparent }
{ if SetTransparent(TRUE) then set default color index for transparent color }
{ this can be changed with TransparentColor after this call }

{LDB  changed so that if any images are transparent, Transparent returns True}
function TGif.GetTransparent: boolean;
var
    b:      boolean;
    gx:     PGifExtensionGraphic;
    i:      integer;
begin
b := false;
for I := 0 to (fImageDescriptorList.Count - 1) do
  begin
  gx := FindGraphicExtension(I);
  if (gx <> nil) then
    b := gx^.rTransparentValid or b;
  end;

GetTransparent := b;
end;

{ ---------------------------------------------------------------------------- }
{ PROCEDURES TO READ A GIF FILE ---------------------------------------------- }

{ ---------------------------------------------------------------------------- }
{ read the GIF signature from the source stream }
{ this assumes the memory stream position is correct }
{ the signature is always 6 bytes, and must be either GIF87A or GIF89A }

procedure TGif.ReadSignature;
var
    s:      string;
begin
with fSignature^ do
    begin
    fIOStream.Read(rSignature, 6);
    s := rSignature;
    s := UpperCase(s);
    if ((s <> 'GIF87A') and (s <> 'GIF89A')) then GIF_Error(1);
    end;
end;


{ ---------------------------------------------------------------------------- }
{ read the GIF logical screen descriptor from the source stream }
{ this assumes the memory stream position is correct }
{ this always follows the GIF signature }

procedure TGif.ReadScreenDescriptor;
var
    i,n:    integer;
begin
with fScreenDescriptor^ do
    begin
    ReadSourceInteger(2, rWidth);                   // logical screen width
    ReadSourceInteger(2, rHeight);                  // logical screen height

    ReadSourceInteger(1, n);                        // packed bit fields
    rGlobalColorValid := ((n and $80) <> 0);
    rColorResolution  := ((n shr 4) and $07) + 1;
    rSorted           := ((n and $08) <> 0);

    i := (n and $07);
    if      (i = 0) then rGlobalColorSize := 2
    else if (i = 1) then rGlobalColorSize := 4
    else if (i = 2) then rGlobalColorSize := 8
    else if (i = 3) then rGlobalColorSize := 16
    else if (i = 4) then rGlobalColorSize := 32
    else if (i = 5) then rGlobalColorSize := 64
    else if (i = 6) then rGlobalColorSize := 128
    else if (i = 7) then rGlobalColorSize := 256
    else                 rGlobalColorSize := 256;


    ReadSourceInteger(1, rBackgroundIndex);         // background color
    ReadSourceInteger(1, rAspectRatio);             // pixel aspect ratio

// read the global color table from the source stream
// this assumes the memory stream position is correct
// the global color table is only valid if a flag is set in the logical
// screen descriptor.  if the flag is set, the global color table will
// immediately follow the logical screen descriptor

    rGlobalColorTable := -1;
    if (rGlobalColorValid) then                     // a global color table?
        ReadColorTable(rGlobalColorSize, rGlobalColorTable)
    end;
end;

{ ---------------------------------------------------------------------------- }
{ read in any type of color table }
{ number of RGB entries is given by SIZE, and save the index into the }
{ master color table list in TABLE }
{ if SIZE is <= 0, then there is no table, and the TABLE becomes -1 }

procedure TGif.ReadColorTable(Size: integer; var Table: integer);
var
    i,n:        integer;
    r,g,b:      byte;
    ct:         PGifColorTable;
begin
Table := -1;                            // assume no table
if (Size > 0) then                      // OK, a table does exist
    begin
    new(ct);                            // make a anew color table
    if (ct = nil) then OutOfMemoryError;
    n := fColorTableList.Add(ct);       // save it in master list
    Table := n;                         // save index for a valid table

    ct^.rSize := Size;

    for i := 0 to (ct^.rSize-1) do      // read a triplet for each TColor
        begin
        fIOStream.Read(r, 1);             // red
        fIOStream.Read(g, 1);             // green
        fIOStream.Read(b, 1);             // blue

        ct^.rColors[i] := r or (g shl 8) or (b shl 16);  
        end;

// make sure we store palette handle in same index slot as the color table

    while (fPaletteList.Count < fColorTableList.Count) do fPaletteList.Add(nil);
    fPaletteList.Items[Table] := Nil;
    end;
end;

{ ---------------------------------------------------------------------------- }
{ read the next image descriptor }
{ the source stream position should be immediately following the }
{ special code image separator }
{ note: this routine only reads in the raw data; the LZW de-compression }
{ occurs later, after all the data has been read }
{ this probably makes for a bigger data chunk, but it doesn't much effect }
{ the speed, and it is certainly a more modular approach and is much easier }
{ to understand the mechanics later }

procedure TGif.ReadImageDescriptor;
var
    i,n:    integer;
    ix:     integer;
    id:     PGifImageDescriptor;
    db:     TGifDataBlock;
begin

// make a new image desctiptor record and add this record to main list

new(id);
if (id = nil) then OutOfMemoryError;
if (fImageDescriptorList = nil) then fImageDescriptorList := TList.Create;
ix := fImageDescriptorList.Add(id);
id^.rIndex := ix;

// initialize data

fillchar(id^, sizeof(TGifImageDescriptor), 0);

// init the sotrage for compressed data

fDataStream.Clear;

// if extensions were read in earlier, save that list
// for this image descriptor
// if no extensions were read in, then we don't need this list at all

if (fExtension <> nil) then
    begin
    id^.rExtensionList := fExtension;
    fExtension := nil;
    end;

// shortcut to the record fields

with id^ do
    begin

// read the basic descriptor record

    ReadSourceInteger(2, rLeft);            // left position