procedure RotateBitmap(Dest, Source: TBitmap; Winkel: Extended;
Hintergrund: TColor; GroesseAnpassen, ImUhrzeigersinn: Boolean);
var
rw: Boolean;
Breite: integer;
type
PR =
array[0..2]
of byte;
//PR = array[0..3] of byte;
FArray =
array[0..32768]
of PR;
procedure WTest;
begin
while Winkel > 360
do Winkel := Winkel - 360;
while Winkel < 0
do Winkel := Winkel + 360;
if ImUhrzeigersinn
then Winkel := 360 - Winkel;
end;
procedure SiCo(W: Extended;
var S, C: Extended);
asm
FLD W
FSINCOS
FSTP TBYTE PTR [EDX]
FSTP TBYTE PTR [EAX]
FWAIT
end;
function Maximum(M1, M2: Integer): Integer;
begin
if M1 > M2
then Result := M1
else Result := M2;
end;
procedure SC(WKL: Extended;
var S, C: Extended);
begin
WKL := WKL * (PI / 180);
SiCo(WKL, S, C);
end;
var
CT, ST: Extended;
I, J, X, Y, DstW, DstH, SrcWD2, SrcHD2: Integer;
SrcR, DstR: ^FArray;
begin
Source.PixelFormat := pf24bit;
//Source.PixelFormat := pf32bit;
Dest.PixelFormat := Source.PixelFormat;
WTest;
rw := frac(Winkel / 90) = 0;
SC(Winkel, ST, CT);
if GroesseAnpassen
then begin
if (ST * CT) < 0
then begin
Dest.Width := Round(Abs(Source.Width * CT
- Source.Height * ST));
Dest.Height := Round(Abs(Source.Width * ST
- Source.Height * CT));
end
else begin
Dest.Width := Round(Abs(Source.Width * CT
+ Source.Height * ST));
Dest.Height := Round(Abs(Source.Width * ST
+ Source.Height * CT));
end;
end else begin
Dest.Width := Source.Width;
Dest.Height := Source.Height;
end;
with Dest.Canvas
do begin
Brush.Style := bsSolid;
Brush.Color := Hintergrund;
FillRect(ClipRect);
end;
SrcWD2 := Source.Width
div 2;
if CT < 0
then Dec(SrcWD2);
SrcHD2 := Source.Height
div 2;
if ST < 0
then Dec(SrcHD2);
Breite := Maximum(Source.Width, Dest.Width) - 1;
for J := 0
to Maximum(Source.Height, Dest.Height) - 1
do begin
if rw
then
Y := Trunc(J - Dest.Height / 2 + 0.5)
else
Y := J - Dest.Height
div 2;
for I := 0
to Breite
do begin
if rw
then
X := Trunc(I - Dest.Width / 2)
else
X := I - Dest.Width
div 2;
DstW := Round(X * CT - Y * ST + SrcWD2);
DstH := Round(X * ST + Y * CT + SrcHD2);
if (DstH >= 0)
and (DstH < Source.Height)
and
(J >= 0)
and (J < Dest.Height)
and
(DstW >= 0)
and (DstW < Source.Width)
and
(I >= 0)
and (I < Dest.Width)
then begin
SrcR := Source.ScanLine[DstH];
DstR := Dest.Scanline[J];
DstR[I] := SrcR[DstW];
end;
end;
end;
end;
//Aufruf
procedure TForm1.Button1Click(Sender: TObject);
var Bmp: TBitmap;
begin
Bmp := TBitmap.create;
RotateBitmap(Bmp, Image1.picture.bitmap, 53.7, clRed, True, False);
Refresh;
canvas.draw(10, 10, Bmp);
Bmp.free;
end;