Карта сайта Kansoftware
НОВОСТИУСЛУГИРЕШЕНИЯКОНТАКТЫ
KANSoftWare

Вращение изображения на заданный угол

Delphi , Графика и Игры , Bitmap



Автор: Fenik
WEB-сайт: http://delphibase.endimus.com

{ **** UBPFD *********** by delphibase.endimus.com ****
>> 
Зависимости: Windows, Classes, Graphics
Автор:       Fenik, chook_nu@uraltc.ru, Новоуральск
Copyright:   Автор Федоровских Николай
Дата:        2 июня 2002 г.
***************************************************** }

procedure RotateBitmap(Bitmap: TBitmap; Angle: Double; BackColor: TColor);
type
  TRGB = record
    B, G, R: Byte;
  end;
  pRGB = ^TRGB;
  pByteArray = ^TByteArray;
  TByteArray = array[0..32767] of Byte;
  TRectList = array[1..4] of TPoint;

var
  x, y, W, H, v1, v2: Integer;
  Dest, Src: pRGB;
  VertArray: array of pByteArray;
  Bmp: TBitmap;

  procedure SinCos(AngleRad: Double; var ASin, ACos: Double);
  begin
    ASin := Sin(AngleRad);
    ACos := Cos(AngleRad);
  end;

  function RotateRect(const Rect: TRect; const Center: TPoint; Angle: Double):
    TRectList;
  var
    DX, DY: Integer;
    SinAng, CosAng: Double;
    function RotPoint(PX, PY: Integer): TPoint;
    begin
      DX := PX - Center.x;
      DY := PY - Center.y;
      Result.x := Center.x + Round(DX * CosAng - DY * SinAng);
      Result.y := Center.y + Round(DX * SinAng + DY * CosAng);
    end;
  begin
    SinCos(Angle * (Pi / 180), SinAng, CosAng);
    Result[1] := RotPoint(Rect.Left, Rect.Top);
    Result[2] := RotPoint(Rect.Right, Rect.Top);
    Result[3] := RotPoint(Rect.Right, Rect.Bottom);
    Result[4] := RotPoint(Rect.Left, Rect.Bottom);
  end;

  function Min(A, B: Integer): Integer;
  begin
    if A < B then
      Result := A
    else
      Result := B;
  end;

  function Max(A, B: Integer): Integer;
  begin
    if A > B then
      Result := A
    else
      Result := B;
  end;

  function GetRLLimit(const RL: TRectList): TRect;
  begin
    Result.Left := Min(Min(RL[1].x, RL[2].x), Min(RL[3].x, RL[4].x));
    Result.Top := Min(Min(RL[1].y, RL[2].y), Min(RL[3].y, RL[4].y));
    Result.Right := Max(Max(RL[1].x, RL[2].x), Max(RL[3].x, RL[4].x));
    Result.Bottom := Max(Max(RL[1].y, RL[2].y), Max(RL[3].y, RL[4].y));
  end;

  procedure Rotate;
  var
    x, y, xr, yr, yp: Integer;
    ACos, ASin: Double;
    Lim: TRect;
  begin
    W := Bmp.Width;
    H := Bmp.Height;
    SinCos(-Angle * Pi / 180, ASin, ACos);
    Lim := GetRLLimit(RotateRect(Rect(0, 0, Bmp.Width, Bmp.Height), Point(0, 0),
      Angle));
    Bitmap.Width := Lim.Right - Lim.Left;
    Bitmap.Height := Lim.Bottom - Lim.Top;
    Bitmap.Canvas.Brush.Color := BackColor;
    Bitmap.Canvas.FillRect(Rect(0, 0, Bitmap.Width, Bitmap.Height));
    for y := 0 to Bitmap.Height - 1 do
    begin
      Dest := Bitmap.ScanLine[y];
      yp := y + Lim.Top;
      for x := 0 to Bitmap.Width - 1 do
      begin
        xr := Round(((x + Lim.Left) * ACos) - (yp * ASin));
        yr := Round(((x + Lim.Left) * ASin) + (yp * ACos));
        if (xr > -1) and (xr < W) and (yr > -1) and (yr < H) then
        begin
          Src := Bmp.ScanLine[yr];
          Inc(Src, xr);
          Dest^ := Src^;
        end;
        Inc(Dest);
      end;
    end;
  end;

