Поворот изображения на 90 градусов
Новый модуль имеет три программы: 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. |
[000122]
