Новый модуль имеет три программы: RotateBitmap90DegreesClockwise, RotateBitmap90DegreesCounterClockwise, и RotateBitmap180Degrees. Все три используют TBitmap как переменную и вращают его согласно своему названию.
Два предостережения: Это все еще не совсем работает в Delphi3. Появляется какой-то шум на краях изображения. Мне кажется это из-за какой-то ошибки в методе LoadFromStream объекта TBitmap, но это может быть и моей ошибкой. Тем не менее есть другие решения, связанные с использованием свойства ScanLine, так что эта проблема решается. Во-вторых, этот алгоритм не работает с сжатыми RLE-алгоритмом изображениями.  4 - и  8 -битные (по разрешению) изображения могут быть декодированы и хранится в памяти: на случай, если они потребуются, у нас есть их дескриптор. К тому же, если изображение сжато, можно просто получить дескриптор канвы с нормальным изображением:



 --------------------------------------------------------------------------------
 
    ABitmap.Canvas.Handle;  

Этим мы также назначаем контекст устройства (то есть экрана), и, вероятно, сможем обрабатывать изображения вплоть до  24 -битного формата. Что-то вроде компромисного решения.

Во всяком случае это работает у меня в Delphi  1  и  2  с черно-белыми,  4 -,  8 -,  16 -,  24 -, и  32 -битными изображениями (но не с  4 - и  8 -битными изображениями, сжатыми RLE-алгоритмом, как я уже говорил выше).



 --------------------------------------------------------------------------------
 
    unit bmpRot;

interface

uses

(*$IFDEF Win32*) Windows, (*$ELSE*) WinTypes, WinProcs, (*$ENDIF*)
Classes, Graphics;

procedure RotateBitmap90DegreesCounterClockwise(var ABitmap: TBitmap);
procedure RotateBitmap90DegreesClockwise(var ABitmap: TBitmap);
procedure RotateBitmap180Degrees(var ABitmap: TBitmap);

implementation

uses

Dialogs;


(*$IFNDEF Win32*)

type

DWORD = LongInt;
TSelOfs = record
L, H: Word;
end;

procedure Win16Dec(var P: Pointer; const N: LongInt); forward;

procedure Win16Inc(var P: Pointer; const N: LongInt);
begin

if N <  0  then
Win16Dec(P, -N)
else if N >  0  then begin
Inc( TSelOfs(P).H, TSelOfs(N).H * SelectorInc );
Inc( TSelOfs(P).L, TSelOfs(N).L );
if TSelOfs(P).L < TSelOfs(N).L then Inc( TSelOfs(P).H, SelectorInc );
end;
end;

procedure Win16Dec(var P: Pointer; const N: LongInt);
begin

if N <  0  then
Win16Inc(P, -N)
else if N >  0  then begin
if TSelOfs(N).L > TSelOfs(P).L then Dec( TSelOfs(P).H, SelectorInc );
Dec( TSelOfs(P).L, TSelOfs(N).L );
Dec( TSelOfs(P).H, TSelOfs(N).H * SelectorInc );
end;
end;

(*
procedure HugeShift; far; external 'KERNEL' index  113 ;
procedure Win16Dec(var P: Pointer; const N: LongInt); forward;

procedure Win16Inc(var HugePtr: Pointer; Amount: LongInt);

procedure HugeInc; assembler;
asm
mov ax, Amount.Word[ 0 ]        { Сохраняем сумму в DX:AX. }
mov dx, Amount.Word[ 2 ]
les bx, HugePtr               { Получаем ссылку на HugePtr. }
add ax, es:[bx]               { Добавление коррекции. }
adc dx,  0                      { Распространяем перенос на наибольшую величину суммы. }
mov cx, Offset HugeShift
shl dx,                       { Перемещаем наибольшую величину суммы для сегмента. }
add es:[bx+ 2 ], dx             { Увеличиваем сегмент HugePtr. }
mov es:[bx], ax
end;

begin

if Amount >  0  then HugeInc else if Amount <  0  then Win16Dec(HugePtr, -Amount);
end;

procedure Win16Dec(var P: Pointer; const N: LongInt);
begin

if N <  0  then
Win16Inc(P, -N)
else if N >  0  then begin
if TSelOfs(N).L > TSelOfs(P).L then Dec( TSelOfs(P).H, SelectorInc );
Dec( TSelOfs(P).L, TSelOfs(N).L );
Dec( TSelOfs(P).H, TSelOfs(N).H * SelectorInc );
end;
end;
*)

