unit DIBRead;

(*
  Device Independent Bitmap Read unit

  BMP（もしくは DIB）ファイルを、ディスクに置いたまま色情報を読み込む非ビジュアルオブジェクトです。
  一行分のバッファがあるのでそこそこスピードがあり、また大量にメモリを取りません（1オブジェクトに関して1行分）。
  ただし、圧縮ファイルとビットフィールドの画像は読めません。

  非常に大きな画像や、複数の画像を一度に操作する必要がある場合など、メモリに収まりきらないようなときに使用すると効果を発揮します。

  一行分のバッファを有効に活用するため、Y をループの外側に使い、X をループの内側に使うようにしてください。そうでない場合は、不要な
  ディスクアクセスが大量に  発生してしまいます。

  もし、ランダムポイントで読み出す必要がある場合は、PixelNoBuffer を使ってください。こちらはバッファを使わない読み込みですので、
  バッファ操作分の時間が節約できます（ディスクアクセスも抑えられます）。ただし、バッファを使う場合に比べて非常に遅い（それでも
  バッファ付きでランダムにアクセスするよりは速いです）ので、出来ればバッファを有効活用できるようにプログラムしていただければと
  思います。

*)


{$R-}

interface

uses
	SysUtils, Graphics, Windows;

type
	ECompressionError = class(Exception);		// 圧縮もしくはビットフィールドの DIB が指定されたときのエラー
	EBitmapRangeError = class(Exception);		// 横または縦が範囲外を指定したときのエラー
	EIndexColorError = class(Exception);		// 24bit カラー時にインデックスカラーの手続きなどを呼び出したときのエラー
	EPaletteRangeError = class(Exception);		// パレットのインデックスが範囲外を指定したときのエラー

	TLine = array[0..0] of byte;
	PLine = ^TLine;
	TPaletteArr = array[0..0] of TRGBQuad;
	PPaletteArr = ^TPaletteArr;

	TDIBRead = class(TObject)
		private
			{private 宣言}
			FFilePointer : File;				// 画像ファイルポインタ
			FLineByte : integer;				// 画像一行のバイト数（ダミーバイト含む）
			FBitmapWidth : integer;				// 画像横ピクセル数
			FBitmapHeight : integer;			// 画像縦ピクセル数
			FBitmapPixelBits : word;			// 1ピクセルにつき何ビット使われているか
			FPaletteCount : DWORD;				// パレット数（インデックス数）
			FPaletteTopAdress : integer;		// パレットトップアドレス
			FBitmapTopAdress : integer;			// 画像データのトップアドレス

			FLineBuf : PLine;					// 一行分のバッファ
			FBufLineNum : integer;				// 現在読み込んでいるバッファの行番号
			FPaletteList : PPaletteArr;			// 全てのパレットを保存

			FTag : integer;						// 自由に使えるタグ
	// TDIBRead プライベート手続き/関数
			procedure BufferRead(const LineNum : integer);	// ファイルからバッファへ読み込み
			function  BufXPoint(const XPoint : integer) : TRGBTriple;	// バッファ内の位置を指定して色を読み出す
			procedure SetBuf(const LineNum : integer);		// バッファ変数のチェック（FBufLineNum への write 手続き）
		public
			{public 宣言}
	// プロパティ
			property LineByte : integer read FLineByte;				// 一行のバイト数取得（リードオンリー）
			property Width : integer read FBitmapWidth;				// 画像横ピクセル数取得（リードオンリー）
			property Height : integer read FBitmapHeight;			// 画像縦ピクセル数取得（リードオンリー）
			property ColorBits : word read FBitmapPixelBits;		// 1ピクセルに何ビット使われているかを取得（リードオンリー）
			property PaletteCount : DWORD read FPaletteCount;		// パレット数（インデックス数）（リードオンリー）
			property BufferLineNum : integer read FBufLineNum write SetBuf;	// バッファに何行目のラインが読み込まれているか（もしくは読み込むか）の指定
			property Tag : integer read FTag write FTag;	// 汎用に使えるタグ
	// constructor, destructor
			constructor Create(const filename : string);		// オブジェクト作成
			destructor Destroy; override;						// オブジェクト破棄
	// 色の取得（どのカラーモードでも使用可）
			function  Pixel(const XPoint, YPoint : integer) : TRGBTriple;	// ピクセル位置の色を取得
			function  FileHeader : TBitmapFileHeader;						// BitmapFileHeader を取得
			function  InfoHeader : TBitmapInfoHeader;						// BitmapInfoHeader を取得
	// 低レベル処理用
			procedure ScanLine(const LineNum : integer; LineBuf : PLine);	// 一行分のデータを一括取得（事前に領域確保が必要）
			function  BufPoint(const position : integer) : byte;				// バッファから特定位置のバイトを読み込む
			function  PixelNoBuffer(const XPoint, YPoint : integer) : TRGBTriple;	// バッファを使わない読み込み
	// インデックスカラー（ColorBits が 1,4,8 の場合）のみ使用可能
			procedure AllPalette(ColorPal : PPaletteArr);					// 全パレット取得（事前に領域確保が必要）
			function  PixelIndex(const XPoint, YPoint : integer) : DWORD;	// ピクセル位置のインデックスを取得
			function  IndexToColor(const PaletteIndex : DWORD) : TRGBQuad;		// インデックスからパレット取得
		end;

