procedure RotateBitmap90l(var ABitmap: TBitmap);
const
BitsPerByte = 8;

var
PbmpInfoR: PBitmapInfoHeader;
bmpBuffer, bmpBufferR: PByte;
MemoryStream, MemoryStreamR: TMemoryStream;
PbmpBuffer, PbmpBufferR: PByte;
BytesPerPixel, PixelsPerByte: LongInt;
BytesPerScanLine, BytesPerScanLineR: LongInt;
PaddingBytes: LongInt;
BitmapOffset: LongInt;
BitCount: LongInt;
WholeBytes, ExtraPixels: LongInt;
SignificantBytes, SignificantBytesR: LongInt;
ColumnBytes: LongInt;
AtLeastEightBitColor: Boolean;
T: LongInt;

procedure NonIntegralByteRotate; (* nested *)
var
X, Y: LongInt;
I: LongInt;
MaskBits, CurrentBits: Byte;
FirstMask, LastMask: Byte;
PFirstScanLine: PByte;
FirstIndex, CurrentBitIndex: LongInt;
ShiftRightAmount, ShiftRightStart: LongInt;

begin
(*$IFDEF Win32*)
Inc(PbmpBuffer, BytesPerScanLine * (PbmpInfoR^.biHeight - 1) );
(*$ELSE*)
Win16Inc( Pointer(PbmpBuffer), BytesPerScanLine * (PbmpInfoR^.biHeight - 1) );
(*$ENDIF*)

PFirstScanLine := bmpBufferR;

FirstIndex := BitsPerByte - BitCount;


LastMask := 1 shl BitCount - 1;
FirstMask := LastMask shl FirstIndex;

CurrentBits := FirstMask;
CurrentBitIndex := FirstIndex;

ShiftRightStart := BitCount * (PixelsPerByte - 1);

for Y := 1 to PbmpInfoR^.biHeight do begin
PbmpBufferR := PFirstScanLine;

for X := 1 to WholeBytes do begin
MaskBits := FirstMask;
ShiftRightAmount := ShiftRightStart;
for I := 1 to PixelsPerByte do begin

PbmpBufferR^ := ( PbmpBufferR^ and not CurrentBits ) or
( (PbmpBuffer^ and MaskBits) shr ShiftRightAmount shl CurrentBitIndex );

MaskBits := MaskBits shr BitCount;
(*$IFDEF Win32*)
Inc(PbmpBufferR, BytesPerScanLineR);
Dec(ShiftRightAmount, BitCount);
(*$ELSE*)
Win16Inc( Pointer(PbmpBufferR), BytesPerScanLineR );
Win16Dec( Pointer(ShiftRightAmount), BitCount );
(*$ENDIF*)
end;
(*$IFDEF Win32*)
Inc(PbmpBuffer);
(*$ELSE*)
Win16Inc( Pointer(PbmpBuffer), 1 );
(*$ENDIF*)
end;

if ExtraPixels <> 0 then begin
MaskBits := FirstMask;
ShiftRightAmount := ShiftRightStart;
for I := 1 to ExtraPixels do begin
PbmpBufferR^ := ( PbmpBufferR^ and not CurrentBits ) or
( (PbmpBuffer^ and MaskBits) shr ShiftRightAmount shl CurrentBitIndex );

MaskBits := MaskBits shr BitCount;
(*$IFDEF Win32*)
Inc(PbmpBufferR, BytesPerScanLineR);
(*$ELSE*)
Win16Inc( Pointer(PbmpBufferR), BytesPerScanLineR );
(*$ENDIF*)
Dec(ShiftRightAmount, BitCount);
end;
(*$IFDEF Win32*)
Inc(PbmpBuffer);
(*$ELSE*)
Win16Inc( Pointer(PbmpBuffer), 1 );
(*$ENDIF*)
end;

