Resim çevirme-03

procedure RotateBitmap(var hBitmapDC : Longint; var lWidth : Longint;
var lHeight : Longint; lRadians : real);
begin
hNewBitmapDC := CreateCompatibleDC(hBitmapDC);
lSine := Sin(lRadians);
lCosine := Cos(lRadians);
X1 := Round(-lHeight * lSine);
Y1 := Round(lHeight * lCosine);
X2 := Round(lWidth * lCosine - lHeight * lSine);
Y2 := Round(lHeight * lCosine + lWidth * lSine);
X3 := Round(lWidth * lCosine);
Y3 := Round(lWidth * lSine);
lMinX := Min(0, Min(X1, Min(X2, X3)));
lMinY := Min(0, Min(Y1, Min(Y2, Y3)));
lMaxX := Max(X1, Max(X2, X3));
lMaxY := Max(Y1, Max(Y2, Y3));
lNewWidth := lMaxX - lMinX;
lNewHeight := lMaxY - lMinY;
hNewBitmap := CreateCompatibleBitmap(hBitmapDC, lNewWidth, lNewHeight);
SelectObject(hNewBitmapDC, hNewBitmap);
For I := 0 To lNewHeight do begin
For J := 0 To lNewWidth do begin
lSourceX := Round((J +lMinX) * lCosine + (I + lMinY) * lSine);
lSourceY := Round((I + lMinY) * lCosine - (J + lMinX) * lSine);
If (lSourceX >= 0) And (lSourceX <= lWidth) And
(lSourceY >= 0) And (lSourceY <= lHeight) Then
BitBlt(hNewBitmapDC, J, I, 1, 1, hBitmapDC,
lSourceX, lSourceY, SRCCOPY);
end;
end;
lWidth := lNewWidth;
lHeight := lNewHeight;
hBitmapDC := hNewBitmapDC;
DeleteObject(hNewBitmap);
End;

procedure TForm1.Rotate1Click(Sender: TObject);
var lRadians : real;
DC : longint;
H, W : integer;
Degrees : integer;
begin
Degrees := 90;
lRadians := PI * Degrees / 180;
DC := Image1.Picture.Bitmap.Canvas.Handle;
H := Image1.Picture.Bitmap.Height;
W := Image1.Picture.Bitmap.Width;
RotateBitmap(DC, W, H, lRadians);
Image1.Width := W;
Image1.Height := H;
Image1.Picture.Bitmap.Width := W;
Image1.Picture.Bitmap.Height := H;
BitBlt(Image1.Picture.Bitmap.Canvas.Handle, 0, 0, W, H, DC, 0, 0, SRCCopy);
Image1.Refresh;
end;