Полезное для программистов:

Фриланс
Новости
Статьи
   
Рубрики:

Error. Page cannot be displayed. Please contact your service provider for more details. (12)


Вращение изображения

Поиск:
Вот быстрый и примитивный способ вращения изображения. Должно работать. По крайней мере хоть какой-то выход из-положения, поскольку Windows этого делать не умеет. Но сначала попробуйте на небольший изображениях.

Код
procedure RotateRight(BitMap: tImage);
var
 FirstC, LastC, c, r: integer;

 procedure FixPixels(c, r: integer);
 var
   SavePix, SavePix2: tColor;
   i, NewC, NewR: integer;
 begin
   SavePix := Bitmap.Canvas.Pixels[c, r];
   for i := 1 to 4 do
   begin
     newc := BitMap.Height - r + 1;
     newr := c;
     SavePix2 := BitMap.Canvas.Pixels[newc, newr];
     Bitmap.Canvas.Pixels[newc, newr] := SavePix;
     SavePix := SavePix2;
     c := Newc;
     r := NewR;
   end;
 end;

begin
 if BitMap.Width <> BitMap.Height then
   exit;
 BitMap.Visible := false;
 with Bitmap.Canvas do
 begin
   firstc := 0;
   lastc := BitMap.Width;
   for r := 0 to BitMap.Height div 2 do
   begin
     for c := firstc to lastc do
     begin
       FixPixels(c, r);
     end;
     inc(FirstC);
     Dec(LastC);
   end;
 end;
 BitMap.Visible := true;
end;


Взято с http://delphiworld.narod.ru

--------------------------------------------------------------------------------

...я думаю над принудительным грубым методом, но его эффективность может быть сомнительна, и не вздумайте пробовать его без сопроцессора!

Сделайте наложение пиксель-на-пиксель из исходного изображение на целевой (используя свойство Canvas.Pixels). Для каждого пикселя осуществите преобразование полярных координат, добавьте компенсирующий угол к полярной координате, затем спозиционируйте это обратно на координаты прямоугольника, и разместите пиксель с новыми координатами на целевом изображении. Также вы можете добавлять какой-либо псевдослучайный пиксель через определенное их количество, если хотите задать какую-то точность вашей операции.

Для преобразования X- и Y-координат объявлены следующие переменные:

X,Y = старые координаты пикселя
X1,Y1 = новые координаты пикселя
T = угол вращения (в радианах)

R, A - промежуточные величины, представляющие собой полярные координаты

R = Sqrt(Sqr(X) + Sqr(Y));

A = Arctan(Y/X);

X1 = R * Cos(A+T);

Y1 = R * Sin(A+T);
Я отдаю себе отчет, что это не оптимальное решение, поэтому, если вы найдете еще какое-либо решение, дайте мне знать. В действительности мой метод работает, но делает это очень медленно.

Создайте наложение пиксель-на-пиксель исходного изображение на целевое (используя свойство Canvas.Pixels).
...это хорошее начало, но я думаю другой способ будет немного лучшим. Создайте наложение пиксель-на-пиксель целевого изображения на исходное так, чтобы нам было нужно вычислять откуда брать нужные пиксели, а не думать над тем, куда их нужно поместить.

Для начала вот мой вариант формулы вращения:

x, y = координаты в целевом изображении
t = угол
u, v = координаты в исходном изображении

x = u * cos(t) - v * sin(t)
y = v * cos(t) + u * sin(t)
Теперь, если я захочу решить эти уравнения и вычислить u и v (привести их к правой части уравнения), то формулы будут выглядеть следующим образом (без гарантии, по этой причине я и включил исходные уравнения!):
x * cos(t) + y
u = --------------------
sqr(cos(t)) + sin(t)

v = y * cos(t) - x
--------------------
sqr(cos(t)) + sin(t)
Так, подразумевая, что вы уже знаете угол вращения, можно вычислить константы cos(t) и 1/sqr(cos(t))+sin(t) непосредственно перед самим циклом; это может выглядеть примерно так (приблизительный код):

Код

ct := cos(t);
ccst := 1/sqr(cos(t))+sin(t);
for x := 0 to width do

