iepsd.pas

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

    bitmapWidth:=bitmap.Width;
    bitmapHeight:=bitmap.Height;
    bitmapPixelFormat:=bitmap.PixelFormat;
    if sizes=nil then
    begin
      PutSmallint(Stream,1);  // compression (for merged, out of channels loop)
      // put blank row lengths
      pos2:=Stream.Position;
      Stream.Seek(BitmapHeight*channelCount*2,soFromCurrent);
    end;
    for i:=0 to channelCount-1 do
    begin
      pos1:=Stream.Position;
      if sizes<>nil then
      begin
        PutSmallint(Stream,1);  // compression (for layers)
        // put blank row lengths
        pos2:=Stream.Position;
        Stream.Seek(BitmapHeight*2,soFromCurrent);
      end;
      for row:=0 to bitmapHeight-1 do
      begin
        pb:=Bitmap.Scanline[row];
        pw:=pword(pb);
        if bitmapPixelFormat=ie24RGB then
          inc(pb,2-i)
        else
          inc(pb,i);
        inc(pw,i);
        case depth of
          1:
            begin
              actlen:=rl;
              move(pb^,rowbuf^,actlen);
            end;
          8:
            begin
              rb:=rowbuf;
              for col:=0 to bitmapWidth-1 do
              begin
                rb^:=pb^;
                inc(pb,channelCount);
                inc(rb);
              end;
              actlen:=rl;
            end;
          16:
            begin
              wb:=pword(rowbuf);
              for col:=0 to bitmapWidth-1 do
              begin
                wb^:=IESwapWord(pw^);
                inc(pw,channelCount);
                inc(wb);
              end;
              actlen:=rl;
            end;
        end;
        WriteRow;
      end;
      // write channel size
      if sizes<>nil then
        PutLongintAt(Stream,sizes[sizesIdx][k],Stream.Size-pos1);  // included compression tag
      //
      inc(k);
      if doProgress and assigned(Progress.fOnProgress) then
        Progress.fOnProgress(Progress.Sender, trunc(i/channelCount*100));
    end;

    // put layer mask (always 8 bit?)
    if layerMask<>nil then
    begin
      pos1:=Stream.Position;
      PutSmallint(Stream,1);  // compression
      // put blank row lengths
      pos2:=Stream.Position;
      Stream.Seek(layerMask.Height*2,soFromCurrent);
      // write values
      for row:=0 to layerMask.Height-1 do
      begin
        pb:=layerMask.Scanline[row];
        actlen:=layerMask.Width;
        move(pb^,rowbuf^,actlen);
        WriteRow;
      end;
      // write channel size
      if sizes<>nil then
        PutLongintAt(Stream,sizes[sizesIdx][k],Stream.Size-pos1);  // included compression tag
    end;

    freemem(cmpbuf);
    freemem(rowbuf);

  end;  // end of with context
end;


procedure WriteLayers(var context:TPSDWriterContext);
var
  sizepos:int64;
  i,j,k:integer;
  lyr,msk:TIELayer;
  sizes:PSizes;  // array of lsizes structure to store channels sizes for each layer
  layermaskcount:integer; // number of layer masks
  pos1:int64;
  extradatasize:integer;
  chcount:integer;
  tempLayer:TIELayer; // used if layers.Count=0
