ホーム > カテゴリ > フォーマット変換 >

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