unit PortableBitmap;
interface
uses Classes, SysUtils;
const
WhiteChars = [#9, #10, #13, #32];
type
TPortableBitmap =
class
private
FWidth, FHeight: Integer;
FData: TBytes;
function ConvertTo8Bit(
const Data: TBytes; WidthBytes: Cardinal): TBytes;
public
procedure LoadFromFile(Filename:
string);
property Data: TBytes
read FData;
property Height: Integer
read FHeight;
property Width: Integer
read FWidth;
end;
TPBMReader =
class helper
for TStream
public
function ReadString:
string;
function ReadInt: Integer;
end;
implementation
{ TPBMReader }
function TPBMReader.ReadInt: Integer;
begin
Result := StrToInt(ReadString);
end;
function TPBMReader.ReadString:
string;
var
C: AnsiChar;
begin
repeat
Read(C, 1);
if not (C
in WhiteChars)
then
Result := Result + Char(C);
until (Position >= Size - 1)
or (C
in WhiteChars);
while C
in WhiteChars
do
Read(C, 1);
Position := Position - 1;
end;
{ TPortableBitmap }
procedure TPortableBitmap.LoadFromFile(Filename:
string);
var
ScanLineSize, MonoSize: Cardinal;
MonoData: TBytes;
FS: TFileStream;
begin
FS := TFileStream.Create(Filename, fmOpenRead);
try
if FS.ReadString[2] <> '
4'
then
raise Exception.Create('
Kein kompatibles PortableBitmap Bild:' + sLineBreak + Filename);
FWidth := FS.ReadInt;
FHeight := FS.ReadInt;
if (FHeight < 1)
or (FWidth < 1)
then
raise Exception.Create('
Höhe/Breite des Bildes ungültig!');
ScanLineSize := (FWidth + 7)
div 8;
MonoSize := ScanLineSize * FHeight;
if MonoSize > FS.Size - FS.Position
then
MonoSize := FS.Size - FS.Position;
SetLength(MonoData, MonoSize);
FS.
Read(MonoData[0], MonoSize);
FData := ConvertTo8Bit(MonoData, ScanLineSize);
finally
FS.Free;
end;
end;
function TPortableBitmap.ConvertTo8Bit(
const Data: TBytes; WidthBytes: Cardinal): TBytes;
const
Mask:
array[0..7]
of Byte = ($80, $40, $20, $10, $08, $04, $02, $01);
Shift:
array[0..7]
of Byte = (7, 6, 5, 4, 3, 2, 1, 0);
var
X, Y, I: Integer;
begin
SetLength(Result, FWidth * FHeight);
for Y := 0
to FHeight - 1
do
for X := 0
to FWidth - 1
do
Result[Y * FWidth + X] :=
(Data[Y * WidthBytes + X
shr 3]
and Mask[X
and 7])
shr Shift[X
and 7];
for I := 0
to FWidth * FHeight - 1
do
Result[I] := 255 - Result[I] * 255;
end;
end.