begin
  with context do
  begin
    sizepos:=Stream.Position;
    PutLongint(Stream,0); // dummy size value

    if layers.Count=0 then
    begin
      tempLayer:=TIELayer.Create(nil,MergedImage,true);
      tempLayer.FreeBitmapOnDestroy:=false;
      layers.Add(tempLayer);
    end
    else
      tempLayer:=nil;

    // count how much layer mask are present
    layermaskcount:=0;
    for i:=0 to layers.Count-1 do
      if TIELayer(layers[i]).IsMask then
        inc(layermaskcount);

    PutSmallint(Stream,layers.Count-layermaskcount); // layers count

    getmem( sizes, sizeof(integer)*6*layers.Count );

    for i:=0 to layers.Count-1 do
    begin
      lyr:=TIELayer(layers[i]);

      if not lyr.IsMask then
      begin

        PutLongint(Stream, lyr.PosY); // Layer top
        PutLongint(Stream, lyr.PosX); // Layer left
        PutLongint(Stream, lyr.PosY+lyr.Bitmap.Height);   // Layer bottom
        PutLongint(Stream, lyr.PosX+lyr.Bitmap.Width);    // Layer right

        // channels count
        chcount:=lyr.Bitmap.ChannelCount;
        if lyr.Bitmap.HasAlphaChannel then
          inc(chcount);
        if (i<layers.Count-1) and (TIELayer(layers[i+1]).IsMask) then
          inc(chcount);
        PutSmallint(Stream, chcount);

        // channel length info
        k:=0;
        if lyr.Bitmap.HasAlphaChannel then
        begin
          // transparency mask
          PutSmallint(Stream, -1);  // -1 = transparency mask
          sizes[i][k]:=Stream.Position;
          inc(k);
          PutLongint(Stream,0);     // dummy size
        end;
        for j:=0 to lyr.Bitmap.ChannelCount-1 do
        begin
          // color channels
          PutSmallint(Stream,j);
          sizes[i][k]:=Stream.Position;
          inc(k);
          PutLongint(Stream,0);     // dummy size
        end;
        if (i<layers.Count-1) and (TIELayer(layers[i+1]).IsMask) then
        begin
          // layer mask
          PutSmallint(Stream, -2);
          sizes[i][k]:=Stream.Position;
          //inc(k);
          PutLongint(Stream,0);     // dummy size
        end;

        Stream.Write('8BIM',4); // Blend mode signature
        Stream.Write('norm',4); // temporary: blend mode key
        PutByte(Stream, lyr.Transparency);  // Opacity
        //PutByte(Stream, integer(not lyr.Cropped));  // Clipping
        PutByte(Stream, 0);  // 2.2.4rc2: it seems that photoshop doesn't support "1"!

        // Flags
        if lyr.Visible then
          PutByte(Stream, 0)
        else
          PutByte(Stream, $2);

        PutByte(Stream,0);  // Filler

        // extra data size
        pos1:=Stream.Position;
        PutLongint(Stream,0); // Extra data size (dummy value)
        extradatasize:=0;

        // Layer mask data
        inc(extradatasize,4);
        if (i<layers.Count-1) and (TIELayer(layers[i+1]).IsMask) then
        begin
          PutLongint(Stream,20); // Layer mask data size
          msk:=TIELayer(layers[i+1]);
          PutLongint(Stream, msk.PosY); // top
          PutLongint(Stream, msk.PosX); // left
          PutLongint(Stream, msk.PosY+msk.Bitmap.Height);   // bottom
          PutLongint(Stream, msk.PosX+msk.Bitmap.Width);    // right
          PutByte(Stream, 0); // default color
          PutByte(Stream, 0); // flags
          PutSmallint(Stream, 0); // padding (zeros)
          inc(extradatasize,20);
        end
        else
          PutLongint(Stream,0); // Layer mask data size (no layer mask)

        // Layer blending ranges (not used)
        PutLongint(Stream,0); // zero size
        inc(extradatasize,4);

        // Layer name
        PutByte(Stream,length(lyr.Name)); // name size
        Stream.Write(lyr.Name[1],length(lyr.Name)); // name
        inc(extradatasize,1+length(lyr.Name));
        // pad to multiple of 4 bytes
        while (ExtraDataSize and $3)<>0 do
        begin
          PutByte(Stream,1);
          inc(ExtraDataSize);
        end;

        // adjustment layer info tags (not used)
        // just blank because this is tagged

        // actual extra data asize
        PutLongintAt(Stream,pos1,extradatasize);
      end;

    end;  // for each layer loop

    // write pixel data
    for i:=0 to layers.Count-1 do
    begin
      lyr:=TIELayer(layers[i]);
      if not lyr.IsMask then
      begin
        if (i<layers.Count-1) and (TIELayer(layers[i+1]).IsMask) then
          WritePixelData(context,lyr.Bitmap,TIELayer(layers[i+1]).Bitmap,sizes,i,false)
        else
          WritePixelData(context,lyr.Bitmap,nil,sizes,i,false);
      end;
      if assigned(Progress.fOnProgress) then
        Progress.fOnProgress(Progress.Sender, trunc(i/layers.Count*100));
    end;

    freemem( sizes );
    if tempLayer<>nil then
    begin
      layers.Clear;
      tempLayer.free;
    end;

    PutLongintAt(Stream,sizepos,Stream.Size-sizepos-4);
  end;
end;

procedure WriteGlobalMask(var context:TPSDWriterContext);
var
  sizepos:int64;
begin
  with context do
  begin
    sizepos:=Stream.Position;
    PutLongint(Stream,0); // dummy size value

    PutLongintAt(Stream,sizepos,Stream.Size-sizepos-4);
  end;
end;

// Write layer and mask information section
procedure WriteLayerAndMaskInfo(var context:TPSDWriterContext);
var
  sizepos:int64;
begin
  with context do
  begin
    sizepos:=Stream.Position;
    PutLongint(Stream,0); // dummy size value
    WriteLayers(context);
    WriteGlobalMask(context);
    PutLongintAt(Stream,sizepos,Stream.Size-sizepos-4);
  end;
