EPSの表示 (ID:4283)

名前

ホームページ(ブログ、Twitterなど)のURL (省略可)

本文

EPSのWMFファイルをプレビューするだけでしたら
以前、誰かに差し上げたコードがありますので下記を参考にしてみて下さい。

// EPSPack.pasのソース

// {$DEFINE USETIFF}    // ←個人用設定
(*------------------------------------------------------------------*)
(*                                                                  *)
(* 読み込みはWMFプレビューのみ、書き込みは"プレビューなし"のみです  *)
(*                                                                  *)
(*------------------------------------------------------------------*)

unit EPSPack;

interface
 uses Windows,Classes, Graphics, SysUtils;

type
  TEPSImage = class(TBitmap)
  private
   {$IFDEF USETIFF}
    FPreview : Boolean;
   {$ENDIF}
    FMono    : Boolean;
    procedure Write8bit(Stream : TStream);
    procedure Write24bit(Stream : TStream);
  public
    constructor Create; override;
    procedure LoadFromStream(Stream: TStream); override;
    procedure SaveToStream(Stream: TStream); override;
    published
   {$IFDEF USETIFF}
     property Preview : Boolean read FPreview write FPreview;
   {$ENDIF}
     property Mono : Boolean read FMono write FMono;
  end;

// 28byte;
  type
  TEPSPreview =packed record
    Magic          : Dword;  // $C6D3D0C5
    PostScriptPos  : Dword;
    PostScriptSize : Dword;
    MetaFilePos    : Dword;  // メタファイルでない場合は0
    MetaFileSize   : Dword;  // メタファイルでない場合は0
    TIFFPos        : Dword;  // TIFFファイルでない場合は0
    TIFFSize       : Dword;  // TIFFファイルでない場合は0
  end;

type
   pRGBArray = ^TRGBArray;
   TRGBArray = array[0..32768-1] of TRGBTriple;

type
   TRGBTripleW =packed record
    R,G,B :Word;
  end;

type
   pRGBArrayW = ^TRGBArrayW;
   TRGBArrayW = array[0..32768-1] of TRGBTripleW;

const
   LF    : Byte   =$0A;
   Dummy : DWord  =$0000FFFF;

implementation

{$IFDEF USETIFF}
 uses
  TIFFPack;
{$ENDIF}

// Byte -> Binary -> Ascii -> Word
function IntToHexEx(B: Byte) :Word;
Var
 Hi,Lo :Byte;
begin
  Hi:=(B And $F0) shr 4;
  Lo:=B And $0F;

case Hi of
   0..9   : Hi:=  Hi+48;
   10..15 : Hi:=  Hi+55;
  end;

case Lo of
   0..9   : Lo:=  Lo+48;
   10..15 : Lo:=  Lo+55;
  end;

Result:= (Lo shl 8) or Hi;
end;

function EffectGrayScaleColor(hBMP :HBitmap):HBitmap;

function  RGBTripleToYIQ (R,G,B:Byte):  integer;
   begin
       Result := INTEGER(77*R + 150*G + 29*B) SHR 8
   end;

var
  Row,Col,w,h    : Integer;
  RGBColor       : Integer;
  SrcRow,DestRow : pRGBArray;
  SrcBitmap,DestBitmap : TBitmap;
begin
  SrcBitmap   :=TBitmap.Create;
  DestBitmap  :=TBitmap.Create;
  SrcBitmap.Handle :=hBMP;

SrcBitmap.Pixelformat :=pf24bit;
  DestBitmap.Pixelformat:=pf24bit;
  DestBitmap.Width  :=SrcBitmap.Width;
  DestBitmap.Height :=SrcBitmap.Height;

w :=SrcBitmap.Width-1;
  h :=SrcBitmap.Height-1;

try
    for Row:=0 to h do
    begin
       SrcRow :=SrcBitmap.ScanLine[Row];
       DestRow:=DestBitmap.ScanLine[Row];
       for Col:=0 to w do
       begin
         RGBColor:=RGBTripleToYIQ(SrcRow[Col].rgbtRed,
                                  SrcRow[Col].rgbtGreen,
                                  SrcRow[Col].rgbtBlue);
         DestRow[Col].rgbtBlue :=RGBColor;
         DestRow[Col].rgbtGreen:=RGBColor;
         DestRow[Col].rgbtRed  :=RGBColor;
       end;
    end;
    Result :=DestBitmap.ReleaseHandle;
  except
    Result :=SrcBitmap.ReleaseHandle;
  end;

SrcBitmap.Free  ;
  DestBitmap.Free;
end;

constructor TEPSImage.Create;
begin
  inherited Create;
  {$IFDEF USETIFF}
     FPreview :=True;
  {$ENDIF}
  FMono    :=false;
end;