for y := 0 to height do
dest.pixels[x,y] := source.pixels[Round((x * ct + y) * ccst),
Round((y * ct - x) * ccst)];


Если вы хотите ускорить этот процесс, и при этом волнуетесь за накопление ошибки округления, то вам следует обратить внимание на используемую нами технологию: мы перемещаем за один раз один пиксель, дистанция между пикселями равна u, v содержит константу, определяющую колонку с перемещаемым пикселем. Я использую расчитанные выше переменные как рычаг с коротким плечом (с вычисленной длиной и точкой приложения). Просто поместите в (x,y) = (1,0) и (x,y) = (0,1) и уравнение, приведенное выше:

Код

duCol := ct * ccst;
dvCol := -ccst;

duRow := ccst;
dvRow := ct * ccst;

uStart := 0;
vStart := 0;

for x := 0 to width do
begin
 u := uStart;
 v := vStart;
 for y := 0 to height do
 begin
   dest.pixels[x, y] := source.pixels[Round(u), Round(v)];
   u := u + rowdu;
   v := v + rowdv;
 end;
 uStart := uStart + duCol;
 vStart := vStart + dvCol;
end;



Приведенный выше код можно использовать "как есть", и я не даю никаких гарантий отностительно его использования!

Если вы в душе испытатель, и хотите попробовать вращение вокруг произвольной точки, попробуйте поиграться со значенияим u и v:

Xp, Yp (X-sub-p, Y-sub-p) точка оси вращения, другие константы определены выше
x = Xp + (u - Xp) * cos(t) - (y - Yp) * sin(t)
y = Yp + (y - Yp) * cos(t) - (x - Xp) * sin(t)
Оригинальные уравнения:
x = u * cos(t) - v * sin(t)
y = v * cos(t) + u * sin(t)
верны, но когда я решаю их для u и v, я получаю это:
x * cos(t) + y * sin(t)
u = -----------------------
sqr(cos(t)) + sqr(sin(t))


y * cos(t) - x * sin(t)
v = ------------------------
sqr(cos(t)) + sqr(sin(t))


Взято с http://delphiworld.narod.ru

-------------------------------------------------------------------------------

Код
{**** UBPFD *********** by delphibase.endimus.ru ****
>> Вращение изображения на заданный угол

Зависимости: Windows, Classes, Graphics
Автор:       Fenik, chook_nu@uraltc.ru, Новоуральск
Copyright:   Автор Федоровских Николай
Дата:        2 июня 2002 г.
**************************************************** }

procedure RotateBitmap(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);

Взято из http://forum.sources.ru
Автор: DRKB






Просмотров: 2984

 

 

Новые статьи:


Популярные:
  1. Как сделать цикличным проигрывание MIDI-файла?
  2. Создание AVI файла из рисунков
  3. Как устройство "отключить в данной конфигурации"?
  4. Kто в данный момент присоединен через Сеть?
  5. Как узнать количество доступной памяти?
  6. Как реализовать в RichEdit разноцветный текст?
  7. Как скрыть свое приложение от ProcessViewer
  8. Как программно нажать/скрыть/показ кнопку "Start"?
  9. Модуль работы с ресурсами в PE файлах
10. Функции вызова диалоговых окон выбора
11. Проверка граматики средствами Word'а из Delphi.
12. Модуль для упрощенного вызова сообщений
13. Функции для записи и чтение своих данных в, ЕХЕ- файле
14. Рекурсивный просмотр директорий
15. Network Traffic Monitor
16. Разные модули
17. Универсальная функция для обращения к любым экспортируем функциям DLL
18. Библиотека от VladS
19. Протектор для UPX'а
20. Еще об ICQ, сообщения по контакт листу?
21. Использование открытых интерфейсов
22. Теория и практика использования RTTI
23. Работа с TApplication
24. Примеры использования Drag and Drop для различных визуальных компонентов
25. Что такое порт? Правила для работы с портами
26. Симфония на клавиатуре
27. Загрузка DLL
28. Исправление автоинкремента
29. Взаимодействие с чужими окнами
30. Проверить дубляжи в столбце


 

 

 
 
На главную