Поворот изображения

[Armageddets]

Доброго времени суток, уважаемые эксперты. У меня стоит задача создать алгоритм поворота изображения на заданный угол в делфи. Но желательно без подключения дополнительных библиотек (все стандартными средствами). Алгоритм должен вместиться в одну процедуру, чтобы не нужно было еще дополнительно прописывать какие-то константы или классы, записи вне процедуры. Заданный угол может быть абсолютно любым. Скорость работы такого алгоритма мне не важна - подойдет даже очень медленный. Я вот знаю можно к пикселям добраться через TBitmap.Pixels[i,j], но я никак не могу подобрать формулу которая бы могла нормально (без искажения) повернуть изображение. Например поворот на 90 градусов я делаю так:

var X,Y,C: uint;
begin
for X:=0 to image1.picture.width-1 do begin
for Y:=0 to image1.picture.Height-1 do begin
C:=image1.Canvas.Pixels[x,y];
image2.Canvas.Pixels[Y,X]:=C;
end;

А вот если я начинаю добавлять в формулу синусы, косинусы и угол то при повороте изображение очень сильно начинает страдать:

procedure IMGRotate(IMG:TBitmap; Angle:single);
var X,Y,Cell: uint;
buf:TBitmap;
x0,y0:Integer; //center katrinki
r:Single;
sinus, cosinus: Extended;
begin
Buf:=TBitmap.Create;
Buf.Width:=IMG.Height;
Buf.Height:=IMG.Width;
//x0:=0; y0:=0;
x0 := img.Width div 2;
y0 := img.Height div 2;
Angle:=1;
for X:=0 to IMG.width-1 do
begin
for Y:=0 to IMG.Height-1 do
begin
r := sqrt(sqr(X - x0) + sqr(Y - y0));
SinCos(angle + arctan2((y - y0), (x - x0)), sinus, cosinus);
Buf.Canvas.Pixels[x,y]:=img.Canvas.Pixels[round(x0+r*cosinus), round(y0+r*sinus)];
if (Buf.Canvas.Pixels[x,y]=clWhite) then
Buf.Canvas.Pixels[x,y]:=Buf.TransparentColor;
end;
end;
IMG.Canvas.Draw(0,0,Buf);
Buf.FreeImage;
Buf.Free;
end;

Можно ли подправить мой алгоритм или хотя бы подобрать формулу по которой можно было бы нормально пиксели расставить при поворотах. Я нашел кучу информации, но это или с помошью дополнительных библиотек или куча процедур вместо одной или нужно вне процедуры обьявлять что-то. Заранее спасибо.

[type_Oleg]

Ну, рисовать по пикселам - это моветон.
Лучше используйте методы Канвы - LineTo, MoveTo.
Например, создайте процедуру рисования прямоугольника по заданным вершинам v1,v2,v3,v4:

procedure pRect(v1,v2,v3,v4:TPoint;can:TCanvas);
begin
 // здесь рисование с помощью LineTo, MoveTo
end;

И процедуру поворота, то есть по заданному углу alpha и вершинам v1,v2,v3,v4 поиск новых вершин v1new,v2new,v3new,v4new

procedure pRotat(alpha:Double; v1,v2,v3,v4:TPoint;var v1new,v2new,v3new,v4new:TPoint);
begin
 // здесь расчеты 
end;

В качестве v1 - та вершина, вокруг которой поворот. Остальные перечисляются по часовой стрелке.

[Armageddets]

Спасибо за совет. Неплохой вариант. Но вот с расчетами у меня как раз и проблемы. Я не могу формулу подобрать.

[type_Oleg]

Вот, построение прямоугольника, это конечно проще поворота.

procedure pRect(v1,v2,v3,v4:TPoint;can:TCanvas);
begin
 with can do
  begin
   MoveTo(v1.X,v1.Y);
   LineTo(v2.X,v2.Y);
   LineTo(v3.X,v3.Y);
   LineTo(v4.X,v4.Y);
   LineTo(v1.X,v1.Y);
  end;
end;

А повороты вершин - сами делайте.
Имеем точки A, B , надо повернуть на alpha точку B вокруг точки A. Координаты, синусы, косинусы.

[Armageddets]

Ну построить и отобразить прямоугольник - это не проблема. Повернуть изображение на 90 или 180 градусов тоже. Но когда нужно повернуть на произвольный угол типа на 1 градус или 6 градусов - изображение по моему алгоритму поворачивается, но изображение начинает размываться, а значит алгоритм не правильный. Ладно, если никто ничего не посоветует по поводу формул - буду сам пытаться выводить их. Просто уже 2 суток на это потратил. В любом случае благодарен тебе за советы - я их приму во внимание. Еще раз спасибо.

[type_Oleg]

Держите. Работает. На рисунке - результат одного клика на Батон1, и трех - на Батон2. На форму кроме Батонов положите еще Image.
Дорабатывайте для того, чтобы вводить начальные координаты, угол поворота ...

//  .... 
var
  Form1: TForm1;
  v1,v2,v3,v4:TPoint;
implementation

{$R *.dfm}
  // рисование прямоугольника по вершинам
procedure pRect(v1,v2,v3,v4:TPoint;can:TCanvas);
begin
 with can do
  begin
   MoveTo(v1.X,v1.Y);
   LineTo(v2.X,v2.Y);
   LineTo(v3.X,v3.Y);
   LineTo(v4.X,v4.Y);
   LineTo(v1.X,v1.Y);
  end;
end;
 // поворот одной точки вокруг другой на угол alph ( в радианах )
function fRotatV2(v1,v2:TPoint;alph:Double):TPoint;
begin
 Result.X:=Round(v1.X+(v2.X-v1.X)*Cos(alph)-(v2.Y-v1.Y)*Sin(alph));
 Result.Y:=Round(v1.Y+(v2.X-v1.X)*Sin(alph)+(v2.Y-v1.Y)*Cos(alph));
end;
 // поворот прямоугольника вокруг вершины v1
procedure pRotat(alpha:Double; v1,v2,v3,v4:TPoint;var v1new,v2new,v3new,v4new:TPoint);
begin
 v1new:=v1;
 v2new:=fRotatV2(v1,v2,alpha);
 v3new:=fRotatV2(v1,v3,alpha);
 v4new:=fRotatV2(v1,v4,alpha);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
 v1.X:=30;
 v1.Y:=30;
 v2.X:=v1.X+80;
 v2.Y:=v1.Y;
 v3.X:=v2.X;
 v3.Y:=v1.Y+50;
 v4.X:=v1.X;
 v4.Y:=v3.Y;
 pRect(v1,v2,v3,v4,Image1.Canvas);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
 pRotat(15*PI/180,v1,v2,v3,v4,v1,v2,v3,v4); // поворот на 15 град
 pRect(v1,v2,v3,v4,Image1.Canvas);
end;

end.

[Armageddets]

Огромное спасибо! Дальше, думаю разберусь. Главное, что есть формулы поворота вокруг точки.

[XE5]

type_Oleg А если нужно повернуть картинку?

[type_Oleg]

Сообщение от XE5

type_Oleg А если нужно повернуть картинку?

Да, у меня только поворот 4-угольника. Я написал прямоугольник, на самом деле любой 4-угольник.

А вообще, любую растровую картинку - да, наверное только через пикселы. Пусть использует функцию fRotatV2 Только надо удалять старое изображение сначала

[XE5]

Тогда предложу такой вариант