begin
  Bitmap.PixelFormat := pf24Bit;
  Bmp := TBitmap.Create;
  try
    Bmp.Assign(Bitmap);
    W := Bitmap.Width - 1;
    H := Bitmap.Height - 1;
    if Frac(Angle) <> 0.0 then
      Rotate
    else
      case Trunc(Angle) of
        -360, 0, 360, 720: Exit;
        90, 270:
          begin
            Bitmap.Width := H + 1;
            Bitmap.Height := W + 1;
            SetLength(VertArray, H + 1);
            v1 := 0;
            v2 := 0;
            if Angle = 90.0 then
              v1 := H
            else
              v2 := W;
            for y := 0 to H do
              VertArray[y] := Bmp.ScanLine[Abs(v1 - y)];
            for x := 0 to W do
            begin
              Dest := Bitmap.ScanLine[x];
              for y := 0 to H do
              begin
                v1 := Abs(v2 - x) * 3;
                with Dest^ do
                begin
                  B := VertArray[y, v1];
                  G := VertArray[y, v1 + 1];
                  R := VertArray[y, v1 + 2];
                end;
                Inc(Dest);
              end;
            end
          end;
        180:
          begin
            for y := 0 to H do
            begin
              Dest := Bitmap.ScanLine[y];
              Src := Bmp.ScanLine[H - y];
              Inc(Src, W);
              for x := 0 to W do
              begin
                Dest^ := Src^;
                Dec(Src);
                Inc(Dest);
              end;
            end;
          end;
      else
        Rotate;
      end;
  finally
    Bmp.Free;
  end;
end;

Пример использования:

RotateBitmap(FBitmap, 17.23, clWhite); 

Here is the translation of the text into Russian:

Процедура RotateBitmap

Процедура RotateBitmap принимает три параметра:

  1. Bitmap: объект TBitmap, представляющий изображение, которое необходимо повернуть.
  2. Angle: вещественное значение, представляющее угол поворота в градусах.
  3. BackColor: целевое значение TColor, представляющее фоновую цветовую схему выводимого битмапа.

Локальные переменные и типы

Код определяет несколько локальных переменных и типов:

  1. TRGB: рекордный тип, представляющий одиночную пиксель с тремя байтами для красного, зеленого и синего цветов (R,G,B).
  2. pRGB: указательный тип, указывающий на запись TRGB.
  3. pByteArray: указательный тип, указывающий на массив байтов.
  4. TByteArray: массивный тип, представляющий массив байтов.
  5. TRectList: массивный тип, представляющий массив из четырех структур TPoint, которые будут использоваться для хранения углов поворота прямоугольника.

Помощники и функции

Код определяет несколько вспомогательных процедур и функций:

  1. SinCos: процедура для расчета значений синуса и косинуса для заданного угла в радах.
  2. RotateRect: функция для поворота прямоугольника вокруг его центра по указанному углу, возвращая массив из четырех поворотных точек.
  3. GetRLLimit: функция для расчета ограничивающего прямоугольника (минимум/максимум координат x и y) из массива поворотных точек.
  4. Min и Max: две простые функции для возвращения минимального или максимального значения между двумя целыми числами.

Основная процедура

Основная процедура RotateBitmap выполняет следующие шаги:

  1. Она устанавливает формат пикселей входного битмапа в 24-битное цветовое пространство (pf24Bit).
  2. Она создает новый объект TBitmap и присваивает его входному битмапу.
  3. Она рассчитывает ширину и высоту входного битмапа.
  4. Если угол поворота не является точным множителем 90 градусов, она вызывает процедуру Rotate для выполнения поворота.
  5. В противном случае она использует предопределенные значения для поворота изображения на 0, 90, 180 или 270 градусов.

Предварительный расчет и поворот

Для углов поворота в 90, 180 или 270 градусов код выполняет простую трансформацию данных пикселей для достижения желаемого поворота. Для других углов она вызывает процедуру Rotate для выполнения поворота с использованием тригонометрических функций (синуса и косинуса).

Логика поворота

Процедура Rotate выполняет следующие шаги:

  1. Она рассчитывает значения синуса и косинуса для заданного угла.
  2. Она рассчитывает ограничивающий прямоугольник входного битмапа на основе поворотных углов.
  3. Она устанавливает фоновую цветовую схему выводимого битмапа в указанное значение.
  4. Она итерирует по каждому пикселю в выводимом битмапе, рассчитывая его позицию на основе угла поворота и тригонометрических функций.
  5. Для пикселей, которые попадают в пределы исходного изображения, она копирует соответствующие данные пикселей из входного битмапа.

Пример использования

Код предоставляет пример использования процедуры RotateBitmap:

RotateBitmap(FBitmap, 17.23, clWhite);

Это поворачивает изображение, хранящееся в FBitmap, на приблизительно 17,23 градуса вокруг центра, с фоновой цветовой схемой белого цвета (clWhite).

В статье описывается процедура вращения изображения на заданный угол в программировании на языке Delphi.


Комментарии и вопросы

Получайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш Telegram-канал delphi_kansoftware и будьте в курсе последних тенденций в разработке под Linux, Windows, Android и iOS




Материалы статей собраны из открытых источников, владелец сайта не претендует на авторство. Там где авторство установить не удалось, материал подаётся без имени автора. В случае если Вы считаете, что Ваши права нарушены, пожалуйста, свяжитесь с владельцем сайта.


:: Главная :: Bitmap ::


реклама


©KANSoftWare (разработка программного обеспечения, создание программ, создание интерактивных сайтов), 2007
Top.Mail.Ru

Время компиляции файла: 2024-12-22 20:14:06
2025-06-16 00:32:05/0.0037150382995605/0