(* -----------------------------  Generic interface part  ----------------------------------------------- *)
// 色に関する変換関数
function  TRGBTripleToTColor(const color : TRGBTriple) : TColor;
function  TColorToTRGBTriple(const color : TColor) : TRGBTriple;
function  TRGBQuadToTRGBTriple(const RGBR : TRGBQuad) : TRGBTriple;
function  RGBtoTcolor(const r, g, b : byte) : TColor;
function  RGBtoTRGBTriple(const r, g, b : byte) : TRGBTriple;

function  PixelLayer(const Base, Layer : TRGBTriple; const Alpha : byte) : TRGBTriple;
(* Base 色上に Layer 色が Alpha の透明度で乗っている時に、何色になるかを計算する。
   Alpha は 0 が透明、 255 が完全不透明を表しています。 *)


implementation

(* -----------------------------  Unit Local part  --------------------------- *)

function Ceil(const X : Extended) : integer;	// 小数点以下切り上げ
begin {Ceil}
	Result := trunc(x);
	if Result < x then
		Result := Result + 1;
end;  {Ceil}


(* -----------------------------  Imprelentation Private part  ------------------------------------------ *)


procedure TDIBRead.BufferRead(const LineNum : integer);
begin {TDIBRead.BufferRead}
	if FBufLineNum <> LineNum then begin
		Seek(FFilePointer, FBitmapTopAdress + (FBitmapHeight - 1 - LineNum) * FLineByte);
		BlockRead(FFilePointer, FLineBuf^, FLineByte);
		FBufLineNum := LineNum;
	end;
end;  {TDIBRead.BufferRead}


function TDIBRead.BufXPoint(const XPoint : integer) : TRGBTriple;
begin {TDIBRead.BufXPoint}
	result.rgbtBlue := FLineBuf^[XPoint * 3];
	result.rgbtGreen := FLineBuf^[XPoint * 3 + 1];
	result.rgbtRed := FLineBuf^[XPoint * 3 + 2];
end;  {TDIBRead.BufXPoint}


procedure TDIBRead.SetBuf(const LineNum : integer);
begin {TDIBRead.SetBuf}
	if (LineNum < 0) or (LineNum >= FBitmapHeight) then
		raise EBitmapRangeError.Create('画像の行数の範囲外です');

	BufferRead(LineNum);
end;  {TDIBRead.SetBuf}



(* -----------------------------  TDIBRead implementation part  ----------------------------------------- *)

constructor TDIBRead.Create(const filename : string);

var
	fh : TBitmapFileHeader;
	ih : TBitmapInfoHeader;

begin {TDIBRead.Create}
// ファイルのオープン
	AssignFile(FFilePointer, filename);
	FileMode := 0;
	Reset(FFilePointer, 1);

// BitmapFileHeader のデータ取得
	fh := FileHeader;
	FBitmapTopAdress := fh.bfOffBits;

// BitmapInfoHeader の各種データ取得
	ih := InfoHeader;
	FBitmapWidth := ih.biWidth;
	FBitmapHeight := ih.biHeight;
	FBitmapPixelBits := ih.biBitCount;
	FPaletteCount := ih.biClrUsed;

// 圧縮エラーチェック
	if ih.biCompression <> BI_RGB then
		raise ECompressionError.Create('圧縮もしくはビットフィールドの画像です');

// 1行のバイト数とパレットトップアドレスの設定
	FPaletteTopAdress := SizeOf(fh) + ih.biSize;
	FLineByte := Ceil(FBitmapWidth * FBitmapPixelBits div 8 / 4) * 4;

// バッファリード
	FLineBuf := AllocMem(FLineByte);
	Seek(FFilePointer, FBitmapTopAdress + (FBitmapHeight - 1) * FLineByte);
	BlockRead(FFilePointer, FLineBuf^, FLineByte);
	FBufLineNum := 0;