(*$ENDIF*)

procedure RotateBitmap90DegreesCounterClockwise(var ABitmap: TBitmap);
const

BitsPerByte =  8 ;

var

{
Целая куча переменных. Некоторые имеют дело только с одно- и четырех-битовыми
изображениями, другие только с восемью- и  24 -битовыми, а некоторые с обоими.
Любая переменная, оканчивающаяся символом 'R', имеет отношение к вращению изображения,
например если MemoryStream содержит исходное изображение, то MemoryStreamR - повернутое.
}
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; (* вложение *)
{

Эта программа осуществляет поворот изображений с разрешением меньшим, чем  8  бит на пиксел,
а имеено: черно-белые ( 1 -бит) и  16 -цветные ( 4 -бит) изображения. Имейте в виду, что
такие вещи, как  2 -битные изображения также могли бы вращаться, но Microsoft не включил
данный формат в свои спецификации и не поддерживает его.
}
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. }
PFirstScanLine := bmpBufferR;


{ Устанавливаем индексирование. }
FirstIndex := BitsPerByte - BitCount;


{
Устанавливаем битовые маски:


Для черно-белого изображения,
LastMask  :=  00000001     и
FirstMask :=  10000000 


Для  4 -битного изображения,
LastMask  :=  00001111     и
FirstMask :=  11110000 


Зададим значения CurrentBits и MaskBits, так как мы будем перемещаться по ним:
Для монохромных изображений:
 10000000 ,  01000000 ,  00100000 ,  00010000 ,  00001000 ,  00000100 ,  00000010 ,  00000001 
Для  4 -битных изображений:
 11110000 ,  00001111 


CurrentBitIndex определяет расстояние от крайнего правого бита
до позиции CurrentBits. Например, если мы находимся в одиннадцатой
колонке черно-белого изображения, CurrentBits равен
 11  mod  8  :=  3 , или  3 -й самый левый бит. Таким образом, крайне правый
бит должен переместиться на четыре позиции, чтобы попасть на позицию
CurrentBits. CurrentBitIndex как раз и хранит такое значение.
}
LastMask :=  1  shl BitCount -  1 ;
FirstMask := LastMask shl FirstIndex;


CurrentBits := FirstMask;
CurrentBitIndex := FirstIndex;


ShiftRightStart := BitCount * (PixelsPerByte -  1 );


{ Вот мясо. Перебираем в цикле все пиксели и соответственно вращаем. }
{ Помните что DIB'ы имеют происхождение противоположное DDB'сам. }


{ Счетчик Y указывает на текущую строчку исходного изображения. }
for Y :=  1  to PbmpInfoR^.biHeight do begin
PbmpBufferR := PFirstScanLine;


{
Счетчик X указывает на текущую колонку пикселей исходного изображения.
Здесь мы имеем дело только с полностью заполненными байтами. Обработка
'частично заполненных' байтов происходит ниже.
}
for X :=  1  to WholeBytes do begin
{
Выбираем биты, начиная с  10000000  для черно-белых и
заканчивая  11110000  для  4 -битных изображений.
}
MaskBits := FirstMask;
{
ShiftRightAmount - сумма, необходимая для перемещения текущего байта
через весь путь (помните, я об этом говорил выше) в правую часть.
}
ShiftRightAmount := ShiftRightStart;
for I :=  1  to PixelsPerByte do begin
{
Вот гарнир. Берем текущий байт вращаемого изображения и маскируем его
с not CurrentBits. Гасятся нулями только биты CurrentBits, сам байт перемещается
без изменений. Пример: Для черно-белого изображения, если бы мы
находились в  11 -й колонке (см. пример выше), мы должны нулем погасить
 3 -й слева бит, то есть мы должны использовать PbmpBufferR^ и  11011111 .


Теперь рассмотрим наш текущий исходный байт. Для черно-белых изображений
мы организуем цикл с шагом через бит, в общей сложности для восьми пикселей.
Для  4 -битных изображений мы делаем цикл с обработкой четырех битов за проход для
двух пикселей. В любом случае мы делаем это через маскирование с
MaskBits ('PbmpBuffer^ и MaskBits'). Теперь нам нужно получить бит(ы)
из той колонки(ок), на которую отобразится CurrentBits. Мы это делаем с помощью
перемещения их в крайне правую часть байта ('shr ShiftRightAmount'),
затем сдвигая их налево с помощью вышеупомянутого
CurrentBitIndex ('shl CurrentBitIndex'). Дело в том, что хотя перемещение
вправо с параметром -n должно быть просто перемещением налево с параметром +n,
в Delphi это не работает. Итак, мы начинаем с первого байта, перемещая пиксели
в правую часть насколько это возможно незанятыми позициями.


Наконец, мы имеем наш исходный бит(ы), перемещенный на нужное место
с погашенными нулями битами. Последнее делаем непосредственно или с
помощью PbmpBufferR^ (гасим биты в CurrentBits, помните?).


Мда...  "Просто" . Ладно, поехали дальше.
}


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


