Главная страница
Top.Mail.Ru    Яндекс.Метрика
Текущий архив: 2007.08.19;
Скачать: CL | DM;

Вниз

Поворот TImage   Найти похожие ветки 

 
ММК   (2007-07-26 13:44) [0]

Нужно повернуть картинку в TImage на угол 90 градусов.
Как мне это сделать?
Заранее спасибо.


 
Lacmus ©   (2007-07-26 13:58) [1]

Не TImage, но возможно будет полезно

http://www.g32.org/


 
ММК   (2007-07-26 14:01) [2]


> Lacmus ©   (26.07.07 13:58) [1]

Спасибо конечно.
Но мне нужен именно TImage


 
DVM ©   (2007-07-26 14:01) [3]

Поворот на произвольный угол. Для 90 град. конечно можно было проще.

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;



 
ММК   (2007-07-26 14:03) [4]

Спасибо


 
palva ©   (2007-07-26 15:05) [5]


> ММК   (26.07.07 14:03) [4]
> Спасибо

А чего спасибо? вы же просили TImage.


 
DVM ©   (2007-07-26 15:10) [6]


> А чего спасибо? вы же просили TImage.

Разве этим нельзя повернуть картинку в TImage?

RotateBitmap(Image1.Picture.Bitmap, 90, clBlack);


 
palva ©   (2007-07-26 15:47) [7]

DVM ©   (26.07.07 15:10) [6]
В самом деле.


 
Vlad Oshin ©   (2007-07-26 15:59) [8]

for i:=1 to image1.Picture.Bitmap.Height do
 for j:=1 to image1.Picture.Bitmap.Width do begin
  image2.Picture.Bitmap.Canvas.Pixels[i,j]:= image1.Picture.Bitmap.Canvas.Pixels[j,i];
               
а что-то типа такого не спасет отца русской демократии?


 
palva ©   (2007-07-26 16:15) [9]

Да, как нибудь так

for i := 0 to w div 2 do for j := w div 2 do begin
   p := image2.Picture.Bitmap.Canvas.Pixels[i,j];
   image2.Picture.Bitmap.Canvas.Pixels[i,j] := image2.Picture.Bitmap.Canvas.Pixels[w-j-1,i];
   image2.Picture.Bitmap.Canvas.Pixels[w-j-1,i] := image2.Picture.Bitmap.Canvas.Pixels[w-i-1,w-j-1];
   image2.Picture.Bitmap.Canvas.Pixels[w-i-1,w-j-1] := image2.Picture.Bitmap.Canvas.Pixels[j,w-i-1];
   image2.Picture.Bitmap.Canvas.Pixels[j,w-i-1] := p;


 
любитель поорать   (2007-07-26 16:30) [10]

> а что-то типа такого не спасет отца русской демократии?

С таким кодом только в сарай за метлой.


 
DVM ©   (2007-07-26 16:46) [11]


> palva ©   (26.07.07 16:15) [9]

Раз в 20 медленнее чем вариант из [3] даже несмотря на избыточность [3]


 
palva ©   (2007-07-26 17:01) [12]

DVM ©   (26.07.07 16:46) [11]
Это да.


 
Sdubaruhnul   (2007-07-26 18:50) [13]

Ещё вариант - использовать SetWorldTransform.


 
ProgRAMmer Dimonych ©   (2007-07-27 00:29) [14]

> Sdubaruhnul   (26.07.07 18:50) [13]
> Ещё вариант - использовать SetWorldTransform.

Ну зачем же так человека-то пугать, а?



Страницы: 1 вся ветка

Текущий архив: 2007.08.19;
Скачать: CL | DM;

Наверх




Память: 0.51 MB
Время: 0.035 c
2-1185000344
apic
2007-07-21 10:45
2007.08.19
Цвет полосы прокрутки


2-1184886310
vasIZmax
2007-07-20 03:05
2007.08.19
Проблема с "я"


5-1159542115
ProgRAMmer Dimonych
2006-09-29 19:01
2007.08.19
Отлов клавы в одной процедуре


15-1184931279
Sandman29
2007-07-20 15:34
2007.08.19
Буш-диктатор?


15-1185098328
Rouse_
2007-07-22 13:58
2007.08.19
Утилиты модификации NTFS безопасности.