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

Вниз

Врещения изображения   Найти похожие ветки 

 
nord489   (2007-08-07 22:50) [0]

Здравствуйте, подскажите, как можно заставить вращаться изображение (TImage) по или против часовой стрелки в течении определенного промежутка времени?


 
JanMihail ©   (2007-08-07 22:52) [1]

Никак. TImage не вращают. Это либо DirectDraw или OpenGL. И скорее в разделе Игры ты такое узнаешь


 
ShyricK ©   (2007-08-07 23:02) [2]

В зависимости от того что в Image: Если загруженая картинка то нельзя, а если сам рисуешь на канве Image"а то можно.


 
Amoeba ©   (2007-08-08 14:53) [3]

Компонент TRotateImage
http://www.delphiarea.com/products/rotateimage/


 
shtam   (2007-08-09 14:09) [4]

Кусок кода взят из "delphi word 6"
проверил сам работает

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;



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

Форум: "Начинающим";
Текущий архив: 2007.09.02;
Скачать: [xml.tar.bz2];

Наверх





Память: 0.48 MB
Время: 0.045 c
2-1186471609
Сергей И
2007-08-07 11:26
2007.09.02
Создание из текстового документа электронной книги


10-1135328510
alex_s
2005-12-23 12:01
2007.09.02
OPC клиент


2-1186737234
Новичек
2007-08-10 13:13
2007.09.02
Массив объектов.


15-1186483370
Галинка
2007-08-07 14:42
2007.09.02
.tar чем разархивировать?


8-1164713466
Tar I
2006-11-28 14:31
2007.09.02
Вывод графики поверх видео





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
Английский Французский Немецкий Итальянский Португальский Русский Испанский