{ Сдвигаем MaskBits для следующей итерации. }
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*)
{ Пропускаем заполнение. }
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
{ Продолжаем заполнять этот байт. }
CurrentBits := CurrentBits shr BitCount;
Dec(CurrentBitIndex, BitCount);
end;
end;
end; { procedure NonIntegralByteRotate (* вложение *) }

procedure IntegralByteRotate; (* вложение *)
var

X, Y: LongInt;
(*$IFNDEF Win32*)
I: Integer;
(*$ENDIF*)

begin

{ Перемещаем PbmpBufferR в последнюю колонку первой линии чередования bmpBufferR. }
(*$IFDEF Win32*)
Inc(PbmpBufferR, SignificantBytesR - BytesPerPixel);
(*$ELSE*)
Win16Inc( Pointer(PbmpBufferR), SignificantBytesR - BytesPerPixel );
(*$ENDIF*)


{ Вот мясо. Перебираем в цикле все пиксели и соответственно вращаем. }
{ Помните что DIB'ы имеют происхождение противоположное DDB'сам. }
for Y :=  1  to PbmpInfoR^.biHeight do begin
for X :=  1  to PbmpInfoR^.biWidth do begin
{ Копируем пиксели. }
(*$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*)
{ Пропускаем заполнение. }
Inc(PbmpBuffer, PaddingBytes);
{ Идем вверх колонки вращаемого изображения , но одну колонку пропускаем. }
Dec(PbmpBufferR, ColumnBytes + BytesPerPixel);
(*$ELSE*)
Win16Inc( Pointer(PbmpBuffer), PaddingBytes);
Win16Dec( Pointer(PbmpBufferR), ColumnBytes + BytesPerPixel);
(*$ENDIF*)
end;
end;

{ Это тело процедуры RotateBitmap90DegreesCounterClockwise. }
begin

{ Никогда сами не вызывайте GetDIBSizes! Это испортит ваше изображение. }


MemoryStream := TMemoryStream.Create;


{
Для работы: Прежде всего установим размер. Это устранит перераспределение памяти
для MemoryStream. Вызов GetDIBSizes будет к месту, но, как отмечалось выше,
это может исказить ваше изображение. Вызов некоторых API функций вероятно
позаботился бы об этом, но это тема отдельного разговора.
}


{ Недокументированный метод. Все же программист иногда сродни шаману. }
ABitmap.SaveToStream(MemoryStream);


{ Изображение больше не нужно. Создадим новое когда понадобится. }
ABitmap.Free;


bmpBuffer := MemoryStream.Memory;
{ Получаем биты компенсации. Они могут содержать информацию о палитре. }
BitmapOffset := PBitmapFileHeader(bmpBuffer)^.bfOffBits;


{ Устанавливаем PbmpInfoR на указатель информационного заголовка исходного изображения. }
{ Эти заголовки могут немного раздражать, но они необходимы для работы. }
(*$IFDEF Win32*)
Inc( bmpBuffer, SizeOf(TBitmapFileHeader) );
(*$ELSE*)
Win16Inc( Pointer(bmpBuffer), SizeOf(TBitmapFileHeader) );
(*$ENDIF*)
PbmpInfoR := PBitmapInfoHeader(bmpBuffer);


