SetWorldTransform

[lexaltd]

Помогите разобратся с SetWorldTransform
Мне нужно при каждом нажатии на кнопку поворачивать изображение , загруженное в Image на 90 градусов ( и Image тоже должен менять размер я так понимаю )

Пытаюсь делать так :

Загружаю изоброжение так:

if OpenPictureDialog1.Execute then
begin
Image1.Picture.LoadFromFile(OpenPic tureDialog1.FileName);
source.Assign(Image1.Picture);
end;

Пытаюсь поворачивать;

procedure TForm1.BitBtn1Click(Sender: TObject);
var
Matrix: TXForm;
Angle: Single;
begin
Angle:=90;
Matrix.eM11 := Cos(Angle);
Matrix.eM12 := Sin(Angle);
Matrix.eM21 := -Sin(Angle);
Matrix.eM22 := Cos(Angle);
Matrix.eDx := 0;
Matrix.eDy := 0;
SetWorldTransform(source.Handle, Matrix);
Image1.Canvas.Draw(0, 0, source);
ModifyWorldTransform(source.Handle, Matrix, MWT_IDENTITY);
end;

Я понимаю что при попытке переворачивать - где то бред написал.
Потому что при нажати на кнопку не чего не происходит.
Но я не нашёл не где норм описания SetWorldTransform , а с примерами те что нашёл тоже толком не смог разобратся.
Можете подсказать где ошибка ???
Или лучше привести рабочий пример с SetWorldTransform , чтоб я смог раздуплится как SetWorldTransform работает.

Зарание спасибо

[mihali4]

Может, лучше так?
Поворот изображения на N градусов

Поворот проще всего осуществляется в полярных кординатах, а у нас доступны только Декартовы. Перевод осуществляется по формулам:
x=LCos(@) L=Sqrt(x**2+y**2)
y=LSin(@) @=arctg(y/x)

Для поворота достаточно добавить к a угол, на который осуществляется поворот. И новые координаты будут выглядеть так:
x'=LCos(@+t)
y'=LSin(@+t)

В принципе это все. Давайте теперь напишем функцию, которая будет переводить координаты из старых в новые.

procedure NewCoord(Var X, Y : Integer; Alpha : Double);
Var
A, L:   Double;
Begin
// Вычисляем размер плеча
L:= Sqrt(X*X+Y*Y);
// Вычисляем угол поворота, но если X = 0, то на него делить нельзя, поэтому запишем угол равный PI/2
IF X = 0 THEN
IF Y  < 0 THEN
A:= -PI/2
ELSE
A:= PI/2
ELSE
A:= ArcTan(Y/X);
// Скорректируем значение угла (если X < 0, то угол должен лежать в диапазоне от PI/2 до 3PI/2)
IF X < 0 THEN
A:= A+PI;
// Вычисляем новые координаты
X:= Round(L*(Cos(A+Alpha)));
Y:= Round(L*(Sin(A+Alpha)));
End;

Единственный тонкий момент - это вычисление угла. Функция ArcTan возвращает значение в диапазоне -PI/2 до PI/2. Мы должны сами корректировать это значение в зависимости от аргументов.

Теперь, когда есть функция, напишем саму процедуру поворота.
Нам понадобятся 2 объекта TImage, поле для ввода угла поворота и кнопочка, по которой будет осуществляться поворот.
Загрузим в первый объект TImage картинку в формате bmp. А в обработчике события кнопки будем писать саму процедуру.

