こんにちは。ｆｕｍｉｋａです。


Q0 や RGB といったフルカラーベタの画像ファイルを表示させる
ためのグラフィッククラスです。以下を Q0Bmp.pas という名前で
保存して uses に加えるだけで、TImage などに表示することが
できるようになります。汚いソースですがご参考までに。
あまりテストしてません(^^;)

-------------------- >8 キリトリ ---------------------------------------
unit Q0Bmp;

{$IFDEF VER90}
  need Delphi3 later
{$ENDIF}
{$IFDEF VER93}
  need C++Builder3 later
{$ENDIF}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, 
Dialogs;

type
  TQ0Bitmap = class(TBitmap)
  public
    procedure LoadFromFile(const FileName: string); override;
  end;

procedure Register;

implementation

{  TQ0Bitmap  }

procedure TQ0Bitmap.LoadFromFile(const FileName: string);
var
  Ext, InfoFileName, S, SizeStr: string;
  SL: TStringList;
  Stream1, Stream2: TMemoryStream;
  BFH: TBitmapFileHeader;
  BIH: TBitmapInfoHeader;
  Buff: array[1..3] of Byte;
  BX, FW, FH: LongInt;
  X, Y: Integer;
begin
  try
    Ext := AnsiLowerCase(ExtractFileExt(FileName));
    // 拡張子が .Q0 のファイルの場合、 .FAL ファイルに
    // 画像のサイズが格納されている(らしい)。
    if Ext = '.q0' then begin
      InfoFileName := ChangeFileExt(FileName, '.fal');
      if not FileExists(InfoFileName) then
        raise Exception.Create('FAL ファイルが見つかりません');
      SL := TStringList.Create;
      try
        SL.LoadFromFile(InfoFileName);
        if Copy(SL[0], 0 ,5) <> 'F_ALL' then begin
          MessageBeep(MB_ICONHAND);
          MessageDlg('FAL ファイルが不正です', mtError, [mbOk], 0);
          Exit;
        end;
        SizeStr := SL[1];
      finally
        SL.Free;
      end;
    end else
    // 拡張子が .RGB のファイルの場合、 .IPR ファイルに
    // 画像のサイズが格納されている(らしい)。
    if Ext = '.rgb' then begin
      InfoFileName := ChangeFileExt(FileName, '.ipr');
      if not FileExists(InfoFileName) then
        raise Exception.Create('IPR ファイルがありません');
      SL := TStringList.Create;
      try
        SL.LoadFromFile(InfoFileName);
        SizeStr := SL.Text;
      finally
        SL.Free;
      end;
    end;
    // .FAL or .IPR ファイルから読みとった文字列から、
    // 画像の幅、高さを切り出す。
    SizeStr := TrimLeft(SizeStr);
    S  := Copy(SizeStr, 0, Pos(' ', SizeStr) - 1);
    FW := StrToIntDef(S, 0);
    SizeStr := TrimLeft(Copy(SizeStr, Length(S) + 1, 
                             Length(SizeStr)-Length(S)));
    FH := StrToIntDef(Copy(SizeStr, 0, Pos(' ', SizeStr) - 1), 0);
  except
    FW := 0;
    FH := 0;
  end;

  // DIB データ作成用ストリームの作成
  Stream1 := TMemoryStream.Create;
  try
    // BITMAPINFOHEADER の作成
    BIH.biSize := SizeOf(TBitmapInfoHeader);
    BIH.biWidth  := FW;
    BIH.biHeight := FH;
    BIH.biPlanes := 1;
    BIH.biBitCount := 24;
    BIH.biCompression := BI_RGB;
    BIH.biClrUsed := 0;
    BIH.biClrImportant := 0;
    BX := ((LongInt(BIH.biWidth) * BIH.biBitCount + 31) div 32) * 4;
    BIH.biSizeImage := BX * BIH.biHeight;

    // ビットデータ読み込み用ストリームの作成
    Stream2 := TMemoryStream.Create;
    try
      Stream2.LoadFromFile(FileName);

      // 幅、高さが 0 の場合、ここでファイルサイズから
      // 適当に割り出す。
      if BIH.biSizeImage = 0 then begin
        BIH.biSizeImage := Stream2.Size;// div 3;
        if (BIH.biWidth = 0) and (BIH.biHeight = 0) then begin
          if BIH.biSizeImage div 3 = 256000 then begin
            BIH.biHeight := 400;
            BIH.biWidth  := 640;
          end else begin
            BIH.biHeight := (BIH.biSizeImage div 3) div 640;
            BIH.biWidth  := 640;
          end;
          BX := ((LongInt(BIH.biWidth) * BIH.biBitCount + 31) div 32) * 4;
        end else begin
          if BIH.biHeight <> 0 then
            BIH.biWidth  := Longint(BIH.biSizeImage) div BIH.biHeight
          else
            BIH.biHeight := Longint(BIH.biSizeImage) div BIH.biWidth;
        end;
      end;

      // BITMAPFILEHEADER の作成
      BFH.bfType := $4D42;
      BFH.bfSize := (SizeOf(TBitmapFileHeader)
                  + SizeOf(TBItmapInfoHeader)
                  + Stream2.Size) div 4;
      BFH.bfReserved1 := 0;
      BFH.bfReserved2 := 0;
      BFH.bfOffBits  := SizeOf(TBitmapFileHeader) + SizeOf(TBItmapInfoHeader);

      // BITMAPFILEHEADER の書き込み
      Stream1.Write(BFH, SizeOf(TBitmapFileHeader));

      // BITMAPINFOHEADER の書き込み
      Stream1.Write(BIH, SizeOf(TBitmapInfoHeader));

      for Y := 0 to BIH.biHeight - 1  do begin
        // Bitmap はボトムアップなのでデータはファイルの後ろの
        // 方から読み出す。
        Stream2.Seek(-BX * Y, soFromEnd);
        for X := 0 to (BIH.biWidth - 1) do begin
          // フルカラーベタファイルは RGB 順、Bitmap は BGR 順なので
          // 書き換えながらビットデータを作成。
          Stream2.Read(Buff, 3);
          Stream1.Write(Buff[3], 1);
          Stream1.Write(Buff[2], 1);
          Stream1.Write(Buff[1], 1);
        end;
      end;
    finally
      Stream2.Free;
    end;

    Stream1.Position := 0;
    inherited LoadFromStream(Stream1);
  finally
    Stream1.Free;
  end;
end;

{  初期化部  }

procedure Register;
begin
  // 何もしないが設計時に使われるために削除しないこと
end;

initialization
  TPicture.RegisterFileFormat('q0', 'フルカラーベタ', TQ0Bitmap);
  TPicture.RegisterFileFormat('rgb', 'フルカラーベタ', TQ0Bitmap);

finalization
  TPicture.UnregisterGraphicClass(TQ0Bitmap);

end.
-------------------- >8 キリトリ ---------------------------------------


　　　　平成10年12月2日(水)　　ｆｕｍｉｋａ(YRK00111@nifty.ne.jp)
　　       ★☆★　http://www2m.biglobe.ne.jp/~fumika/　★☆★

Original document by ｆｕｍｉｋａ    氏 ID:(YRK00111)

ここにあるドキュメントは NIFTY SERVEの Delphi Users' Forum の16番会議室「玉石混淆みんなで作るSample蔵」に投稿されたサンプルです。これらのサンプルはボーランド株式会社がサポートする公式のものではありません。また、必ずしも動作が検証されているものではありません。これらのサンプルを使用したことに起因するいかなる損害も投稿者、およびフォーラムスタッフはその責めを負いません。使用者のリスクの範疇でご使用下さい。