//------------------------------------------------------------------------------
//■関数名  BMPToPSD
//■用途    BMP->PSD変換
//■引数
//          BMP          ...TBitmapオブジェクト
//          SaveFileName ...PSDのファイル名
//------------------------------------------------------------------------------
procedure BMPToPSD(BMP:TBitmap;SaveFileName: String);
  type
   PRGBColor = ^TRGBColor;
   TRGBColor = array[0..32768-1] of TRGBTriple;
  type
    TPSDHeader = packed record
      Signature : array[0..3] of Char;
      Version   : Word;
      Reserved  : array[0..5] of Byte;
      Channels  : Word;
      Rows      : DWord;
      Columns   : DWord;
      Depth     : Word;
      Mode      : Word;
  end;

  function IntelOder_word(Buffer :word):word;
  begin
   Result :=(Buffer AND $00FF) shl 8 ;
   Result :=Result+(Buffer AND $FF00) shr 8  ;
  end;

  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;

Var
 PSD      : TPSDHeader ;
 Section  : Integer;
 Compress : Word;
 Stream   : TMemoryStream;
 Row,COl  : Integer;
 SrcRow   : PRGBColor;
 Buffer   : Pointer;
 Lines    : PBYTE;
begin

 if BMP.Empty then raise Exception.Create('TBitmapオブジェクトにイメージが入っていないよ。');
 if BMP.Pixelformat<>pf24bit then BMP.Pixelformat:=pf24bit;

 Stream:=TMemoryStream.Create;

 ZeroMemory(@PSD,sizeof(TPSDHeader));
 Section       :=0;

 //ヘッダー構築
 PSD.Signature :='8BPS';
 PSD.Version   :=IntelOder_word(1);
 PSD.Rows      :=IntelOder_Dword(BMP.Height);
 PSD.Columns   :=IntelOder_Dword(BMP.Width);
 PSD.Depth     :=IntelOder_word(8) ;
 PSD.Channels  :=IntelOder_word(3);
 PSD.Mode:=IntelOder_word(3);

 Stream.write(PSD,sizeof(TPSDHeader));

 //モードデータなし
 Stream.write(Section,4);
 //イメージリソースなし
 Stream.write(Section,4);
 //リザーブデータなし
 Stream.write(Section,4);
 //無圧縮
 Compress:=0;
 Stream.write(Compress,2);

 //RRR GGG BBB で保存
 GetMem(Buffer,BMP.Width*BMP.Height);
 try
   Lines:=Buffer;
   //RRR
   for Row := 0 to BMP.Height - 1 do
   begin
     SrcRow:=  BMP.ScanLine[Row];
     for Col:= 0 to  BMP.Width -1 do
     begin
       Lines^:=SrcRow[Col].rgbtRed;
       inc(Lines);
     end;
   end;
   Dec(Lines,BMP.Width*BMP.Height);
   Stream.Write(Lines^,BMP.Width*BMP.Height);
 finally
  FreeMem(Buffer);
 end;

 //BBB
 GetMem(Buffer,BMP.Width*BMP.Height);
 try
   Lines:=Buffer;
   for Row := 0 to BMP.Height - 1 do
   begin
    SrcRow:=  BMP.ScanLine[Row];
    for Col:= 0 to  BMP.Width -1 do
    begin
      Lines^:=SrcRow[Col].rgbtGreen;
      inc(Lines);
    end;
   end;
   Dec(Lines,BMP.Width*BMP.Height);
   Stream.Write(Lines^,BMP.Width*BMP.Height);
 finally
  FreeMem(BUffer);
 end;

 //GGG
 GetMem(Buffer,BMP.Width*BMP.Height);

 try
   Lines:=Buffer;
   for Row := 0 to BMP.Height - 1 do
   begin
     SrcRow:=  BMP.ScanLine[Row];
     for Col:= 0 to  BMP.Width -1 do
     begin
      Lines^:=SrcRow[Col].rgbtBlue;
      inc(Lines);
    end;
   end;
   Dec(Lines,BMP.Width*BMP.Height);
   Stream.Write(Lines^,BMP.Width*BMP.Height);
 finally
  FreeMem(Buffer);
 end;

 Stream.SavetoFile(SaveFileName);
 Stream.free;
end;