giffilter.pas

·ImageEn 2.3.0 ImageEn一组用于图像处理、查看和分析的Delphi控件。能够保存几种图像格式

(*
Copyright (c) 1998-2007 by HiComponents. All rights reserved.

This software comes without express or implied warranty.
In no case shall the author be liable for any damage or unwanted behavior of any
computer hardware and/or software.

HiComponents grants you the right to include the compiled component
in your application, whether COMMERCIAL, SHAREWARE, or FREEWARE,
BUT YOU MAY NOT DISTRIBUTE THIS SOURCE CODE OR ITS COMPILED .DCU IN ANY FORM.

ImageEn, IEvolution and ImageEn ActiveX may not be included in any commercial,
shareware or freeware libraries or components.

email: [e-mail]

http://www.hicomponents.com
*)

unit giffilter;

{$R-}
{$Q-}

{$I ie.inc}

interface

uses Windows, Graphics, classes, sysutils, ImageEn, ImageEnIO, ImageEnProc, hyiedefs, hyieutils;

type

  // main header / screen descriptor
  TGIFHeader = packed record
    // GIF magic
    id: array[0..5] of char;
    // screen descriptor
    WinWidth: word; // window width
    WinHeight: word; // window height
    Flags: byte; // Flags
    Background: byte; // Background
    Ratio: byte; // Aspect ratio   dx/dy = (Ratio+15)/64
  end;

procedure ReadGIF(nf: string; OutBitmap: TIEBitmap; var numi: integer; var IOParams: TIOParamsVals; var Progress: TProgressRec; var AlphaChannel: TIEMask; IgnoreAlpha: boolean);
procedure ReadGIFStream(fs: TStream; OutBitmap: TIEBitmap; var numi: integer; var IOParams: TIOParamsVals; var Progress: TProgressRec; Preview: boolean; var AlphaChannel: TIEMask; IgnoreAlpha: boolean);
procedure WriteGIF(nf: string; bitmap: TIEBitmap; var IOParams: TIOParamsVals; var Progress: TProgressRec);
procedure WriteGIFStream(fs: TStream; bitmap: TIEBitmap; var IOParams: TIOParamsVals; var Progress: TProgressRec);
function _InsertGIFIm(nf: string; bitmap: TIEBitmap; var IOParams: TIOParamsVals; var Progress: TProgressRec): integer;
function _InsertGIFImStream(fs: TStream; bitmap: TIEBitmap; var IOParams: TIOParamsVals; var Progress: TProgressRec): integer;
procedure _GIFMakeAnimate(const nf: string; iters: word; windx, windy: integer);
function _DeleteGIFIm(nf: string; idx: integer; wr: boolean): integer;
function _CheckGIFAnimate(const nf: string): boolean;

implementation

uses NeurQuant, ImageEnView, ieview;

{$R-}

type
  // image descriptor
  TGIFImDes = packed record
    PosX: word; // X position
    PosY: word; // Y position
    Width: word; // width
    Height: word; // height
    Flags: byte; // Flags
  end;

  // Graphic control extension
  TGIFGCE = packed record
    Flags: byte; // Flags
    DelayTime: word; // wait time (1/100 seconds)
    TranspColor: byte; // transparent color
  end;

/////////////////////////////////////////////////////////////////////////////////////
// makes a gif animated

procedure _GIFMakeAnimate(const nf: string; iters: word; windx, windy: integer);
var
  fs: TFileStream;
  fm: TMemoryStream;
  head: TGIFHeader;
  // Dati nel campo FLAGS del Descrittore di schermo
  headDimGlobColormap: integer; // Dimensione Colormap globale
  headGlobalColormap: boolean; // Presenza colormap globale
  //
  bb: byte;
  ps: int64;
  buf: string[255];
begin
  {$ifdef IEPROFILE} try IEProfileBegin('_GIFMakeAnimate'); {$endif}
  fm := TMemoryStream.Create; // OUTPUT
  fs := TFileStream.create(nf, fmOpenRead or fmShareDenyWrite); // INPUT
  // Legge header e controlla validit