{ Устанавливаем bmpBuffer и PbmpBuffer так, чтобы они указывали на биты оригинального изображения. }
bmpBuffer := MemoryStream.Memory;
(*$IFDEF Win32*)
Inc(bmpBuffer, BitmapOffset);
(*$ELSE*)
Win16Inc( Pointer(bmpBuffer), BitmapOffset );
(*$ENDIF*)
PbmpBuffer := bmpBuffer;


{
Имейте в виду, что нам не нужно беспокоиться о совместимости изображений версии  4  и  3 ,
поскольку области, которые мы используем, а именно  -- biWidth, biHeight, и biBitCount --
 
располагаются на один и тех же местах в обоих структурах. Итак, одной проблемой меньше.
Изображения версии OS/ 2 , между прочим, при этом гнусно рушатся. Обидно.
}
with PbmpInfoR^ do begin
{ ShowMessage('Компрессия := ' + IntToStr(biCompression)); }
BitCount := biBitCount;
{ ShowMessage('BitCount := ' + IntToStr(BitCount)); }


{ ScanLines -  "выровненный"  DWORD. }
BytesPerScanLine := ((((biWidth * BitCount) +  31 ) div  32 ) * SizeOf(DWORD));
BytesPerScanLineR := ((((biHeight * BitCount) +  31 ) div  32 ) * SizeOf(DWORD));


AtLeastEightBitColor := BitCount >= BitsPerByte;
if AtLeastEightBitColor then begin
{ Нас не должен волновать бит-тильда. Классно. }
BytesPerPixel := biBitCount shr  3 ;
SignificantBytes := biWidth * BitCount shr  3 ;
SignificantBytesR := biHeight * BitCount shr  3 ;
{ Дополнительные байты необходимы для выравнивания DWORD. }
PaddingBytes := BytesPerScanLine - SignificantBytes;
ColumnBytes := BytesPerScanLineR * biWidth;
end
else begin
{ Одно- или четырех-битовое изображение. Уфф. }
PixelsPerByte := SizeOf(Byte) * BitsPerByte div BitCount;
{ Все количество байтов полностью заполняется информацией о пикселе. }
WholeBytes := biWidth div PixelsPerByte;
{
Обрабатываем любые дополнительные биты, которые могут частично заполнять байт.
Например, черно-белое изображение, у которого  14  пикселей описываются каждый
соответственно своим байтом, плюс одним дополнительным, у которого на самом
деле используются  6  битов, остальное мусор.
}
ExtraPixels := biWidth mod PixelsPerByte;
{
Все дополнительные байты  -- если имеются -- требуется DWORD-выровнять по
 
линии чередования.
}
PaddingBytes := BytesPerScanLine - WholeBytes;
{
Если есть дополнительные биты (то есть имеется 'дополнительный байт'),
то один из заполненных байтов уже был принят во внимание.
}
if ExtraPixels <>  0  then Dec(PaddingBytes);
end; { if AtLeastEightBitColor then }


{ TMemoryStream, обслуживающий вращаемые биты. }
MemoryStreamR := TMemoryStream.Create;
{
Устанавливаем размер вращаемого изображения. Может отличаться
от исходного из-за выравнивания DWORD.
}
MemoryStreamR.SetSize(BitmapOffset + BytesPerScanLineR * biWidth);
end; { with PbmpInfoR^ do }


{ Копируем заголовки исходного изображения. }
MemoryStream.Seek( 0 , soFromBeginning);
MemoryStreamR.CopyFrom(MemoryStream, BitmapOffset);


{ Вот буфер, который мы будем  "вращать" . }
bmpBufferR := MemoryStreamR.Memory;
{ Пропускаем заголовки, yadda yadda yadda... }
(*$IFDEF Win32*)
Inc(bmpBufferR, BitmapOffset);
(*$ELSE*)
Win16Inc( Pointer(bmpBufferR), BitmapOffset );
(*$ENDIF*)
PbmpBufferR := bmpBufferR;