// パレットセット
	case FBitmapPixelBits of
		1, 4, 8 : begin
				FPaletteList := AllocMem(SizeOf(TRGBQuad) * FPaletteCount);
				Seek(FFilePointer, FPaletteTopAdress);
				BlockRead(FFilePointer, FPaletteList^, SizeOf(TRGBQuad) * FPaletteCount);
			end;
		24 : FPaletteList := nil;
    end;
end;  {TDIBRead.Create}


destructor TDIBRead.Destroy;
begin {TDIBRead.Destroy}
	CloseFile(FFilePointer);
	FreeMem(FLineBuf);
	if FPaletteList <> nil then
		FreeMem(FPaletteList);
	inherited Destroy;
end;  {TDIBRead.Destroy}


function  TDIBRead.Pixel(const XPoint, YPoint : integer) : TRGBTriple;
begin {TDIBRead.Pixel}
	if (Xpoint < 0) or (XPoint >= FBitmapWidth) or (YPoint < 0) or (YPoint >= FBitmapHeight) then
		raise EBitmapRangeError.Create('画像範囲外です');

	case FBitmapPixelBits of
    	1, 4, 8 : result := TRGBQuadToTRGBTriple(IndexToColor(PixelIndex(XPoint, YPoint)));
		24 : begin
				BufferRead(YPoint);
				result := BufXPoint(XPoint);
        	end;
	end;
end;  {TDIBRead.Pixel}


function  TDIBRead.FileHeader : TBitmapFileHeader;
begin {TDIBRead.FileHeader}
	Seek(FFilePointer, 0);
	BlockRead(FFilePointer, result, SizeOf(result));
end;  {TDIBRead.FileHeader}


function  TDIBRead.InfoHeader : TBitmapInfoHeader;
begin {TDIBRead.InfoHeader}
	Seek(FFilePointer, SizeOf(TBitmapFileHeader));
	BlockRead(FFilePointer, result, SizeOf(result));
end;  {TDIBRead.InfoHeader}


procedure TDIBRead.ScanLine(const LineNum : integer; LineBuf : PLine);
begin {TDIBRead.ScanLine}
	BufferRead(LineNum);
	Move(FLineBuf^, LineBuf^, FLineByte);
end;  {TDIBRead.ScanLine}

function  TDIBRead.BufPoint(const position : integer) : byte;
begin {TDIBRead.BufPoint}
	if (position < 0) or (position >= FLineByte) then
		raise EBitmapRangeError.Create('バッファの範囲外です');

	result := FLineBuf^[position];
end;  {TDIBRead.BufPoint}

function  TDIBRead.PixelNoBuffer(const XPoint, YPoint : integer) : TRGBTriple;

var
	ColorIndex : byte;

begin {TDIBRead.PixelNoBuffer}
	if (XPoint < 0) or (XPoint >= FBitmapWidth) or (YPoint < 0) or (YPoint >= FBitmapHeight) then
		raise EBitmapRangeError.Create('画像範囲外です');

	case FBitmapPixelBits of
		1 : begin
			Seek(FFilePointer, FBitmapTopAdress + (FBitmapHeight - 1 - YPoint) * FLineByte + XPoint div 8);
			BlockRead(FFilePointer, ColorIndex, sizeof(ColorIndex));
			result := TRGBQuadToTRGBTriple(IndexToColor(DWORD(($80 shr (XPoint mod 8) and ColorIndex) <> 0)));
		end;

		4 : begin
			Seek(FFilePointer, FBitmapTopAdress + (FBitmapHeight - 1 - YPoint) * FLineByte + XPoint div 2);
			BlockRead(FFilePointer, ColorIndex, sizeof(ColorIndex));
			if (XPoint mod 2) = 0 then
				result := TRGBQuadToTRGBTriple(IndexToColor(($F0 and ColorIndex) shr 4))
			else
				result := TRGBQuadToTRGBTriple(IndexToColor($0F and ColorIndex));
		end;

		8 : begin
			Seek(FFilePointer, FBitmapTopAdress + (FBitmapHeight - 1 - YPoint) * FLineByte + XPoint);
			BlockRead(FFilePointer, ColorIndex, sizeof(ColorIndex));
			result := TRGBQuadToTRGBTriple(IndexToColor(ColorIndex));
		end;

		24 : begin
			Seek(FFilePointer, FBitmapTopAdress + (FBitmapHeight - 1 - YPoint) * FLineByte + XPoint * 3);
			BlockRead(FFilePointer, result, sizeof(result));
		end;
	end;
