EPSの表示
EPSファイルをDelphiで表示する事は可能なのでしょうか？
可能か不可能かだけであれば、(苦労の量はともかくとして)可能でしょう。
Windowsで表示できる画像は全て表示できます。
ただし、標準でTGraphicにあたるクラスはありません。
PostScriptですので、フォントなども用意しなければなりません。
もしかしたら、
http://www.cs.wisc.edu/~ghost/
ここに利用できるDLLやフォントなどがあるかもしれません。
なければ、全て自前でコーディングすることになります。
SusieプラグインにPostScript用のものがあるようですが、未確認です。
# これも、GhostScriptが必要のようです
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(体験版)にて確認しました。
*)
| ツイート |  |