{ Едем дальше. }
if AtLeastEightBitColor then
IntegralByteRotate
else
NonIntegralByteRotate;


{ Удовлетворяемся исходными битами. }
MemoryStream.Free;


{ Теперь устанавливаем PbmpInfoR, чтобы он указывал на информационный заголовок вращаемого изображения. }
PbmpBufferR := MemoryStreamR.Memory;
(*$IFDEF Win32*)
Inc( PbmpBufferR, SizeOf(TBitmapFileHeader) );
(*$ELSE*)
Win16Inc( Pointer(PbmpBufferR), SizeOf(TBitmapFileHeader) );
(*$ENDIF*)
PbmpInfoR := PBitmapInfoHeader(PbmpBufferR);


{ Меняем ширину с высотой в информационном заголовке вращаемого изображения. }
with PbmpInfoR^ do begin
T := biHeight;
biHeight := biWidth;
biWidth := T;
biSizeImage :=  0 ;
end;


ABitmap := TBitmap.Create;


{ Вращение с самого начала. }
MemoryStreamR.Seek( 0 , soFromBeginning);
{ Загружаем это снова в ABitmap. }
ABitmap.LoadFromStream(MemoryStreamR);


MemoryStreamR.Free;
end;

procedure RotateBitmap90DegreesClockwise(var ABitmap: TBitmap);
const

BitsPerByte =  8 ;

var

{
Целая куча переменных. Некоторые имеют дело только с одно- и четырех-битовыми
изображениями, другие только с восемью- и  24 -битовыми, а некоторые с обоими.
Любая переменная, оканчивающаяся символом 'R', имеет отношение к вращению изображения,
например если MemoryStream содержит исходное изображение, то MemoryStreamR - повернутое.
}
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; (* вложение *)
{

Эта программа осуществляет поворот изображений с разрешением меньшим, чем  8  бит на пиксел,
а имеено: черно-белые ( 1 -бит) и  16 -цветные ( 4 -бит) изображения. Имейте в виду, что
такие вещи, как  2 -битные изображения также могли бы вращаться, но Microsoft не включил
данный формат в свои спецификации и не поддерживает его.
}
var

X, Y: LongInt;
I: LongInt;
MaskBits, CurrentBits: Byte;
FirstMask, LastMask: Byte;
PLastScanLine: PByte;
FirstIndex, CurrentBitIndex: LongInt;
ShiftRightAmount, ShiftRightStart: LongInt;

begin 
{ Перемещаем PLastScanLine в первую колонку последней линии чередования bmpBufferR. }
PLastScanLine := bmpBufferR; (*$IFDEF Win32*) Inc(PLastScanLine, BytesPerScanLineR *
(PbmpInfoR^.biWidth -  1 ) ); (*$ELSE*) Win16Inc( Pointer(PLastScanLine),
BytesPerScanLineR * (PbmpInfoR^.biWidth -  1 ) ); (*$ENDIF*)


{ Устанавливаем индексирование. }
FirstIndex := BitsPerByte - BitCount;


{
Устанавливаем битовые маски:


Для черно-белого изображения,
LastMask  :=  00000001     и
FirstMask :=  10000000 


Для  4 -битного изображения,
LastMask  :=  00001111     и
FirstMask :=  11110000 


Зададим значения CurrentBits и MaskBits, так как мы будем перемещаться по ним:
Для черно-белых изображений:
 10000000 ,  01000000 ,  00100000 ,  00010000 ,  00001000 ,  00000100 ,  00000010 ,  00000001 
Для  4 -битных изображений:
 11110000 ,  00001111 


CurrentBitIndex определяет расстояние от крайнего правого бита
до позиции CurrentBits. Например, если мы находимся в одиннадцатой
колонке черно-белого изображения, CurrentBits равен
 11  mod  8  :=  3 , или  3 -й самый левый бит. Таким образом, крайне правый
бит должен переместиться на четыре позиции, чтобы попасть на позицию
CurrentBits. CurrentBitIndex как раз и хранит такое значение.
}
LastMask :=  1  shl BitCount -  1 ;
FirstMask := LastMask shl FirstIndex;


CurrentBits := FirstMask;
CurrentBitIndex := FirstIndex;