end;  {TDIBRead.PixelNoBuffer}


(* -----  IndexColor 画像のみ対象ルーチン  ----- *)

procedure TDIBRead.AllPalette(ColorPal : PPaletteArr);
begin {TDIBRead.AllPalette}
	if FBitmapPixelBits = 24 then
		raise EIndexColorError.Create('フルカラー画像でインデックスは使用できません')
	else
		Move(FPaletteList^, ColorPal^, SizeOf(TRGBQuad) * FPaletteCount);
end;  {TDIBRead.AllPalette}


function  TDIBRead.PixelIndex(const XPoint, YPoint : integer) : DWORD;

var
	pix : byte;
	sp : byte;

begin {TDIBRead.PixelIndex}
	if FBitmapPixelBits = 24 then
		raise EIndexColorError.Create('フルカラー画像でインデックスは使用できません');
	if (Xpoint < 0) or (XPoint >= FBitmapWidth) or (YPoint < 0) or (YPoint >= FBitmapHeight) then
		raise EBitmapRangeError.Create('画像範囲外です');

   	BufferRead(YPoint);

	pix := FLineBuf^[XPoint * FBitmapPixelBits div 8];

	sp := XPoint mod (8 div FBitmapPixelBits);
	result := pix;
	if FBitmapPixelBits = 1 then
		result := DWORD((($80 shr sp) and pix) <> 0)
	else if FBitmapPixelBits = 4 then
		if sp = 0 then
			result := DWORD($F0 and pix) shr 4
		else
			result := DWORD($0F and pix)
end;  {TDIBRead.PixelIndex}


function  TDIBRead.IndexToColor(const PaletteIndex : DWORD) : TRGBQuad;
begin {TDIBRead.IndexToColor}
	if FBitmapPixelBits = 24 then
		raise EIndexColorError.Create('フルカラー画像でインデックスは使用できません');
	if (PaletteIndex >= FPaletteCount) then
		raise EPaletteRangeError.Create('パレットより大きい値です');

	result := FPaletteList^[PaletteIndex];
end;  {TDIBRead.IndexToColor}


(* -----------------------------  Generic implementation part  ------------------------------------------ *)

function  TRGBTripleToTColor(const color : TRGBTriple) : TColor;
begin {TRGBTripleToTColor}
	result := TColor((color.rgbtBlue shl 16) or (color.rgbtGreen shl 8) or color.rgbtRed);
end;  {TRGBTripleToTColor}


function  TColorToTRGBTriple(const color : TColor) : TRGBTriple;
begin {TColorToTRGBTriple}
	result.rgbtRed := byte(color and $FF);
	result.rgbtGreen := byte((color shr 8) and $FF);
	result.rgbtBlue := byte((color shr 16) and $FF);
end;  {TColorToTRGBTriple}


function  TRGBQuadToTRGBTriple(const RGBR : TRGBQuad) : TRGBTriple;
begin {TRGBQuadToTRGBTriple}
	result.rgbtBlue := RGBR.rgbBlue;
	result.rgbtGreen := RGBR.rgbGreen;
	result.rgbtRed := RGBR.rgbRed;
end;  {TRGBQuadToTRGBTriple}


function  RGBToTColor(const r, g, b : byte) : TColor;
begin {RGBToTColor}
	result := TColor((b shl 16) or (g shl 8) or r);
end;  {RGBToTColor}


function  RGBtoTRGBTriple(const r, g, b : byte) : TRGBTriple;
begin {RGBtoTRGBTriple}
	result.rgbtBlue := b;
	result.rgbtGreen := g;
	result.rgbtRed := r;
end;  {RGBtoTRGBTriple}


function  PixelLayer(const Base, Layer : TRGBTriple; const Alpha : byte) : TRGBTriple;

var
	AlphaLate : Extended;

begin {PixelLayer}
	if Alpha = 0 then
		result := Base
	else if Alpha = 255 then
		result := Layer
	else begin
		AlphaLate := Alpha / 255;
		result.rgbtBlue := Trunc((1 - AlphaLate) * Base.rgbtBlue + AlphaLate * Layer.rgbtBlue);
		result.rgbtGreen := Trunc((1 - AlphaLate) * Base.rgbtGreen + AlphaLate * Layer.rgbtGreen);
		result.rgbtRed := Trunc((1 - AlphaLate) * Base.rgbtRed + AlphaLate * Layer.rgbtRed);
	end;
end;  {PixelLayer}

end.