procedure TEPSImage.Write8bit(Stream : TStream);
Var
 Row,Col : Integer;
 SrcRow  : pRGBArray;
 SrcCnt  : Integer;
 SrcMem  : Pointer;
 SrcLine : pWordArray;
begin

With TStringStream(Stream) do
 begin
    // ポストスクリプト
    WriteString('%!PS-Adobe-1.0 EPSF-1.2'#10);
    WriteString(Format('%%%%BoundingBox: 0 0 %d %d'#10,[WIdth,Height]));
    WriteString('%%Creator: Created by GraphicConvert Library'#10);
    WriteString('%%EndComments'#10);
    WriteString(Format('/width %d def'#10,[Width]));
    WriteString(Format('/height %d def'#10,[height]));
    WriteString(Format('/pixwidth %d def'#10,[Width]));
    WriteString(Format('/pixheight %d def'#10,[height]));
    WriteString('/picstr width string def'#10);
    WriteString('/TokPic {'#10);
    WriteString('gsave width height 8'#10);
    WriteString('[width 0 0 height 0 height neg]'#10);
    WriteString('{currentfile picstr readhexstring pop}'#10);
    WriteString('image grestore } def'#10);
    WriteString('0 height neg translate pixwidth pixheight scale'#10);
    WriteString('TokPic'#10);

// イメージデータの書き込み
    PixelFormat:=pf24bit;

GetMem(SrcMem,Width*2);
    SrcLine :=SrcMem;
    try
       for Row:=Height-1 Downto 0 do
       begin
         SrcRow :=ScanLine[Row];
         SrcCnt :=0;
         for Col:= 0 to Width-1 do
         begin
           SrcLine[SrcCnt] :=IntToHexEx(SrcRow[Col].rgbtRed);
           Inc(SrcCnt);
         end;
         Stream.WriteBuffer(SrcLine[0],Width*2);
         Stream.Write(LF,1);
       end;
    finally
       FreeMem(SrcMem);
    end;
    WriteString('%%Trailer'#10);
  end;
end;

procedure TEPSImage.Write24bit(Stream : TStream);
Var
 Row,Col : Integer;
 SrcRow  : pRGBArray;
 SrcCnt  : Integer;
 SrcMem  : Pointer;
 SrcLine : pRGBArrayW;
begin
 With TStringStream(Stream) do
 begin
     // ポストスクリプト
     WriteString('%!PS-Adobe-2.0 EPSF-1.2'#10);
     WriteString(Format('%%%%BoundingBox: 0 0 %d %d'#10,[WIdth,Height]));
     WriteString('%%Creator: Created by GraphicConvert Library'#10);
     WriteString('%%EndComments'#10);
     WriteString(Format('/width %d def'#10,[Width]));
     WriteString(Format('/height %d def'#10,[height]));
     WriteString(Format('/pixwidth %d def'#10,[Width]));
     WriteString(Format('/pixheight %d def'#10,[height]));
     WriteString('/picstr width string def'#10);
     WriteString('/TokPic {'#10);
     WriteString('gsave width height 8'#10);
     WriteString('[width 0 0 height 0 height neg]'#10);
     WriteString('{currentfile picstr readhexstring pop}'#10);
     WriteString('false 3 colorimage grestore } def'#10);
     WriteString('0 height neg translate pixwidth pixheight scale'#10);
     WriteString('TokPic'#10);

// イメージデータの書き込み
     GetMem(SrcMem,Width*2*3);
     SrcLine :=SrcMem;
     try
        for Row:=Height-1 Downto 0 do
        begin
           SrcRow :=ScanLine[Row];
           SrcCnt :=0;
           for Col:= 0 to Width-1 do
           begin
             SrcLine[SrcCnt].R :=IntToHexEx(SrcRow[Col].rgbtRed);
             SrcLine[SrcCnt].G :=IntToHexEx(SrcRow[Col].rgbtGreen);
             SrcLine[SrcCnt].B :=IntToHexEx(SrcRow[Col].rgbtBlue);
             Inc(SrcCnt);
           end;
           Stream.WriteBuffer(SrcLine[0],Width*2*3);
           Stream.Write(LF,1);
        end;
     finally
       FreeMem(SrcMem);
     end;
     WriteString('%%Trailer'#10);
 end;
end;

procedure TEPSImage.LoadFromStream(Stream: TStream);
Var
 EPS : TEPSPreview;
 {$IFDEF USETIFF}
 TIF : TTIFFImage;
 {$ENDIF}
 MemoryStream :TMemoryStream;
 MetaFile:TMetafile;
begin

ZeroMemory(@EPS,Sizeof(TEPSPreview));
 Stream.ReadBuffer(EPS,SizeOf(TEPSPreview));

if EPS.Magic <>$C6D3D0C5 then
  raise Exception.Create
          ('このファイルはEPS(プレビュー)ファイルではありません。');

// TIFFプレビュー
 if not ((EPS.TIFFPos = 0) or (EPS.TIFFSize= 0)) then
 begin

raise Exception.Create
                  ('このEPSファイルにはTIFFプレビューが含まれています。'
                   +#10#13+'読み込むためにはTIFFPack.pasが必要です。');

{$IFDEF USETIFF}
   Stream.Position:=EPS.TIFFPos;

TIF :=TTIFFImage.Create;
   MemoryStream :=TMemoryStream.Create;
   Try
     MemoryStream.CopyFrom(Stream,EPS.TIFFSize);
     MemoryStream.Position:=0;
     TIF.LoadFromStream(MemoryStream);
     Assign(TIF);
   finally
     MemoryStream.Free;
     TIF.Free;
   end;
   Exit;
  {$ENDIF}
 end;

// WMFプレビュー
 if not ((EPS.MetaFilePos = 0) or (EPS.MetaFileSize= 0)) then
 begin
    Stream.Position:=EPS.MetaFilePos;

Metafile     :=TMetaFile.Create;
    MemoryStream :=TMemoryStream.Create;
    Try
      MemoryStream.CopyFrom(Stream,EPS.MetaFileSize);
      MemoryStream.Position:=0;
      MetaFile.LoadFromStream(MemoryStream);

PixelFOrmat:=pf24bit;
      Height :=Metafile.Height;
      Width  :=Metafile.Width ;
      //メタファイルの画像をBMPへ転送
      Canvas.Draw(0,0,MetaFile);
    finally
      MemoryStream.Free;
      Metafile.Free;
    end;
   Exit;
 end;

end;

procedure TEPSImage.SaveToStream(Stream: TStream);
Var
 EPS : TEPSPreview;
 {$IFDEF USETIFF}
   TIF : TTIFFIMage;
   Size,Pos :Integer;
 {$ENDIF}
begin

ZeroMemory(@EPS,Sizeof(TEPSPreview));

if FMono then
  begin
    // グレースケール化
    Handle:=EffectGrayScaleColor(Handle);

{$IFDEF USETIFF}
    if FPreview then
    begin
       TIF :=TTIFFImage.Create;
       Try
          Stream.WriteBuffer(EPS, Sizeof(TEPSPreview));
          Stream.WriteBuffer(Dummy, 4);

// ポストスクリプトの書き込み
          Pos :=Stream.Position;
          Write8bit(Stream)   ;
          Size :=Stream.Position-  Pos;

EPS.Magic :=$C6D3D0C5;
          EPS.PostScriptPos  :=Pos;
          EPS.PostScriptSize :=Size;

// TIFFの書き込み
          Pos :=Stream.Position;
            TIF.Assign(Self);
            TIF.SaveToStream(Stream);
          Size :=Stream.Size-  Pos;

EPS.TIFFPos  := Pos;
          EPS.TIFFSize := Size;

Stream.Position:=0;
          Stream.WriteBuffer(EPS, Sizeof(TEPSPreview));
       finally
         TIF.Free;
       end;
    end
    else
    {$ENDIF}
      Write8bit(Stream)   ;
  end
  else

begin
    PixelFormat:=pf24bit;

{$IFDEF USETIFF}
    if FPreview then
    begin
       TIF :=TTIFFImage.Create;
       Try

Stream.WriteBuffer(EPS, Sizeof(TEPSPreview));
          Stream.WriteBuffer(Dummy, 4);

// ポストスクリプトの書き込み
          Pos :=Stream.Position;
            Write24bit(Stream);
          Size :=Stream.Position-  Pos;

EPS.Magic :=$C6D3D0C5;
          EPS.PostScriptPos  :=Pos;
          EPS.PostScriptSize :=Size;

// TIFFの書き込み
          Pos :=Stream.Position;
            TIF.Assign(Self);
            TIF.SaveToStream(Stream);
          Size :=Stream.Size-  Pos;

EPS.TIFFPos  := Pos;
          EPS.TIFFSize := Size;

Stream.Position:=0;
          Stream.WriteBuffer(EPS, Sizeof(TEPSPreview));
       finally
         TIF.Free;
       end;
    end
    else
    {$ENDIF}
       Write24bit(Stream)   ;
 end;

end;

end.

// -----------------------------------------------------------------------------
// EPSPack.pasの使い方(BMP2EPS)
// -----------------------------------------------------------------------------
(*
procedure TForm1.Button1Click(Sender: TObject);
Var
 EPS :TEPSImage;
begin
 EPS:=TEPSImage.Create;
 try
   EPS.Assign(Image1.Picture.bitmap);
   // カラー  false モノクロ true
   EPS.Mono :=false;
   EPS.SavetoFile('tes.eps');
 finally
   EPS.Free;
 end;
end;
// # EPSファイルの読み込み・書き込みはPaint Shop Pro(体験版)にて確認しました。
*)

←解決時は質問者本人がここをチェックしてください。

戻る