const
MASKE1 = $FE;
MASKE2 = $01;
procedure Encode(ABitmap: TBitmap;
const AText: AnsiString);
var
m, mMax, x, xMax, y, yMax, g: Integer;
a, v: Longword;
P: PByteArray;
begin
mmax := Length(AText);
m := 0;
{die ersten 32 Bit enthalten die Länge des Textes}
v := mmax;
g := 32;
{richtiges Pixelformat sicherstellen}
ABitmap.Pixelformat := pf24Bit;
xMax := ABitmap.Width - 1;
yMax := ABitmap.Height - 1;
try
for y := 0
to yMax
do
begin
P := ABitmap.ScanLine[y];
for x := 0
to xMax * 3
do
begin
{nächstes Byte holen}
if g = 0
then
begin
Inc(m);
if m > mmax
then
Exit;
v := Ord(AText[m]);
g := 8;
end;
{nächstes Bit auswählen}
Dec(g);
a := v
shr g;
P[x] := (P[x]
and MASKE1)
or (a
and MASKE2);
end;
end;
finally
ABitmap.Modified := True;
end;
end;
function Decode(ABitmap: TBitmap): AnsiString;
var
x, xMax, y, yMax, m, mMax, g: Integer;
a, v: Byte;
P: PByteArray;
begin
Result := '
';
if ABitmap.Pixelformat <> pf24Bit
then
Exit;
xMax := ABitmap.Width;
yMax := ABitmap.Height;
mMax := (xMax * yMax * 3)
div 8;
if mMax < 4
then
Exit;
SetLength(Result, mmax);
Dec(xMax);
Dec(yMax);
v := 0;
g := 0;
m := 0;
for y := 0
to yMax
do
begin
P := ABitmap.ScanLine[y];
for x := 0
to xMax * 3
do
begin
a := P[x]
and Maske2;
v := (v
shl 1)
or a;
Inc(g);
{nächstes Byte}
if g = 8
then
begin
Inc(m);
Result[m] := AnsiChar(v);
v := 0;
g := 0;
end;
end;
end;
{Die ersten 4 Zeichen enthalten die tatsächliche Länge des Textes.}
mMax := 0;
for m := 1
to 4
do
mMax := (mMax
shl 8) + Byte(Result[m]);
Result := Copy(Result, 5, mMax);
end;