(*$IFDEF Win32*)
{ Skip the padding. }
Inc(PbmpBuffer, PaddingBytes);
Dec(PbmpBuffer, BytesPerScanLine shl 1);
(*$ELSE*)
Win16Inc( Pointer(PbmpBuffer), PaddingBytes );
Win16Dec( Pointer(PbmpBuffer), BytesPerScanLine shl 1 );
(*$ENDIF*)

if CurrentBits = LastMask then begin
CurrentBits := FirstMask;
CurrentBitIndex := FirstIndex;
(*$IFDEF Win32*)
Inc(PFirstScanLine);
(*$ELSE*)
Win16Inc( Pointer(PFirstScanLine), 1 );
(*$ENDIF*)
end
else begin
{ Continue filling this byte. }
CurrentBits := CurrentBits shr BitCount;
Dec(CurrentBitIndex, BitCount);
end;
end;
end; { procedure NonIntegralByteRotate (* nested *) }

procedure IntegralByteRotate; (* nested *)
var
X, Y: LongInt;
(*$IFNDEF Win32*)
I: Integer;
(*$ENDIF*)

begin
{ Advance PbmpBufferR to the last column of the first scan line of bmpBufferR. }
(*$IFDEF Win32*)
Inc(PbmpBufferR, SignificantBytesR - BytesPerPixel);
(*$ELSE*)
Win16Inc( Pointer(PbmpBufferR), SignificantBytesR - BytesPerPixel );
(*$ENDIF*)