Var
N   :   Double;
I, J:   Integer;
XMax, YMax: Integer;
Max :   Integer;
X, Y:   Integer;
Xm, Ym, Xx, Yx: Integer;
L, A: Double;
begin
//Для начала преобразуем наш угол поворота в радианы
N:= -StrToFloat(Edit1.Text)*PI/180;
//Причем угол имеет обратное значение *
// Узнаем максимальные размеры изображения
XMax:= Image1.Width-1;
YMax:= Image1.Height-1;
// Получим координаты середины изображения (именно вокруг него мы и будем вращать)
X2:= XMax DIV 2;
Y2:= YMax DIV 2;
//Размеры будущего изображения
Xm:= 0; Xx:= 0; Ym:= 0; Yx:= 0;
//Определяем размер получаемого изображения
//левый верхний угол
X:= -X2; Y:= -Y2;
NewCoord(X, Y, -N);
X:= X+X2; Y:= Y+Y2;
IF X < Xm THEN
Xm:= X;
IF X > Xx THEN
Xx:= X;
IF Y < Ym THEN
Ym:= Y;
IF Y > Yx THEN
Yx:= Y;
//правый верхний угол
X:= X2; Y:= -Y2;
NewCoord(X, Y, -N);
X:= X+X2; Y:= Y+Y2;
IF X < Xm THEN
Xm:= X;
IF X > Xx THEN
Xx:= X;
IF Y < Ym THEN
Ym:= Y;
IF Y > Yx THEN
Yx:= Y;
//правый нижний угол
X:= X2; Y:= Y2;
NewCoord(X, Y, -N);
X:= X+X2; Y:= Y+Y2;
IF X < Xm THEN
Xm:= X;
IF X > Xx THEN
Xx:= X;
IF Y < Ym THEN
Ym:= Y;
IF Y > Yx THEN
Yx:= Y;
//левый нижний угол
X:= -X2; Y:= Y2;
NewCoord(X, Y, -N);
X:= X+X2; Y:= Y+Y2;
IF X < Xm THEN
Xm:= X;
IF X > Xx THEN
Xx:= X;
IF Y < Ym THEN
Ym:= Y;
IF Y > Yx THEN
Yx:= Y;
//Теперь мы знаем размеры изображения, которое получится
Image2.Width:= Xx-Xm;
Image2.Height:= Yx-Ym;
//Идем по координатам полученной картинки и вычисляем для них координаты исходного изображения
FOR I:= Xm TO Xx DO 
FOR J:= Ym TO Yx DO 
Begin
//Получаем координаты точки изображения относительно его центра
X:= I-X2;
Y:= J-Y2;
//Преобразовываем
NewCoord(X, Y, N);
//Переходим к абсолютным координатам
X:= X+X2; Y:= Y+Y2;
//Если координаты точки не попадают в исходное изображение, то рисуем простую белую точку
IF (X > Image1.Width-1) OR (Y > Image1.Height-1) OR (X < 0) OR (Y < 0) THEN
Image2.Canvas.Pixels[I-Xm, J-Ym]:= clWhite
ELSE // иначе переносим точку с изображения оригинала
Image2.Canvas.Pixels[I-Xm, J-Ym]:= Image1.Canvas.Pixels[X, Y];
End;
//Все поворот завершен
End;

* Нам необходимо, чтобы каждая точка нового изображения соответствовала точкe из старого изображения. Поэтому мы, грубо говоря, осуществляем поворот нового изображения на угол -N. Получая соответствующую координату/ мы получим точку исходного изображения.

[lexaltd]

Спасибо mihali4 за ответ (если не получется с SetWorldTransform то будем пробывать так )
Но хотелось разобратся SetWorldTransform

[alexBlack]

еще пример:

var B:TBitMap;
procedure TForm2.FormCreate(Sender: TObject);
var M:TXFORM;
    a:Double;
    HDC:THandle;
begin
   B := TBitMap.Create;
   B.LoadFromFile('logo.bmp');

   hDc := image1.Canvas.Handle;
   SetGraphicsMode(hDc, GM_ADVANCED);

   M.eM11 := 1;
   M.eM12 := 0;
   M.eM21 := 0;
   M.eM22 := 1;
   M.eDx := -B.Width div 2;
   M.eDy := -B.Height div 2;
   SetWorldTransform(hDc, M);

   a := PI/6;
   fillChar(M, sizeOf(M), 0);
   M.eM11 := Cos(a);
   M.eM12 := Sin(a);
   M.eM21 := -Sin(a);
   M.eM22 := Cos(a);
   M.eDx := 0;
   M.eDy := 0;
   ModifyWorldTransform(hDc, M, MWT_RIGHTMULTIPLY);

   M.eM11 := 1;
   M.eM12 := 0;
   M.eM21 := 0;
   M.eM22 := 1;
   M.eDx := B.Width div 2;
   M.eDy := B.Height div 2;
   ModifyWorldTransform(hDc, M, MWT_RIGHTMULTIPLY);

   image1.Canvas.Draw(0, 0, b);
// или BitBlt(hDc, 0, 0, image1.Width, image1.Height, B.Canvas.Handle, 0, 0, SRCCOPY);
end;

[mihali4]

To alexBlack
Хороший пример, как раз то, что просил автор. Я бы только чуток переделал начало:

var  B: TBitMap;
begin
   B := TBitMap.Create;
   //B.LoadFromFile('logo.bmp');
   B.Assign(Image1.Picture.Bitmap);

и конец:

   B.Free;
end;

Ну и всю эту процедуру в обработчик procedure TForm1.BitBtn1Click(Sender: TObject); а не procedure TForm2.FormCreate(Sender: TObject);

[lexaltd]

Спасибо большое - это то что доктор прописал

[Лукманов Александр]

Простите, что поднимаю старую тему. Но возник вопрос.

от mihali4

var  B: TBitMap;
begin
   B := TBitMap.Create;
   //B.LoadFromFile('logo.bmp');
   B.Assign(Image1.Picture.Bitmap);

//и конец:

   B.Free;
end;

В таком случае новое изображение накладывается на старое. Ломал голову, но так и не понял где (и как) в коде старое изображение "удалять". Подскажите пожалуйста.

[snake-as]

Понимаю, что тема относительно старая, но мне ОЧЕНЬ помог описанный здесь пример. Большое спасибо автору и тому кто этот код здесь написал(может, это и один человек)