ShiftRightStart := BitCount * (PixelsPerByte -  1 );


{ Вот мясо. Перебираем в цикле все пиксели и соответственно вращаем. }
{ Помните что DIB'ы имеют происхождение противоположное DDB'сам. }


{ Счетчик Y указывает на текущую строчку исходного изображения. }
for Y :=  1  to PbmpInfoR^.biHeight do begin
PbmpBufferR := PLastScanLine;


{
Счетчик X указывает на текущую колонку пикселей исходного изображения.
Здесь мы имеем дело только с полностью заполненными байтами. Обработка
'частично заполненных' байтов происходит ниже.
}
for X :=  1  to WholeBytes do begin
{
Выбираем биты, начиная с  10000000  для черно-белых и
заканчивая  11110000  для  4 -битных изображений.
}
MaskBits := FirstMask;
{
ShiftRightAmount - сумма, необходимая для перемещения текущего байта
через весь путь (помните, я об этом говорил выше) в правую часть.
}
ShiftRightAmount := ShiftRightStart;
for I :=  1  to PixelsPerByte do begin
{
Вот гарнир. Берем текущий байт вращаемого изображения и маскируем его
с not CurrentBits. Гасятся нулями только биты CurrentBits, сам байт перемещается
без изменений. Пример: Для черно-белого изображения, если бы мы
находились в  11 -й колонке (см. пример выше), мы должны нулем погасить
 3 -й слева бит, то есть мы должны использовать PbmpBufferR^ и  11011111 .


Теперь рассмотрим наш текущий исходный байт. Для черно-белых изображений
мы организуем цикл с шагом через бит, в общей сложности для восьми пикселей.
Для  4 -битных изображений мы делаем цикл с обработкой четырех битов за проход для
двух пикселей. В любом случае мы делаем это через маскирование с
MaskBits ('PbmpBuffer^ и MaskBits'). Теперь нам нужно получить бит(ы)
из той колонки(ок), на которую отобразится CurrentBits. Мы это делаем с помощью
перемещения их в крайне правую часть байта ('shr ShiftRightAmount'),
затем сдвигая их налево с помощью вышеупомянутого
CurrentBitIndex ('shl CurrentBitIndex'). Дело в том, что хотя перемещение
вправо с параметром -n должно быть просто перемещением налево с параметром +n,
в Delphi это не работает. Итак, мы начинаем с первого байта, перемещая пиксели
в правую часть насколько это возможно незанятыми позициями.


Наконец, мы имеем наш исходный бит(ы), перемещенный на нужное место
с погашенными нулями битами. Последнее делаем непосредственно или с
помощью PbmpBufferR^ (гасим биты в CurrentBits, помните?).


Мда...  "Просто" . Ладно, поехали дальше.
}


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


{ Сдвигаем MaskBits для следующей итерации. }
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;


{ Если есть  "частично заполненный"  байт, самое время о нем позаботиться. }
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*)
Dec(PbmpBufferR, BytesPerScanLineR);
(*$ELSE*)
Win16Dec( Pointer(PbmpBufferR), BytesPerScanLineR );
(*$ENDIF*)
Dec(ShiftRightAmount, BitCount);
end;
(*$IFDEF Win32*)
Inc(PbmpBuffer);
(*$ELSE*)
Win16Inc( Pointer(PbmpBuffer),  1  );
(*$ENDIF*)
end;


{ Пропускаем заполнение. }
(*$IFDEF Win32*)
Inc(PbmpBuffer, PaddingBytes);
(*$ELSE*)
Win16Inc( Pointer(PbmpBuffer), PaddingBytes );
(*$ENDIF*)


if CurrentBits = LastMask then begin
{ Мы в конце этого байта. Начинаем с другой колонки. }
CurrentBits := FirstMask;
CurrentBitIndex := FirstIndex;
{ Идем вниз колонки вращаемого изображения , но одну колонку пропускаем. }
(*$IFDEF Win32*)
Inc(PLastScanLine);
(*$ELSE*)
Win16Inc( Pointer(PLastScanLine),  1  );
(*$ENDIF*)
end
else begin
{ Продолжаем заполнять этот байт. }
CurrentBits := CurrentBits shr BitCount;
Dec(CurrentBitIndex, BitCount);
end;
end;
end; { procedure NonIntegralByteRotate (* вложение *) }

