iepsd.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 iepsd;

{$R-}
{$Q-}

{$I ie.inc}

interface

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

procedure IEReadPSD(Stream:TStream; MergedBitmap:TIEBitmap; var IOParams: TIOParamsVals; var Progress: TProgressRec; LoadLayers: boolean; layers:TList);
procedure IEWritePSD(Stream:TStream; var IOParams: TIOParamsVals; var Progress: TProgressRec; mergedImage:TIEBitmap; layers:TList);
function IETryPSD(Stream:TStream):boolean;

implementation

uses imageenview, jpegfilt;

const
  MAXLAYERNAME=1024;

type

TPSDHeader=packed record
  Signature:array [0..3] of char; // must be '8BPS'
  Version:word;                   // must be 1
  Reserved:array [0..5] of byte;  // must be 0
  Channels:word;                  // 1 to 24
  Rows:longint;                   // 1 to 30000
  Columns:longint;                // 1 to 30000
  Depth:word;                     // 1,8,16
  Mode:word;                      // 0=bitmap, 1=grayscale, 2=indexed, 3=RGB, 4=CMYK, 7=mutlichannel, 8=duotone, 9=lab
end;

TColorMap=array [0..2] of array [0..255] of byte;
PColorMap=^TColorMap;

TPSDResolutionInfo=packed record
  hRes:longint;       // fixed point number: pixels per inch
  hResUnit:word;      // 1=pixels per inch, 2=pixels per centimeter
  WidthUnit:word;     // 1=in, 2=cm, 3=pt, 4=picas, 5=columns
  vRes:longint;       // fixed point number: pixels per inch
  vResUnit:word;      // 1=pixels per inch, 2=pixels per centimeter
  HeightUnit:word;    // 1=in, 2=cm, 3=pt, 4=picas, 5=columns
end;
PPSDResolutionInfo=^TPSDResolutionInfo;

TPSDThumbnailInfo=packed record
  format:longint;         // 1=jpeg 0=raw
  width:longint;          // thumbnail width
  height:longint;         // thumbnail height
  widthbytes:longint;     // rowlen aligned
  size:longint;           // uncompressed size
  compressedsize:longint; // compressed size
  bitspixel:word;         // bits per pixel (24)
  planes:word;            // number of planes (1)
end;
PPSDThumbnailInfo=^TPSDThumbnailInfo;

TPSDReaderContext=record
  Stream:TStream;
  IOParams:TIOParamsVals;
  header:TPSDHeader;
  colormap:PColorMap;
  transpindex:integer;  // index of transparency when mode=indexed (2)
  layers:TList;
  LoadLayers:boolean;
  XProgress:TProgressRec;
  MergedBitmap:TIEBitmap;
  thumbnailLoaded:boolean;
end;

TPSDWriterContext=record
  Stream:TStream;
  IOParams:TIOParamsVals;
  layers:TList;
  mergedImage:TIEBitmap;
  mode:integer;
  depth:integer;
  Progress: TProgressRec;
end;

const
  MAGIK:array [0..3] of char='8BPS';
  RESMAGIK:array [0..3] of char='8BIM';

procedure ReadImageData(Stream:TStream; Bitmap:TIEBitmap; width,height,depth,mode:integer; colormap:PColorMap; transpindex:integer; compression:smallint; sizes:pwordarray; var cursize:integer; channel:integer); forward;

// get 16 bit signed value
function GetSmallint(Stream:TStream):smallint;
begin
  Stream.Read(result,2);
  result:=IESwapWord(result);
end;

// get 32 bit signed value
function GetLongint(Stream:TStream):longint;
begin
  Stream.Read(result,4);
  result:=IESwapDWord(result);
end;

function GetByte(Stream:TStream):byte;
begin
  Stream.Read(result,1);
end;

function IETryPSD(Stream:TStream):boolean;
var
  lpos:int64;
  header:TPSDHeader;
