Delphi - база знаний


Как повернуть Bitmap на любой угол


Как повернуть Bitmap на любой угол



ConstPixelMax = 32768;
Type
  pPixelArray  =  ^TPixelArray;
  TPixelArray  =  Array[0..PixelMax-1] Of TRGBTriple;

Procedure RotateBitmap_ads(
  SourceBitmap   : TBitmap;
  out DestBitmap : TBitmap;
  Center         : TPoint;
  Angle          : Double);
Var
  cosRadians          : Double;
  inX                 : Integer;
  inXOriginal         : Integer;
  inXPrime            : Integer;
  inXPrimeRotated     : Integer;
  inY                 : Integer;
  inYOriginal         : Integer;
  inYPrime            : Integer;
  inYPrimeRotated     : Integer;
  OriginalRow         : pPixelArray;
  Radians             : Double;
  RotatedRow          : pPixelArray;
  sinRadians          : Double;
begin
  DestBitmap.Width    := SourceBitmap.Width;
  DestBitmap.Height   := SourceBitmap.Height;
  DestBitmap.PixelFormat := pf24bit;
  Radians             := -(Angle) * PI / 180;
  sinRadians          := Sin(Radians);
  cosRadians          := Cos(Radians);
  For inX             := DestBitmap.Height-1 Downto 0 Do
  Begin
    RotatedRow        := DestBitmap.Scanline[inX];
    inXPrime          := 2*(inX - Center.y) + 1;
    For inY           := DestBitmap.Width-1 Downto 0 Do
    Begin
      inYPrime        := 2*(inY - Center.x) + 1;
      inYPrimeRotated := Round(inYPrime * CosRadians - inXPrime * sinRadians);
      inXPrimeRotated := Round(inYPrime * sinRadians + inXPrime * cosRadians);
      inYOriginal     := (inYPrimeRotated - 1) Div 2 + Center.x;
      inXOriginal     := (inXPrimeRotated - 1) Div 2 + Center.y;
      If
        (inYOriginal  >= 0)                    And
        (inYOriginal  <= SourceBitmap.Width-1) And
        (inXOriginal  >= 0)                    And
        (inXOriginal  <= SourceBitmap.Height-1)
      Then
      Begin
        OriginalRow   := SourceBitmap.Scanline[inXOriginal];
        RotatedRow[inY]  := OriginalRow[inYOriginal]
      End
      Else
      Begin
        RotatedRow[inY].rgbtBlue  := 255;
        RotatedRow[inY].rgbtGreen := 0;
        RotatedRow[inY].rgbtRed   := 0
      End;
    End;
  End;
End;

{Usage:}
procedure TForm1.Button1Click(Sender: TObject);
Var
  Center : TPoint;
  Bitmap : TBitmap;
begin
  Bitmap := TBitmap.Create;
  Try
    Center.y := (Image.Height  div 2)+20;
    Center.x := (Image.Width div 2)+0;
    RotateBitmap_ads(
      Image.Picture.Bitmap,  
      Bitmap,  
      Center,  
      Angle);
    Angle := Angle + 15;
    Image2.Picture.Bitmap.Assign(Bitmap);
  Finally
    Bitmap.Free;
  End;
end;

Взято с Исходников.ru


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(Image1.Picture.Bitmap, StrToInt(Edit1.Text), clWhite);

Взято из





Начало  Назад  Вперед



Книжный магазин