procedure IntegralByteRotate; (* вложение *)
var

X, Y: LongInt;
(*$IFNDEF Win32*)
I: Integer;
(*$ENDIF*)

begin 
{ Перемещаем PbmpBufferR в первую колонку последней линии чередования bmpBufferR. }
(*$IFDEF Win32*)
Inc( PbmpBufferR, BytesPerScanLineR * (PbmpInfoR^.biWidth -  1 ) );
(*$ELSE*)
Win16Inc( Pointer(PbmpBufferR) , BytesPerScanLineR * (PbmpInfoR^.biWidth -  1 ) );
(*$ENDIF*)


{ Вот мясо. Перебираем в цикле все пиксели и соответственно вращаем. }
{ Remember that DIBs have their origins opposite from DDBs. }
for Y :=  1  to PbmpInfoR^.biHeight do begin
for X :=  1  to PbmpInfoR^.biWidth do begin
{ Копируем пиксели. }
(*$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*)
{ Пропускаем заполнение. }
Inc(PbmpBuffer, PaddingBytes);
{ Идем вверх колонки вращаемого изображения , но одну колонку пропускаем. }
Inc(PbmpBufferR, ColumnBytes + BytesPerPixel);
(*$ELSE*)
Win16Inc( Pointer(PbmpBuffer), PaddingBytes );
Win16Inc( Pointer(PbmpBufferR), ColumnBytes + BytesPerPixel );
(*$ENDIF*)
end;
end;

{ Это тело процедуры RotateBitmap90DegreesCounterClockwise. }
begin

{ Никогда сами не вызывайте GetDIBSizes! Это испортит ваше изображение. }


MemoryStream := TMemoryStream.Create;


{
Для работы: Прежде всего установим размер. Это устранит перераспределение памяти
для MemoryStream. Вызов GetDIBSizes будет к месту, но, как отмечалось выше,
это может исказить ваше изображение. Вызов некоторых API функций вероятно
позаботился бы об этом, но это тема отдельного разговора.
}


{ Недокументированный метод. Все же программист иногда сродни шаману. }
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;


{ Устанавливаем PbmpInfoR на указатель информационного заголовка исходного изображения. }
{ Эти заголовки могут немного раздражать, но они необходимы для работы. }
(*$IFDEF Win32*)
Inc( bmpBuffer, SizeOf(TBitmapFileHeader) );
(*$ELSE*)
Win16Inc( Pointer(bmpBuffer), SizeOf(TBitmapFileHeader) );
(*$ENDIF*)
PbmpInfoR := PBitmapInfoHeader(bmpBuffer);


{ Устанавливаем bmpBuffer и PbmpBuffer так, чтобы они указывали на биты оригинального изображения. }
bmpBuffer := MemoryStream.Memory;
(*$IFDEF Win32*)
Inc(bmpBuffer, BitmapOffset);
(*$ELSE*)
Win16Inc( Pointer(bmpBuffer), BitmapOffset );
(*$ENDIF*)
PbmpBuffer := bmpBuffer;


{
Имейте в виду, что нам не нужно беспокоиться о совместимости изображений версии  4  и  3 ,
поскольку области, которые мы используем, а именно  -- biWidth, biHeight, и biBitCount --
 
располагаются на один и тех же местах в обоих структурах. Итак, одной проблемой меньше.
Изображения версии OS/ 2 , между прочим, при этом гнусно рушатся. Обидно.
}
with PbmpInfoR^ do begin
{ ShowMessage('Компрессия := ' + IntToStr(biCompression)); }
BitCount := biBitCount;
{ ShowMessage('BitCount := ' + IntToStr(BitCount)); }


{ ScanLines -  "выровненный"  DWORD. }
BytesPerScanLine := ((((biWidth * BitCount) +  31 ) div  32 ) * SizeOf(DWORD));
BytesPerScanLineR := ((((biHeight * BitCount) +  31 ) div  32 ) * SizeOf(DWORD));


