Советы по Delphi
Поворот изображения на 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 = recordL, H: Word;end; procedure Win16Dec(var P: Pointer; const N: LongInt); forward; procedure Win16Inc(var P: Pointer; const N: LongInt); begin if N < 0 thenWin16Dec(P, -N)else if N > 0 then beginInc( 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 thenWin16Inc(P, -N)else if N > 0 then beginif 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;asmmov 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 HugeShiftshl dx, { Перемещаем наибольшую величину суммы для сегмента. }add es:[bx+2], dx { Увеличиваем сегмент HugePtr. }mov es:[bx], axend; 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 thenWin16Inc(P, -N)else if N > 0 then beginif 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 beginPbmpBufferR := 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 beginPbmpBufferR^ := ( 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*)endelse 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 beginfor 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 beginPbmpBufferR^ := 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;endelse 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 thenIntegralByteRotateelseNonIntegralByteRotate; { Удовлетворяемся исходными битами. }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 beginT := 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 beginPbmpBufferR := 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 beginPbmpBufferR^ := ( 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*)endelse 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 beginfor 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 beginPbmpBufferR^ := 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;endelse 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 thenIntegralByteRotateelseNonIntegralByteRotate; { Удовлетворяемся исходными битами. }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 beginT := 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 beginWidth := ABitmap.Width;Height := ABitmap.Height;Canvas.StretchDraw( Rect(ABitmap.Width, ABitmap.Height, 0, 0), ABitmap );end;ABitmap.Free;ABitmap := RotatedBitmap;end; end. |
[000122]
