Macintosh PICTファイルを変換する(Delphi)
Macintosh PICTファイルを読み込む事のできるDelphiのソースコードです。クラスになっていますのでそのまま使用できます。
ソースコード
10年以上前に作成した古いコードで私すら覚えていないのですが、何かのお役に立てると嬉しいです。
//Macintosh PICT File I/O Class // //Load 1,4,8,24,32bit PackBits圧縮 //Save none // // # フォーマットはバージョン2に対応しています。 // # ラスター形式のみに対応。ベクタ形式には対応していません。 // # 無圧縮とPICT-JPEG圧縮(?)のファイルは試験データがないので対応していません。 unit PictPack; interface uses Windows,Messages,SysUtils,Classes,Graphics; { ファイルヘッダ 512byte TPictFileHeader(18byte) TPictNextFileHeader or TPictNext2FileHeader(18byte) 以下 オプコードが続く } { color table [2バイト:パレット番号0] [6バイト:パレットデータ(RGB順)] ・ ・ パレットサイズぶんだけ続く } //18byte Type TPictFileHeader =packed record DataSize : Word; // 「最終データサイズ - 512」の演算結果の下位2バイトが格納 Top,Left : Word; // サイズ Height,Width : WOrd; // サイズ VersionOpCode : Word; // バージョンオプコード(0011H) VersionNumver : Word; // バージョン番号(02FFH) VersionOp2Code : Word; // バージョン2オプコード NextFlag : Word; // 次に続くフラグ ($FFFE->TPictNextFileHeader $FFFF->TPictNext2FileHeader) end; // 22bytye Type TPictNextFileHeader =packed record Reserve1 : Word; // 予約(ゼロ) HScroll : Dword; // 水平解像度 VScroll : Dword; // 垂直解像度 Top,Left, Bottom,Right: Word; // 72dpiの時の矩形サイズ Reserve2 : Dword; // 予約(ゼロ) end; // 22byte type TPictNext2FileHeader =packed record KeyWord : Word; // $FFFF Top,Left, Bottom,Right : DWord; // 固定小数点での矩形サイズ Reserve : Dword; // 予約 end; // 46byte type TPictBitsHeader =packed record rowbytes : Word; // 横方向の実際に必要なバイト数 Top,Left, Bottom,Right : Word; // 座標 packType : Word; // 圧縮タイプ 0? version : Word; // バージョン 0? packSize : DWord; // パックサイズ 0? HScroll : Dword; // 水平解像度 VScroll : Dword; // 垂直解像度 pixelType : Word; // ピクセルタイプ pixelSize : Word; // ピクセルサイズ 1ピクセルあたりのビット数(4ビット=16色) cmpCount : Word; // 次のピクセルまでのバイトオフセット cmpSize : Word; // コンポーネントサイズ(1,2,4,8,16,32ビット)? planeBytes : Dword; // 次のカラープレーンまでのオフセット(0) pmTable : Dword; // 反転 pmReserved : Dword; // 予約 end; type TPictColorTable =packed record ctSeed : Dword; // カラーテーブル識別番号(存在しない場合は0) ctFlags : Word; // パレットフラグ ctSize : Word; // パレットデータ数 end; // 18byte type TPictBits2Header=packed record Top,Left, Bottom,Right : Word; // 元解像度での座標 Left2,Top2, Right2,Bottom2 : Word; // 72dpiでの座標 DrawFlag : Word; // 転送フラグ end; type TPICTImage = class(TBitmap) private procedure Decoder(Stream: TStream;PictBitsHeader :TPictBitsHeader) ; procedure CreatePaletteV(Stream :TSTream;PalCnt : integer); public procedure LoadFromStream(Stream: TStream); override; procedure SaveToStream(Stream: TStream); override; end; type TRGB =packed record R,G,B : Byte; end; type TRGBA =packed record R,G,B,A : Byte; end; type pRGBColor = ^TRGBColor; TRGBColor = array[0..0] of TRGB; type pRGBAColor = ^TRGBAColor; TRGBAColor = array[0..0] of TRGBA; implementation /////////////////////////////////////////////////////////////////////////////// //////// バイトオーダー word編 function IntelOder_word(Buffer :word):word; begin Result :=(Buffer AND $00FF) shl 8 ; Result :=Result+(Buffer AND $FF00) shr 8 ; end; //////// インテルオーダー Dword編 function IntelOder_Dword(Buffer :Dword):Dword; begin Result :=(Buffer AND $000000FF) shl 24 ; Result :=Result or ((Buffer AND $0000FF00) shl 8) ; Result :=Result or ((Buffer AND $00FF0000) shr 8) ; Result :=Result or ((Buffer AND $FF000000) shr 24) ; end; //////// function GetMacLineWidth(BitCount,Width : WORD):DWORD; Var Dummy :DWORD; begin // PICTの1ラインの幅を取得 case BitCount of 1 : Dummy :=((Width + 7) div 8) ; 4 : Dummy :=((Width + 1) div 2) ; 8 : Dummy :=Width; 24 : Dummy :=Width*3 else Dummy :=Width*4; end; Result :=Dummy; end; //////// procedure UnPackedBits(var Source,Dest:Pointer;CompressSize: Integer; rowBytes :Integer); Var PackCount,PackCountW : Integer; RunCode : Byte; RunLength : Byte; RunData : Byte; SourceRow : PByte; DestRow : PByteArray; DestCnt : Dword; begin SourceRow :=PByte(Source); DestRow :=PByteArray(Dest) ; DestCnt:=0; if rowBytes > 250 then begin while True do begin // 1ラインのパック数を取得 PackCountW :=SourceRow^ shl 8; inc(SourceRow); PackCountW :=PackCountW or SourceRow^; inc(SourceRow); Dec(CompressSize,2); while True do begin // ランコードを取得 RunCode:= SourceRow^; inc(SourceRow); Dec(CompressSize); Dec(PackCountW); // 連続ピクセル if RunCode>=128 then begin // 連続回数を取得 RunLength:=256-RunCode+1; RunData:= SourceRow^; inc(SourceRow); Dec(CompressSize); Dec(PackCountW); if Dword(rowBytes) < DestCnt+ RunLength then raise Exception.Create('PackBits圧縮を展開できません。'); // 連続データを格納 FillChar(DestRow[DestCnt],RunLength,RunData); inc(DestCnt,RunLength); end else begin // 非連続データ回数を取得(N+1) RunLength := RunCode+1; if Dword(rowBytes) < DestCnt+ RunLength then raise Exception.Create('PackBits圧縮を展開できません。'); // 非連続データを格納 Move(SourceRow^,DestRow[DestCnt],RunLength); inc(SourceRow,RunLength); inc(DestCnt,RunLength); Dec(CompressSize,RunLength); Dec(PackCountW,RunLength); end; if PackCountW<=0 then break; end; if CompressSize<=0 then break; end; end else begin while True do begin // 1ラインのパック数を取得 PackCount :=SourceRow^; inc(SourceRow); Dec(CompressSize); while True do begin // ランコードを取得 RunCode:= SourceRow^; inc(SourceRow); Dec(CompressSize); Dec(PackCount); // 連続ピクセル if RunCode>=128 then begin // 連続回数を取得 RunLength:=256-RunCode+1; RunData:= SourceRow^; inc(SourceRow); Dec(CompressSize); Dec(PackCount); if Dword(rowBytes) < DestCnt+ RunLength then raise Exception.Create('PackBits圧縮を展開できません。'); // 連続データを格納 FillChar(DestRow[DestCnt],RunLength,RunData); inc(DestCnt,RunLength); end else begin // 非連続データ回数を取得(N+1) RunLength := RunCode+1; if Dword(rowBytes) < DestCnt+ RunLength then raise Exception.Create('PackBits圧縮を展開できません。'); // 非連続データを格納 Move(SourceRow^,DestRow[DestCnt],RunLength); inc(SourceRow,RunLength); inc(DestCnt,RunLength); Dec(CompressSize,RunLength); Dec(PackCount,RunLength); end; if PackCount<=0 then break; end; if CompressSize<=0 then break; end; end; end; /////////////////////////////////////////////////////////////////////////////// ///////// procedure TPICTImage.Decoder(Stream: TStream;PictBitsHeader :TPictBitsHeader) ; Var PackCount : Byte; PackCountW : Word; i,j : integer; Source,Dest : Pointer; pRGB : pRGBColor; SrcLines : pByteArray; begin Source:=nil; Dest:=nil; try GetMem(Dest,PictBitsHeader.rowbytes); if PictBitsHeader.rowbytes <=250 then begin for i:= 0 to Self.Height -1 do begin // パックサイズを取得 Stream.ReadBuffer(PackCount,1); Stream.Position:=Stream.Position-1; GetMem(Source,PackCount+1); Stream.ReadBuffer(Source^,PackCount+1) ; UnPackedBits(Source,Dest,PackCount+1,PictBitsHeader.rowbytes); if PixelFormat in [pf1bit,pf4bit,pf8bit] then Move(Dest^,ScanLine[i]^,PictBitsHeader.rowbytes) else begin pRGB :=Self.ScanLine[i]; SrcLines :=(Dest); for j:=0 to Self.Width -1 do begin pRGB[j].B :=SrcLines[j]; pRGB[j].G :=SrcLines[Self.Width+j]; pRGB[j].R :=SrcLines[Self.Width*2+j]; end; end; FreeMem(Source); end; end else begin for i:= 0 to Self.Height -1 do begin // パックサイズを取得 Stream.ReadBuffer(PackCountW,2); PackCountW:=IntelOder_word(PackCountW); Stream.Position:=Stream.Position-2; GetMem(Source,PackCountW+2); Stream.ReadBuffer(Source^,PackCountW+2) ; UnPackedBits(Source,Dest,PackCountW+2,PictBitsHeader.rowbytes); if PictBitsHeader.pixelSize in [1,4,8,16] then Move(Dest^,ScanLine[i]^,PictBitsHeader.rowbytes) else begin pRGB :=Self.ScanLine[i]; SrcLines :=(Dest); for j:=0 to Self.Width -1 do begin pRGB[j].B :=SrcLines[j]; pRGB[j].G :=SrcLines[Self.Width+j]; pRGB[j].R :=SrcLines[Self.Width*2+j]; end; end; FreeMem(Source); end; end; Source :=nil; finally if Assigned(Source) then Freemem(Source); if Assigned(Dest) then Freemem(Dest); end; end; ///////// procedure TPICTImage.CreatePaletteV(Stream :TSTream;PalCnt : integer); var i: Integer; LogPalette: TMaxLogPalette; PaletteMem : Pointer; PaleteRow : Pword; begin FillChar(LogPalette, SizeOf(LogPalette), 0); LogPalette.palVersion := $300; GetMem(PaletteMem,PalCnt*8); Try Stream.ReadBuffer(PaletteMem^,PalCnt*8); PaleteRow:=PWord( PaletteMem); LogPalette.palNumEntries := PalCnt; for i := 0 to PalCnt-1 do begin inc(PaleteRow); LogPalette.palPalEntry[i].peRed := (PaleteRow^ and $00FF) ; inc(PaleteRow); LogPalette.palPalEntry[i].peGreen := (PaleteRow^ and $00FF) ; inc(PaleteRow); LogPalette.palPalEntry[i].peBlue := (PaleteRow^ and $00FF) ; inc(PaleteRow); end; Palette := CreatePalette(PLogPalette(@LogPalette)^); finally FreeMem(PaletteMem); end; end; //////// procedure TPICTImage.LoadFromStream(Stream: TStream); Var DataLengthB : Byte; OpCode,DataLength : Word; DataLengthW,FileSize: Dword; PictFileHeader : TPictFileHeader; PictNextFileHeader : TPictNextFileHeader; PictBitsHeader :TPictBitsHeader; PictColorTable :TPictColorTable; PictBits2Header :TPictBits2Header; begin ZeroMemory(@PictFileHeader,SizeOf(TPictFileHeader)); ZeroMemory(@PictNextFileHeader,SizeOf(TPictNextFileHeader)); ZeroMemory(@PictBitsHeader,SizeOf(TPictBitsHeader)); ZeroMemory(@PictColorTable,SizeOf(TPictColorTable)); ZeroMemory(@PictBits2Header,SizeOf(TPictBits2Header)); // マックバイナリ512byteをスキップ Stream.Position := Stream.Position+512; // PICTファイルヘッダの読み込み Stream.ReadBuffer(PictFileHeader,SizeOf(TPictFileHeader)); PictFileHeader.Width :=IntelOder_word( PictFileHeader.Width); PictFileHeader.Height :=IntelOder_word( PictFileHeader.Height); PictFileHeader.VersionNumver :=IntelOder_word( PictFileHeader.VersionNumver); if PictFileHeader.VersionNumver <> $02FF then raise Exception.Create('フォーマットバージョンが2でありません。'); // PICTファイルネクストヘッダの読み込み Stream.ReadBuffer(PictNextFileHeader,SizeOf(TPictNextFileHeader)); FileSize:= Stream.Size; While True do begin // オプコードの読み込み Stream.ReadBuffer(OpCode,2); OpCode:=IntelOder_word(OpCode); if (Stream.Position<0) or (Dword(Stream.Position)>=FileSize)then Break; case OpCode of // 0Byte Data(未定義) $0000,$001C,$001E,$0017..$0019, $0038..$003F,$0048..$004F,$0058..$005F,$0078..$007F,$0088..$008F, $00B0..$00CF,$8000..$80FF : ; // 1Byte Data $0004,$0011 :Stream.Position:=Stream.Position+1; // 2Byte Data $0003,$0005,$0008,$000D,$0015,$0016,$0023,$00A0 , $0100..$01FF : Stream.Position:=Stream.Position+2; // 4Byte Data $0006,$0007,$000B,$000C,$000E,$000F,$0021, $0068..$006F,$0200 : Stream.Position:=Stream.Position+4; // 6Byte Data $001A,$001B,$001D,$001F,$0022 : Stream.Position:=Stream.Position+6; // 8Byte Data $0002,$0009,$000A,$0010,$0020,$002E, $0030..$0037,$0040..$0047,$0050..$0057 : Stream.Position:=Stream.Position+8; // 10Byte Data $002D : Stream.Position:=Stream.Position+10; // 12Byte Data $0060,$0067 : Stream.Position:=Stream.Position+12; // 22Byte Data $0BFF : Stream.Position:=Stream.Position+22; // 24Byte Data $0C00..$7EFF : Stream.Position:=Stream.Position+24; // 254Byte Data $7F00..$7FFF : Stream.Position:=Stream.Position+254; // 2 + data length $0024..$0027,$002F,$0092..$0097,$009C..$009F,$00A2..$00AF : begin Stream.ReadBuffer(DataLength,2); DataLength:=IntelOder_word(DataLength); Stream.Position:=Stream.Position+DataLength; end; // 4 + data length $00D0..$00FE,$8100..$81FF,$FFFF : begin Stream.ReadBuffer(DataLengthW,4); DataLengthW:=IntelOder_Dword(DataLengthW); Stream.Position:=Dword(Stream.Position)+DataLengthW; end; // Region size $0001,$0080,$0087 : begin // クリップ領域 Stream.ReadBuffer(DataLength,2); DataLength:=IntelOder_word(DataLength); Stream.Position:=Stream.Position+DataLength-2; end; // Polygon size $0070..$0077 : begin // クリップ領域 Stream.Read(DataLength,2); DataLength:=IntelOder_word(DataLength); Stream.Position:=Stream.Position+DataLength; end; // $0028 : begin Stream.Position:=Stream.Position+4; Stream.ReadBuffer(DataLengthB,1); Stream.Position:=Stream.Position+DataLengthB; end; // $0029,$002A : begin Stream.Position:=Stream.Position+1; Stream.ReadBuffer(DataLengthB,1); Stream.Position:=Stream.Position+DataLengthB; end; // $002B : begin Stream.Position:=Stream.Position+2; Stream.ReadBuffer(DataLengthB,1); Stream.Position:=Stream.Position+DataLengthB; end; // $002C : begin Stream.Position:=Stream.Position+4; Stream.ReadBuffer(DataLengthB,1); Stream.Position:=Stream.Position+DataLengthB; end; // JPEG??? $8200,$8201 : begin Stream.ReadBuffer(DataLengthW,4); DataLengthW:=IntelOder_Dword(DataLengthW); Stream.Position:=Dword(Stream.Position)+DataLengthW; end; // コメント $00A1 : begin Stream.Position:=Stream.Position+2; Stream.ReadBuffer(DataLength,2); DataLength:=IntelOder_word(DataLength); Stream.Position:=Stream.Position+DataLength; end; // ビットマップデータ $0090,$0091,$0098,$0099,$009A,$009B : begin //16bit以上ならばここに4byte入る if opcode in [$009A,$009B] then Stream.Position:=Stream.Position+4; Stream.ReadBuffer(PictBitsHeader,SizeOf(TPictBitsHeader)); With PictBitsHeader do begin rowbytes :=IntelOder_word(rowbytes); Left :=IntelOder_word(Left); Top :=IntelOder_word(Top); Right :=IntelOder_word(Right); Bottom :=IntelOder_word(Bottom); packType :=IntelOder_word(packType); version :=IntelOder_word(version); pixelType :=IntelOder_word(pixelType); pixelSize :=IntelOder_word(pixelSize); cmpCount :=IntelOder_word(cmpCount); cmpSize :=IntelOder_word(cmpSize); packSize :=IntelOder_Dword(packSize); VScroll :=IntelOder_Dword(VScroll); HScroll :=IntelOder_Dword(HScroll) ; planeBytes:=IntelOder_Dword(planeBytes); pmTable :=IntelOder_Dword(pmTable); cmpSize :=IntelOder_Dword(cmpSize) ; end; if not (PictBitsHeader.pixelSize in [1,4,8,24,32]) then raise Exception.Create('1,4,8,24,32bit以外のイメージには対応していません。'); case PictBitsHeader.pixelSize of 1 : Self.PixelFormat:=pf1bit; 2..4 : begin Self.PixelFormat:=pf4bit; PictBitsHeader.pixelSize:=4; end; 5..8 : begin Self.PixelFormat:=pf8bit; PictBitsHeader.pixelSize:=8; end; 16 : Self.PixelFormat:=pf15bit; 24,32 : Self.PixelFormat:=pf24bit; end; // パレット付きの場合 if PictBitsHeader.pixelSize in [1,2,4,8] then begin Stream.position:=Stream.position; Stream.ReadBuffer(PictColorTable,SizeOf(TPictColorTable)); PictColorTable.ctSize:=IntelOder_word(PictColorTable.ctSize); CreatePaletteV(Stream,PictColorTable.ctSize+1); end; // ゴミを取る if (PictBitsHeader.rowBytes and $8000) <>0 then PictBitsHeader.rowBytes :=PictBitsHeader.rowBytes xor $8000; // もう一つのヘッダをとる Stream.ReadBuffer(PictBits2Header,SizeOf(TPictBits2Header)); // リージョンならばリージョンサイズ(10byte)が入る if opcode in [$0091,$0099,$009B] then Stream.position:=Stream.position+10; Stream.position:=Stream.position; Self.Width := PictBitsHeader.Right-PictBitsHeader.Left; Self.Height := PictBitsHeader.Bottom-PictBitsHeader.Top; // 無圧縮の場合 if( OpCode in [$0090,$0091]) then begin // end else begin Decoder(Stream,PictBitsHeader); end; break; end; // カラーパレット??? $0012..$0014 : begin raise Exception.Create('対応していないオプコードです。'); end; // 終端 $00FF : break; end; end; end; ///////// procedure TPICTImage.SaveToStream(Stream: TStream); begin // none end; end.
スポンサーリンク
関連記事
公開日:2015年01月07日 最終更新日:2015年02月18日
記事NO:00084