begin
  result:=false;
  lpos:=Stream.Position;
  try
  Stream.Read(header,sizeof(TPSDHeader));
  if not CompareMem(@header.Signature,@MAGIK,4) then
    exit;
  with header do
  begin
    Version:=IESwapWord(Version);
    Channels:=IESwapWord(Channels);
    Rows:=IESwapDWord(Rows);
    Columns:=IESwapDWord(Columns);
    Depth:=IESwapWord(Depth);
    Mode:=IESwapWord(Mode);
    if (Version<>1) or (Channels<1) or (Channels>24) or (Depth<1) or (Depth>16) or (Mode>9) then
      exit;
  end;
  result:=true;
  finally
    Stream.Position:=lpos;
  end;
end;

// read Color mode data section
procedure ReadColorMap(var context:TPSDReaderContext);
var
  colormaplen:longint;
begin
  with context do
  begin
    colormaplen:=GetLongint(Stream);
    if colormaplen=768 then
    begin
      // load color map
      getmem(colormap,768);
      Stream.Read(colormap^,768);
    end
    else
    begin
      colormap:=nil;
      Stream.Seek(colormaplen, soFromCurrent);
    end;
  end;
end;

procedure ReadResource(var context:TPSDReaderContext; ID:word; Data:pbyte; Size:longint);
var
  resinfo:PPSDResolutionInfo;
  thumbinfo:PPSDThumbnailInfo;
  ms:TIEMemStream;
  dummyParams:TIOParamsVals;
  dummyProgress:TProgressRec;
  dummyAbort:boolean;
  ss:string;
begin
  with context do
    case ID of
      $03ED:  // Resolution information
        begin
          resinfo:=PPSDResolutionInfo(Data);
          with resinfo^ do
          begin
            hRes:=IESwapDWord(hRes);
            vRes:=IESwapDWord(vRes);
            IOParams.DpiX:=trunc(hRes/65536);
            IOParams.DpiY:=trunc(vRes/65536);
          end;
        end;
      $0417:  // Transparency index (Photoshop 6.0)
        begin
          transpindex:=IESwapWord(pword(Data)^);
        end;
      $0404:  // IPTC-NAA
        begin
          IOParams.IPTC_Info.LoadFromStandardBuffer(Data,Size);
        end;
      $040F:  // ICC Profile (Photoshop 5.0)
        begin
          IOParams.InputICCProfile.LoadFromBuffer(Data,Size);
        end;
      $040C:  // Thumbnail (Photoshop 5.0)
        begin
          thumbinfo:=PPSDThumbnailInfo(Data);
          with thumbinfo^ do
          begin
            format:=IESwapDWord(format);
            width:=IESwapDWord(width);
            height:=IESwapDWord(height);
            widthbytes:=IESwapDWord(widthbytes);
            size:=IESwapDWord(size);
            compressedsize:=IESwapDWord(compressedsize);
            bitspixel:=IESwapWord(bitspixel);
            planes:=IESwapWord(planes);
          end;
          inc(data,28);
          ms:=TIEMemStream.Create(Data,Size-28);
          if not assigned(IOParams.EXIF_Bitmap) then
            IOParams.EXIF_Bitmap := TIEBitmap.Create;
          dummyParams:=TIOParamsVals.Create(nil);
          dummyProgress.fOnProgress:=nil;
          dummyProgress.Sender:=nil;
          dummyAbort:=false;
          dummyProgress.Aborting:=@dummyAbort;
          ReadJPegStream(ms, nil, IOParams.EXIF_Bitmap, dummyParams, dummyProgress, false, false, false, false, true,true,-1);
          dummyParams.Free;
          ms.free;
          if IOParams.GetThumbnail and (MergedBitmap<>nil) then
          begin
            LoadLayers:=false;
            MergedBitmap.Assign( IOParams.EXIF_Bitmap );
            thumbnailLoaded:=true;
          end;
        end;
      1060:  // XMP
        begin
          SetLength( ss, Size );
          Move( Data^, ss[1], Size );
          IOParams.XMP_Info:=ss;
        end;
    end;
