Delphi - объектно-ориентированный язык программирования, разработанный компанией Borland в 1995 году. Он основан на языке программирования Pascal, но имеет более расширенные возможности и добавлены новые функции.
Delphi является интегрированной средой разработки (IDE), которая позволяет разрабатывать программное обеспечение для различных платформ, включая Windows, macOS, Android и iOS. Delphi достигает многоплатформенности с помощью...
{ **** UBPFD *********** by delphibase.endimus.com **** >> Вращение изображения на заданный угол Зависимости: Windows, Classes, Graphics Автор: Fenik, chook_nu@uraltc.ru, Новоуральск Copyright: Автор Федоровских Николай Дата: 2 июня 2002 г. ***************************************************** } procedureRotateBitmap(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);