procedure Rotiere(ABitmap: TBitmap; ADirection: Integer);
{---}
const
PIXELCOUNT = 8;
{---}
function Rol(
const AByte, APositions: Byte): Byte
register;
asm
mov cl,
dl
rol al, cl
end;
{---}
function Ror(
const AByte, APositions: Byte): Byte
register;
asm
mov cl,
dl
ror al, cl
end;
{---}
function CalcByteCount(AWidth: Integer): Integer;
begin
Result := AWidth
div PIXELCOUNT;
if (AWidth
mod PIXELCOUNT) > 0
then
Inc(Result);
end;
{---}
var
y, x1, x2, yMax, i, xCount, yCount: Integer;
p1, p2, buffer: ^Byte;
v, m: Byte;
begin
{im Uhrzeigersinn drehen}
if (ADirection = 90)
or (ADirection = 180)
or (ADirection = 270)
then
begin
ABitmap.Pixelformat := pf1Bit;
xCount := CalcByteCount(ABitmap.Width);
yCount := CalcByteCount(ABitmap.Height);
GetMem(buffer, xCount * yCount * PIXELCOUNT);
try
FillChar(buffer^, xCount * yCount * PIXELCOUNT, #0);
yMax := ABitmap.Height - 1;
if ADirection = 90
then
begin
m := 1
shl (PIXELCOUNT - 1);
for y := yMax
downto 0
do
begin
p1 := ABitmap.Scanline[y];
p2 := buffer;
Inc(p2, (yMax - y)
div PIXELCOUNT);
for x1 := 0
to xCount - 1
do
begin
v := p1^;
for x2 := 0
to PIXELCOUNT - 1
do
begin
v := Rol(v, 1);
if Odd(v)
then
p2^ := p2^
or m;
Inc(p2, yCount);
end;
Inc(p1, 1);
end;
m := Ror(m, 1);
end;
ABitmap.SetSize(ABitmap.Height, ABitmap.Width);
p2 := buffer;
end
else if ADirection = 270
then
begin
m := 1
shl (PIXELCOUNT - 1);
for y := 0
to yMax
do
begin
p1 := ABitmap.Scanline[y];
Inc(P1, xCount - 1);
p2 := buffer;
Inc(p2, (y
div PIXELCOUNT));
for x1 := 0
to xCount - 1
do
begin
v := p1^;
for x2 := 0
to PIXELCOUNT - 1
do
begin
if Odd(v)
then
p2^ := p2^
or m;
v := Ror(v, 1);
Inc(p2, yCount);
end;
Dec(p1, 1);
end;
m := Ror(m, 1);
end;
ABitmap.SetSize(ABitmap.Height, ABitmap.Width);
p2 := buffer;
{Leerzeilen überspringen}
Inc(p2, yCount * ((xCount * PixelCount) - ABitmap.Height));
end
else if ADirection = 180
then
begin
p2 := buffer;
i := (ABitmap.Width
mod PIXELCOUNT);
for y := yMax
downto 0
do
begin
p1 := ABitmap.Scanline[y];
Inc(P1, xCount - 1);
if i = 0
then
v := 0
else
begin
v := p1^;
Dec(p1);
v := Rol(v, i);
end;
for x1 := 0
to xCount - 1
do
begin
m := 0;
for x2 := 0
to i - 1
do
begin
m := Rol(m, 1);
if Odd(v)
then
m := m
or 1;
v := Ror(v, 1);
end;
if (i > 0)
and (x1 = (xCount - 1))
then
v := 0
else
begin
v := p1^;
Dec(P1);
end;
for x2 := i
to PIXELCOUNT - 1
do
begin
m := Rol(m, 1);
if Odd(v)
then
m := m
or 1;
v := Ror(v, 1);
end;
p2^ := m;
Inc(p2);
end;
end;
p2 := buffer;
end
else
Exit;
{Bitmap aus dem Buffer füllen}
xCount := CalcByteCount(ABitmap.Width);
for y := 0
to ABitmap.Height - 1
do
begin
p1 := ABitmap.Scanline[y];
Move(p2^, p1^, xCount);
Inc(p2, xCount);
end;
finally
FreeMem(Buffer);
end;
end;
end;