end;

// Image resources section
procedure ReadImageResources(var context:TPSDReaderContext);
var
  resourceslen:longint;
  Signature:array [0..3] of char;
  ID:smallint;
  Name:string;
  NameLen:smallint;
  Size:longint;
  Data:pbyte;
  StreamSize:int64;
begin
  with context do
  begin
    resourceslen:=GetLongint(Stream);
    StreamSize:=Stream.Size;
    // load known image resources
    while resourceslen>0 do
    begin
      if (Stream.Position and $1)<>0 then
      begin
        Stream.Seek(1, soFromCurrent);
        dec(resourceslen);
        if resourceslen=0 then
          break;
      end;
      Stream.Read(Signature[0],4); dec(resourceslen,4);
      if not CompareMem(@Signature,@RESMAGIK,4) then
        break;
      ID:=GetSmallint(Stream);
      NameLen:=GetSmallint(Stream);
      SetLength(Name,NameLen);
      Stream.Read(Name[1],NameLen);
      Size:=GetLongint(Stream);
      if (Size<=0) or (Size>StreamSize) then
      begin
        dec(resourceslen,2+2+NameLen+4);
        break;
      end;
      getmem(Data,Size);
      Stream.Read(Data^,Size);
      ReadResource(context,ID,Data,Size);
      freemem(Data);
      dec(resourceslen, 2+2+NameLen+4+Size);
    end;
    Stream.Seek(resourceslen, soFromCurrent); // bypass unknown bytes
  end;
end;

type

  TAdjustment=record
    Signature:array [0..3] of char; // always 8BIM
    Key:array [0..3] of char;
    Length:longint;
    data:pbyte;
  end;
  TAdjustmentArray=array [0..MaxInt div 32] of TAdjustment;
  PAdjustmentArray=^TAdjustmentArray;

  TSmallIntArray=array [0..MaxInt div 4] of SmallInt;
  TLongIntArray=array [0..MaxInt div 8] of LongInt;

  PSmallIntArray=^TSmallIntArray;
  PLongIntArray=^TLongIntArray;

  TTempLayerData=record
    ChannelID:PSmallIntArray;
    ChannelLen:PLongIntArray;
    layerTop,layerLeft,layerBottom,layerRight:longint;
    numberChannels:smallint;
    BlendMode:array [0..3] of char;
    Opacity:byte;
    Clipping:byte;
    Flags:byte;
    layermask_Size:longint;
    layermask_Top:longint;
    layermask_Left:longint;
    layermask_Bottom:longint;
    layermask_Right:longint;
    layermask_DefaultColor:byte;
    layermask_Flags:byte;
    Name:array [0..MAXLAYERNAME-1] of char;
    adjustmentCount:integer;
    adjustment:PAdjustmentArray;
  end;
  PTempLayerData=^TTempLayerData;
  TArrayOfTempLayerData=array [0..MaxInt div 262144] of TTempLayerData;
  PArrayOfTempLayerData=^TArrayOfTempLayerData;

// Read layer and mask information section
procedure ReadLayerAndMaskInfo(var context:TPSDReaderContext);
var
  lpos1:int64;
  layerslen:longint;
  layersinfolen:longint;
  li:longint;
  b:byte;
  layerscount:smallint;
  i,j,c,k:integer;
  compression:smallint;
  cursize:integer;
  sizes:pwordarray;
  width,height:integer;
  ExtraDataSize:longint;
  LayersTemp:PArrayOfTempLayerData;
  layer:TIELayer;
  globalmaskLength:longint;
  //globalmaskOverlayColorSpace:smallint;
  globalmaskColorComponents:array [0..3] of smallint;
  //globalmaskOpacity:smallint;
  //globalmaskKind:byte;