end;

// in PSD layers have the same size of related bitmap
// in PSD layers have all the same pixel format
// this function make ImageEn layers compatible with PSD
procedure MakeLayersPSDCompatible(mergedImage:TIEBitmap; layers:TList);
var
  mode:integer;
  depth:integer;
  i:integer;
  proc:TImageEnProc;
begin
  mode:=-1;
  depth:=-1;
  if mergedImage<>nil then
  begin
    mode:=PIXELFORMAT2MODE[mergedImage.PixelFormat];
    depth:=mergedImage.BitCount div mergedImage.ChannelCount;
  end;
  if mode=-1 then
  begin
    with TIELayer(layers[0]) do
    begin
      mode:=PIXELFORMAT2MODE[Bitmap.PixelFormat];
      depth:=Bitmap.BitCount div Bitmap.ChannelCount;
    end;
  end;
  if (mode=-1) or (mode=1000) then
    exit;
  proc:=TImageEnProc.Create(nil);
  for i:=0 to layers.Count-1 do
  begin
    // change pixel format (if this is not a layer mask)
    with TIELayer(layers[i]) do
    begin
      if not IsMask then
        case mode of
          0:  // black/white
            begin
              depth:=1;
              if Bitmap.PixelFormat<>ie1g then
                Bitmap.PixelFormat:=ie1g;
            end;
          1:  // gray scale
            begin
              if (depth=8) and (Bitmap.PixelFormat<>ie8g) then
                Bitmap.PixelFormat:=ie8g
              else if (depth=16) and (Bitmap.PixelFormat<>ie16g) then
                Bitmap.PixelFormat:=ie16g;
            end;
          2:  // indexed
            begin
              depth:=8;
              if Bitmap.PixelFormat<>ie8p then
                Bitmap.PixelFormat:=ie8p;
            end;
          3:  // RGB
            begin
              if (depth=8) and (Bitmap.PixelFormat<>ie24RGB) then
                Bitmap.PixelFormat:=ie24RGB
              else if (depth=16) and (Bitmap.PixelFormat<>ie48RGB) then
                Bitmap.PixelFormat:=ie48RGB;
            end;
          4:  // CMYK
            begin
              depth:=8;
              if Bitmap.PixelFormat<>ieCMYK then
                Bitmap.PixelFormat:=ieCMYK;
            end;
          9:  // Lab
            begin
              depth:=8;
              if Bitmap.PixelFormat<>ieCIELab then
                Bitmap.PixelFormat:=ieCIELab;
            end;
        end;
      // now resize
      if (Width<>Bitmap.Width) or (Height<>Bitmap.Height) then
      begin
        proc.AttachedIEBitmap:=Bitmap;
        if UseResampleFilter then
          proc.Resample(Width,Height,ResampleFilter)
        else
          proc.Resample(Width,Height,rfNone);
      end;
    end;
  end;
  proc.Free;
end;

// layers cannot be "nil". If you don't want save layers, just leave its size (Count) = 0
// mergedImage must be always present
procedure IEWritePSD(Stream:TStream; var IOParams: TIOParamsVals; var Progress: TProgressRec; mergedImage:TIEBitmap; layers:TList);
var
  context:TPSDWriterContext;
  header:TPSDHeader;
begin

  MakeLayersPSDCompatible(mergedImage,layers);

  context.Stream:=Stream;
  context.IOParams:=IOParams;
  context.layers:=layers;
  context.mergedImage:=mergedImage;
  context.Progress:=Progress;
  with context do
  begin

    mode:=PIXELFORMAT2MODE[mergedImage.PixelFormat];
    depth:=mergedImage.BitCount div mergedImage.ChannelCount;

    // prepare header
    Move(MAGIK[0],header.Signature[0],4);
    header.Version:=IESwapWord(1);
    fillchar(header.Reserved[0],5,0);
    header.Channels:=IESwapWord(mergedImage.ChannelCount);
    header.Rows:=IESwapDWord(mergedImage.Height);
    header.Columns:=IESwapDWord(mergedImage.Width);
    header.Depth:=IESwapWord(depth);
    header.Mode:=IESwapWord(mode);
    if header.Mode=1000 then
    begin
      // pixel format not supported by PSD
      Progress.Aborting^:=true;
      exit;
    end;

    // write header
    Stream.Write(header,sizeof(TPSDHeader));

    // write color mode data section (palette)
    WriteColorMap(context);

    // write image resources section
    WriteImageResources(context);

    // write Layer and mask information section
    WriteLayerAndMaskInfo(context);

    // write pixel data (merged image)
    WritePixelData(context, mergedImage, nil, nil, 0, (layers.Count>0));

  end;
end;


end.