Главная страница
    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.047 c
2-1186558517
Евгений Р.
2007-08-08 11:35
2007.09.02
upper для русских букв FB 1.5.3


3-1178531718
stud
2007-05-07 13:55
2007.09.02
есть ли аналог


3-1178619745
pavel_guzhanov
2007-05-08 14:22
2007.09.02
Ошибка при вставке записи и коммит транзакции


1-1182415155
infom
2007-06-21 12:39
2007.09.02
При загрузке проекты слетает свойство DataSource


2-1186564374
1c_user
2007-08-08 13:12
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
Английский Французский Немецкий Итальянский Португальский Русский Испанский