Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Начинающим";
Текущий архив: 2007.08.19;
Скачать: [xml.tar.bz2];

Вниз

Поворот 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;
Скачать: [xml.tar.bz2];

Наверх




Память: 0.49 MB
Время: 0.071 c
6-1167843193
nes_
2007-01-03 19:53
2007.08.19
webbrowser + HTTP_USER_AGENT (MSIE 6.0; Windows NT 5.1)


2-1182812377
Сергей Макс.
2007-06-26 02:59
2007.08.19
SetFileSecurity


4-1172557563
GrayFace
2007-02-27 09:26
2007.08.19
"Сбросить" ListView_SetColumnWidth при ViewStyle = vsList


2-1185390951
Мануха
2007-07-25 23:15
2007.08.19
желтая сетка в StringGrid


1-1181051958
DelphiN!
2007-06-05 17:59
2007.08.19
WebBrowser загружает страницу из кэша с флагом navNoReadFromCache





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский