Главная страница
    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.041 c
4-1173115326
Dmitry_177
2007-03-05 20:22
2007.09.02
Курсор над кнопкой


6-1168839344
DimaL
2007-01-15 08:35
2007.09.02
Перехват передачи данных


2-1186581369
Constantin
2007-08-08 17:56
2007.09.02
Double


2-1186399551
gentos
2007-08-06 15:25
2007.09.02
primary key


15-1186166932
tesseract
2007-08-03 22:48
2007.09.02
Sergay masloff контакты.





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