begin
  with context do
  begin
    layerslen:=GetLongint(Stream);
    lpos1:=Stream.Position;
    if layerslen>0 then
    begin
      layersinfolen:=GetLongint(Stream);
      layerscount:=abs(GetSmallint(Stream));
      if ((layerscount>1) and not LoadLayers) or (layers=nil) then
      begin
        Stream.Seek(layerslen-4-2,soFromCurrent); // bypass layers
        exit;
      end;
      LayersTemp:=AllocMem( sizeof(TTempLayerData)*layerscount );
      for i:=0 to layerscount-1 do
      begin
        // load layer parameters
        LayersTemp[i].layerTop:=GetLongint(Stream);
        LayersTemp[i].layerLeft:=GetLongint(Stream);
        LayersTemp[i].layerBottom:=GetLongint(Stream);
        LayersTemp[i].layerRight:=GetLongint(Stream);
        LayersTemp[i].numberChannels:=GetSmallint(Stream);
        getmem(LayersTemp[i].ChannelID,sizeof(Smallint)*LayersTemp[i].numberChannels);
        getmem(LayersTemp[i].ChannelLen,sizeof(Longint)*LayersTemp[i].numberChannels);
        for c:=0 to LayersTemp[i].numberChannels-1 do
        begin
          LayersTemp[i].ChannelID[c]:=GetSmallint(Stream);
          LayersTemp[i].ChannelLen[c]:=GetLongint(Stream);
        end;
        Stream.Seek(4, soFromCurrent); // bypass blend mode signature (always 8BIM)
        Stream.Read(LayersTemp[i].BlendMode[0],4);
        LayersTemp[i].Opacity:=GetByte(Stream);
        LayersTemp[i].Clipping:=GetByte(Stream);
        LayersTemp[i].Flags:=GetByte(Stream);
        Stream.Seek(1, soFromCurrent);  // bypass filler
        ExtraDataSize:=GetLongint(Stream);
        // layer mask / adjustment layer data
        LayersTemp[i].layermask_Size:=GetLongint(Stream);
        if LayersTemp[i].layermask_Size>0 then
        begin
          LayersTemp[i].layermask_Top:=GetLongint(Stream);
          LayersTemp[i].layermask_Left:=GetLongint(Stream);
          LayersTemp[i].layermask_Bottom:=GetLongint(Stream);
          LayersTemp[i].layermask_Right:=GetLongint(Stream);
          LayersTemp[i].layermask_DefaultColor:=GetByte(Stream);
          LayersTemp[i].layermask_Flags:=GetByte(Stream);
          Stream.Seek(2, soFromCurrent);  // bypass padding
        end;
        dec(ExtraDataSize,LayersTemp[i].layermask_Size+4);
        // layer blending ranges data (bypass)
        li:=GetLongint(Stream);
        dec(ExtraDataSize,li+4);
        Stream.Seek(li, soFromCurrent);
        // layer name
        b:=GetByte(Stream);
        Stream.Read(LayersTemp[i].Name[0],imin(b,MAXLAYERNAME-1));
        LayersTemp[i].Name[b]:=#0;
        dec(ExtraDataSize,1+b);
        while (ExtraDataSize and $3)<>0 do
        begin
          Stream.Seek(1, soFromCurrent);  // pad to multiple of 4 bytes
          dec(ExtraDataSize);
        end;
        // adjustment layer info tags
        c:=0;
        while ExtraDataSize>0 do
        begin
          inc(LayersTemp[i].adjustmentCount);
          ReallocMem(LayersTemp[i].adjustment, LayersTemp[i].adjustmentCount*sizeof(TAdjustment) );
          Stream.Read(LayersTemp[i].adjustment[c].Signature,4); // Signature '8BIM'
          Stream.Read(LayersTemp[i].adjustment[c].Key,4);       // Key
          LayersTemp[i].adjustment[c].Length:=GetLongint(Stream); // length
          getmem(LayersTemp[i].adjustment[c].Data,LayersTemp[i].adjustment[c].Length);
          Stream.Read(LayersTemp[i].adjustment[c].Data^,LayersTemp[i].adjustment[c].Length);
          dec(ExtraDataSize, 4+4+4+LayersTemp[i].adjustment[c].Length );
          inc(c);