VPF::Поворот image в делфи - Форум программистов

апаааааааааа

Дата 25.1.2012, 18:47 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 2
Регистрация: 25.1.2012

Репутация: нет
Всего: нет

Люди, помогите...как повернуть на какое либо количество градусов изображение...я пока в делфи нубок, так что помгоите пожалуйста...заранее спсМой емайл

M
Alexeis

Модератор: Название темы должно отражать ее суть!

Это сообщение отредактировал(а) Alexeis - 25.1.2012, 21:26

Данкинг

Дата 25.1.2012, 20:40 (ссылка)

(голосов:1)

Загрузка ...

Yersinia pestis

Профиль
Группа: Завсегдатай
Сообщений: 8302
Регистрация: 7.11.2006
Где: მოსკოვი

Репутация: нет
Всего: 130

А зачем нам "твой емайл"?

Цитата(апаааааааааа @ 25.1.2012, 19:47

)

я пока в делфи нубок

И сразу начинаешь с поворота изображений?

Пример поворота битмапов из DRKB:

Код


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;

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

There's nothing left but silent epitaphs.

апаааааааааа

Дата 26.1.2012, 05:20 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 2
Регистрация: 25.1.2012

Репутация: нет
Всего: нет

Спасибо большое

kozerog

Дата 2.3.2012, 22:48 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 3
Регистрация: 2.3.2012

Репутация: нет
Всего: нет

Спасибо ещё раз)))

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Звук, графика и видео \| Следующая тема »