for Y := 1 to PbmpInfoR^.biHeight do begin
for X := 1 to PbmpInfoR^.biWidth do begin
{ Copy the pixels. }
(*$IFDEF Win32*)
Move(PbmpBuffer^, PbmpBufferR^, BytesPerPixel);
Inc(PbmpBuffer, BytesPerPixel);
Inc(PbmpBufferR, BytesPerScanLineR);
(*$ELSE*)
for I := 1 to BytesPerPixel do begin
PbmpBufferR^ := PbmpBuffer^;
Win16Inc( Pointer(PbmpBuffer), 1 );
Win16Inc( Pointer(PbmpBufferR), 1 );
end;
Win16Inc( Pointer(PbmpBufferR), BytesPerScanLineR - BytesPerPixel);
(*$ENDIF*)
end;
(*$IFDEF Win32*)
{ Skip the padding. }
Inc(PbmpBuffer, PaddingBytes);
{ Go to the top of the rotated bitmap's column, but one column over. }
Dec(PbmpBufferR, ColumnBytes + BytesPerPixel);
(*$ELSE*)
Win16Inc( Pointer(PbmpBuffer), PaddingBytes);
Win16Dec( Pointer(PbmpBufferR), ColumnBytes + BytesPerPixel);
(*$ENDIF*)
end;
end;

{ This is the body of procedure RotateBitmap90DegreesCounterClockwise. }
begin
{ Don't *ever* call GetDIBSizes! It screws up your bitmap. }

MemoryStream := TMemoryStream.Create;

ABitmap.SaveToStream(MemoryStream);

{ Don't need you anymore. We'll make a new one when the time comes. }
ABitmap.Free;

bmpBuffer := MemoryStream.Memory;
{ Get the offset bits. This may or may not include palette information. }
BitmapOffset := PBitmapFileHeader(bmpBuffer)^.bfOffBits;

{ Set PbmpInfoR to point to the source bitmap's info header. }
{ Boy, these headers are getting annoying. }
(*$IFDEF Win32*)
Inc( bmpBuffer, SizeOf(TBitmapFileHeader) );
(*$ELSE*)
Win16Inc( Pointer(bmpBuffer), SizeOf(TBitmapFileHeader) );
(*$ENDIF*)
PbmpInfoR := PBitmapInfoHeader(bmpBuffer);

{ Set bmpBuffer and PbmpBuffer to point to the original bitmap bits. }
bmpBuffer := MemoryStream.Memory;
(*$IFDEF Win32*)
Inc(bmpBuffer, BitmapOffset);
(*$ELSE*)
Win16Inc( Pointer(bmpBuffer), BitmapOffset );
(*$ENDIF*)
PbmpBuffer := bmpBuffer;

with PbmpInfoR^ do begin
{ ShowMessage('Compression := ' + IntToStr(biCompression)); }
BitCount := biBitCount;
BytesPerScanLine := ((((biWidth * BitCount) + 31) div 32) * SizeOf(DWORD));
BytesPerScanLineR := ((((biHeight * BitCount) + 31) div 32) * SizeOf(DWORD));

AtLeastEightBitColor := BitCount >= BitsPerByte;
if AtLeastEightBitColor then begin
{ Don't have to worry about bit-twiddling. Cool. }
BytesPerPixel := biBitCount shr 3;
SignificantBytes := biWidth * BitCount shr 3;
SignificantBytesR := biHeight * BitCount shr 3;
{ Extra bytes required for DWORD aligning. }
PaddingBytes := BytesPerScanLine - SignificantBytes;
ColumnBytes := BytesPerScanLineR * biWidth;
end
else begin
{ One- or four-bit bitmap. Ugh. }
PixelsPerByte := SizeOf(Byte) * BitsPerByte div BitCount;
{ The number of bytes entirely filled with pixel information. }
WholeBytes := biWidth div PixelsPerByte;
ExtraPixels := biWidth mod PixelsPerByte;
PaddingBytes := BytesPerScanLine - WholeBytes;
if ExtraPixels <> 0 then Dec(PaddingBytes);
end; { if AtLeastEightBitColor then }

MemoryStreamR := TMemoryStream.Create;
MemoryStreamR.SetSize(BitmapOffset + BytesPerScanLineR * biWidth);
end; { with PbmpInfoR^ do }

MemoryStream.Seek(0, soFromBeginning);
MemoryStreamR.CopyFrom(MemoryStream, BitmapOffset);

{ Here's the buffer we're going to rotate. }
bmpBufferR := MemoryStreamR.Memory;
{ Skip the headers, yadda yadda yadda... }
(*$IFDEF Win32*)
Inc(bmpBufferR, BitmapOffset);
(*$ELSE*)
Win16Inc( Pointer(bmpBufferR), BitmapOffset );
(*$ENDIF*)
PbmpBufferR := bmpBufferR;

{ Do it. }
if AtLeastEightBitColor then
IntegralByteRotate
else
NonIntegralByteRotate;

{ Done with the source bits. }
MemoryStream.Free;

{ Now set PbmpInfoR to point to the rotated bitmap's info header. }
PbmpBufferR := MemoryStreamR.Memory;
(*$IFDEF Win32*)
Inc( PbmpBufferR, SizeOf(TBitmapFileHeader) );
(*$ELSE*)
Win16Inc( Pointer(PbmpBufferR), SizeOf(TBitmapFileHeader) );
(*$ENDIF*)
PbmpInfoR := PBitmapInfoHeader(PbmpBufferR);

{ Swap the width and height of the rotated bitmap's info header. }
with PbmpInfoR^ do begin
T := biHeight;
biHeight := biWidth;
biWidth := T;
biSizeImage := 0;
end;

ABitmap := TBitmap.Create;

{ Spin back to the very beginning. }
MemoryStreamR.Seek(0, soFromBeginning);
{ Load it back into ABitmap. }
ABitmap.LoadFromStream(MemoryStreamR);

MemoryStreamR.Free;
end;

procedure RotateBitmap90r(var ABitmap: TBitmap);
const
BitsPerByte = 8;

var
PbmpInfoR: PBitmapInfoHeader;
bmpBuffer, bmpBufferR: PByte;
MemoryStream, MemoryStreamR: TMemoryStream;
PbmpBuffer, PbmpBufferR: PByte;
BytesPerPixel, PixelsPerByte: LongInt;
BytesPerScanLine, BytesPerScanLineR: LongInt;
PaddingBytes: LongInt;
BitmapOffset: LongInt;
BitCount: LongInt;
WholeBytes, ExtraPixels: LongInt;
SignificantBytes: LongInt;
ColumnBytes: LongInt;
AtLeastEightBitColor: Boolean;
T: LongInt;

procedure NonIntegralByteRotate; (* nested *)
{
This routine rotates bitmaps with fewer than 8 bits of information per pixel,
namely monochrome (1-bit) and 16-color (4-bit) bitmaps. Note that there are
no such things as 2-bit bitmaps, though you might argue that Microsoft's bitmap
format is worth about 2 bits.
}
var
X, Y: LongInt;
I: LongInt;
MaskBits, CurrentBits: Byte;
FirstMask, LastMask: Byte;
PLastScanLine: PByte;
FirstIndex, CurrentBitIndex: LongInt;
ShiftRightAmount, ShiftRightStart: LongInt;

begin
{ Advance PLastScanLine to the first column of the last scan line of bmpBufferR. }
PLastScanLine := bmpBufferR; (*$IFDEF Win32*) Inc(PLastScanLine, BytesPerScanLineR *
(PbmpInfoR^.biWidth - 1) ); (*$ELSE*) Win16Inc( Pointer(PLastScanLine),
BytesPerScanLineR * (PbmpInfoR^.biWidth - 1) ); (*$ENDIF*)

{ Set up the indexing. }
FirstIndex := BitsPerByte - BitCount;

{
Set up the bit masks:

For a monochrome bitmap,
LastMask := 00000001 and
FirstMask := 10000000

For a 4-bit bitmap,
LastMask := 00001111 and
FirstMask := 11110000

We'll shift through these such that the CurrentBits and the MaskBits will go
For a monochrome bitmap:
10000000, 01000000, 00100000, 00010000, 00001000, 00000100, 00000010, 00000001
For a 4-bit bitmap:
11110000, 00001111

The CurrentBitIndex denotes how far over the right-most bit would need to
shift to get to the position of CurrentBits. For example, if we're on the
eleventh column of a monochrome bitmap, then CurrentBits will equal
11 mod 8 := 3, or the 3rd-to-the-leftmost bit. Thus, the right-most bit
would need to shift four places over to get anded correctly with
CurrentBits. CurrentBitIndex will store this value.
}
LastMask := 1 shl BitCount - 1;
FirstMask := LastMask shl FirstIndex;

CurrentBits := FirstMask;
CurrentBitIndex := FirstIndex;

ShiftRightStart := BitCount * (PixelsPerByte - 1);

for Y := 1 to PbmpInfoR^.biHeight do begin
PbmpBufferR := PLastScanLine;

for X := 1 to WholeBytes do begin
MaskBits := FirstMask;
ShiftRightAmount := ShiftRightStart;
for I := 1 to PixelsPerByte do begin

PbmpBufferR^ := ( PbmpBufferR^ and not CurrentBits ) or
( (PbmpBuffer^ and MaskBits) shr ShiftRightAmount shl CurrentBitIndex );

{ Move the MaskBits over for the next iteration. }
MaskBits := MaskBits shr BitCount;
(*$IFDEF Win32*)
{ Move our pointer to the rotated-bitmap buffer up one scan line. }
Dec(PbmpBufferR, BytesPerScanLineR);
(*$ELSE*)
Win16Dec( Pointer(PbmpBufferR), BytesPerScanLineR );
(*$ENDIF*)
{ We don't need to shift as far to the right the next time around. }
Dec(ShiftRightAmount, BitCount);
end;
(*$IFDEF Win32*)
Inc(PbmpBuffer);
(*$ELSE*)
Win16Inc( Pointer(PbmpBuffer), 1 );
(*$ENDIF*)
end;

{ If there's a partial byte, take care of it now. }
if ExtraPixels <> 0 then begin
{ Do exactly the same crap as in the loop above. }
MaskBits := FirstMask;
ShiftRightAmount := ShiftRightStart;
for I := 1 to ExtraPixels do begin
PbmpBufferR^ := ( PbmpBufferR^ and not CurrentBits ) or
( (PbmpBuffer^ and MaskBits) shr ShiftRightAmount shl CurrentBitIndex );

MaskBits := MaskBits shr BitCount;
(*$IFDEF Win32*)
Dec(PbmpBufferR, BytesPerScanLineR);
(*$ELSE*)
Win16Dec( Pointer(PbmpBufferR), BytesPerScanLineR );
(*$ENDIF*)
Dec(ShiftRightAmount, BitCount);
end;
(*$IFDEF Win32*)
Inc(PbmpBuffer);
(*$ELSE*)
Win16Inc( Pointer(PbmpBuffer), 1 );
(*$ENDIF*)
end;

{ Skip the padding. }
(*$IFDEF Win32*)
Inc(PbmpBuffer, PaddingBytes);
(*$ELSE*)
Win16Inc( Pointer(PbmpBuffer), PaddingBytes );
(*$ENDIF*)

if CurrentBits = LastMask then begin
{ We're at the end of this byte. Start over on another column. }
CurrentBits := FirstMask;
CurrentBitIndex := FirstIndex;
{ Go to the bottom of the rotated bitmap's column, but one column over. }
(*$IFDEF Win32*)
Inc(PLastScanLine);
(*$ELSE*)
Win16Inc( Pointer(PLastScanLine), 1 );
(*$ENDIF*)
end
else begin
{ Continue filling this byte. }
CurrentBits := CurrentBits shr BitCount;
Dec(CurrentBitIndex, BitCount);
end;
end;
end; { procedure NonIntegralByteRotate (* nested *) }

procedure IntegralByteRotate; (* nested *)
var
X, Y: LongInt;
(*$IFNDEF Win32*)
I: Integer;
(*$ENDIF*)

begin
{ Advance PbmpBufferR to the first column of the last scan line of bmpBufferR. }
(*$IFDEF Win32*)
Inc( PbmpBufferR, BytesPerScanLineR * (PbmpInfoR^.biWidth - 1) );
(*$ELSE*)
Win16Inc( Pointer(PbmpBufferR) , BytesPerScanLineR * (PbmpInfoR^.biWidth - 1) );
(*$ENDIF*)

for Y := 1 to PbmpInfoR^.biHeight do begin
for X := 1 to PbmpInfoR^.biWidth do begin
{ Copy the pixels. }
(*$IFDEF Win32*)
Move(PbmpBuffer^, PbmpBufferR^, BytesPerPixel);
Inc(PbmpBuffer, BytesPerPixel);
Dec(PbmpBufferR, BytesPerScanLineR);
(*$ELSE*)
for I := 1 to BytesPerPixel do begin
PbmpBufferR^ := PbmpBuffer^;
Win16Inc( Pointer(PbmpBuffer), 1 );
Win16Inc( Pointer(PbmpBufferR), 1 );
end;
Win16Dec( Pointer(PbmpBufferR), BytesPerScanLineR + BytesPerPixel);
(*$ENDIF*)
end;
(*$IFDEF Win32*)
{ Skip the padding. }
Inc(PbmpBuffer, PaddingBytes);
{ Go to the top of the rotated bitmap's column, but one column over. }
Inc(PbmpBufferR, ColumnBytes + BytesPerPixel);
(*$ELSE*)
Win16Inc( Pointer(PbmpBuffer), PaddingBytes );
Win16Inc( Pointer(PbmpBufferR), ColumnBytes + BytesPerPixel );
(*$ENDIF*)
end;
end;

{ This is the body of procedure RotateBitmap90DegreesCounterClockwise. }
begin
{ Don't *ever* call GetDIBSizes! It screws up your bitmap. }

MemoryStream := TMemoryStream.Create;

ABitmap.SaveToStream(MemoryStream);

{ Don't need you anymore. We'll make a new one when the time comes. }
ABitmap.Free;

bmpBuffer := MemoryStream.Memory;
{ Get the offset bits. This may or may not include palette information. }
BitmapOffset := PBitmapFileHeader(bmpBuffer)^.bfOffBits;

(*$IFDEF Win32*)
Inc( bmpBuffer, SizeOf(TBitmapFileHeader) );
(*$ELSE*)
Win16Inc( Pointer(bmpBuffer), SizeOf(TBitmapFileHeader) );
(*$ENDIF*)
PbmpInfoR := PBitmapInfoHeader(bmpBuffer);

{ Set bmpBuffer and PbmpBuffer to point to the original bitmap bits. }
bmpBuffer := MemoryStream.Memory;
(*$IFDEF Win32*)
Inc(bmpBuffer, BitmapOffset);
(*$ELSE*)
Win16Inc( Pointer(bmpBuffer), BitmapOffset );
(*$ENDIF*)
PbmpBuffer := bmpBuffer;

with PbmpInfoR^ do begin
{ ShowMessage('Compression := ' + IntToStr(biCompression)); }
BitCount := biBitCount;
{ ShowMessage('BitCount := ' + IntToStr(BitCount)); }

{ ScanLines are DWORD aligned. }
BytesPerScanLine := ((((biWidth * BitCount) + 31) div 32) * SizeOf(DWORD));
BytesPerScanLineR := ((((biHeight * BitCount) + 31) div 32) * SizeOf(DWORD));

AtLeastEightBitColor := BitCount >= BitsPerByte;
if AtLeastEightBitColor then begin
{ Don't have to worry about bit-twiddling. Cool. }
BytesPerPixel := biBitCount shr 3;
SignificantBytes := biWidth * BitCount shr 3;
{ Extra bytes required for DWORD aligning. }
PaddingBytes := BytesPerScanLine - SignificantBytes;
ColumnBytes := BytesPerScanLineR * biWidth;
end
else begin
{ One- or four-bit bitmap. Ugh. }
PixelsPerByte := SizeOf(Byte) * BitsPerByte div BitCount;
{ The number of bytes entirely filled with pixel information. }
WholeBytes := biWidth div PixelsPerByte;
ExtraPixels := biWidth mod PixelsPerByte;
PaddingBytes := BytesPerScanLine - WholeBytes;
if ExtraPixels <> 0 then Dec(PaddingBytes);
end; { if AtLeastEightBitColor then }

MemoryStreamR := TMemoryStream.Create;
MemoryStreamR.SetSize(BitmapOffset + BytesPerScanLineR * biWidth);
end; { with PbmpInfoR^ do }

{ Copy the headers from the source bitmap. }
MemoryStream.Seek(0, soFromBeginning);
MemoryStreamR.CopyFrom(MemoryStream, BitmapOffset);

{ Here's the buffer we're going to rotate. }
bmpBufferR := MemoryStreamR.Memory;
{ Skip the headers, yadda yadda yadda... }
(*$IFDEF Win32*)
Inc(bmpBufferR, BitmapOffset);
(*$ELSE*)
Win16Inc( Pointer(bmpBufferR), BitmapOffset );
(*$ENDIF*)
PbmpBufferR := bmpBufferR;

{ Do it. }
if AtLeastEightBitColor then
IntegralByteRotate
else
NonIntegralByteRotate;

{ Done with the source bits. }
MemoryStream.Free;

{ Now set PbmpInfoR to point to the rotated bitmap's info header. }
PbmpBufferR := MemoryStreamR.Memory;
(*$IFDEF Win32*)
Inc( PbmpBufferR, SizeOf(TBitmapFileHeader) );
(*$ELSE*)
Win16Inc( Pointer(PbmpBufferR), SizeOf(TBitmapFileHeader) );
(*$ENDIF*)
PbmpInfoR := PBitmapInfoHeader(PbmpBufferR);

{ Swap the width and height of the rotated bitmap's info header. }
with PbmpInfoR^ do begin
T := biHeight;
biHeight := biWidth;
biWidth := T;
biSizeImage := 0;
end;

ABitmap := TBitmap.Create;

{ Spin back to the very beginning. }
MemoryStreamR.Seek(0, soFromBeginning);
{ Load it back into ABitmap. }
ABitmap.LoadFromStream(MemoryStreamR);

MemoryStreamR.Free;
end;