AtLeastEightBitColor := BitCount >= BitsPerByte;
if AtLeastEightBitColor then begin
{ Нас не должен волновать бит-тильда. Классно. }
BytesPerPixel := biBitCount shr  3 ;
SignificantBytes := biWidth * BitCount shr  3 ;
{ Дополнительные байты необходимы для выравнивания DWORD. }
PaddingBytes := BytesPerScanLine - SignificantBytes;
ColumnBytes := BytesPerScanLineR * biWidth;
end
else begin
{ Одно- или четырех-битовое изображение. Уфф. }
PixelsPerByte := SizeOf(Byte) * BitsPerByte div BitCount;
{ Все количество байтов полностью заполняется информацией о пикселе. }
WholeBytes := biWidth div PixelsPerByte;
{
Обрабатываем любые дополнительные биты, которые могут частично заполнять байт.
Например, черно-белое изображение, у которого  14  пикселей описываются каждый
соответственно своим байтом, плюс одним дополнительным, у которого на самом
деле используются  6  битов, остальное мусор.
}
ExtraPixels := biWidth mod PixelsPerByte;
{
Все дополнительные байты  -- если имеются -- требуется DWORD-выровнять по
 
линии чередования.
}
PaddingBytes := BytesPerScanLine - WholeBytes;
{
Если есть дополнительные биты (то есть имеется 'дополнительный байт'),
то один из заполненных байтов уже был принят во внимание.
}
if ExtraPixels <>  0  then Dec(PaddingBytes);
end; { if AtLeastEightBitColor then }


{ TMemoryStream, обслуживающий вращаемые биты. }
MemoryStreamR := TMemoryStream.Create;
{
Устанавливаем размер вращаемого изображения. Может отличаться
от исходного из-за выравнивания DWORD.
}
MemoryStreamR.SetSize(BitmapOffset + BytesPerScanLineR * biWidth);
end; { with PbmpInfoR^ do }


{ Копируем заголовки исходного изображения. }
MemoryStream.Seek( 0 , soFromBeginning);
MemoryStreamR.CopyFrom(MemoryStream, BitmapOffset);


{ Вот буфер, который мы будем  "вращать" . }
bmpBufferR := MemoryStreamR.Memory;
{ Пропускаем заголовки, yadda yadda yadda... }
(*$IFDEF Win32*)
Inc(bmpBufferR, BitmapOffset);
(*$ELSE*)
Win16Inc( Pointer(bmpBufferR), BitmapOffset );
(*$ENDIF*)
PbmpBufferR := bmpBufferR;


{ Едем дальше. }
if AtLeastEightBitColor then
IntegralByteRotate
else
NonIntegralByteRotate;


{ Удовлетворяемся исходными битами. }
MemoryStream.Free;


{ Теперь устанавливаем PbmpInfoR, чтобы он указывал на информационный заголовок вращаемого изображения. }
PbmpBufferR := MemoryStreamR.Memory;
(*$IFDEF Win32*)
Inc( PbmpBufferR, SizeOf(TBitmapFileHeader) );
(*$ELSE*)
Win16Inc( Pointer(PbmpBufferR), SizeOf(TBitmapFileHeader) );
(*$ENDIF*)
PbmpInfoR := PBitmapInfoHeader(PbmpBufferR);


{ Меняем ширину с высотой в информационном заголовке вращаемого изображения. }
with PbmpInfoR^ do begin
T := biHeight;
biHeight := biWidth;
biWidth := T;
biSizeImage :=  0 ;
end;


ABitmap := TBitmap.Create;


{ Вращение с самого начала. }
MemoryStreamR.Seek( 0 , soFromBeginning);
{ Загружаем это снова в ABitmap. }
ABitmap.LoadFromStream(MemoryStreamR);


MemoryStreamR.Free;
end;

procedure RotateBitmap180Degrees(var ABitmap: TBitmap);
var

RotatedBitmap: TBitmap;

begin

RotatedBitmap := TBitmap.Create;
with RotatedBitmap do begin
Width := ABitmap.Width;
Height := ABitmap.Height;
Canvas.StretchDraw( Rect(ABitmap.Width, ABitmap.Height,  0 ,  0 ), ABitmap );
end;
ABitmap.Free;
ABitmap := RotatedBitmap;
end;

end.