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

Советы » Bitmap » Вращение изображения на заданный угол

{ **** 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); 

Другое по теме:

Категории

Статьи

Советы

Copyright © 2022 - All Rights Reserved - www.delphirus.com