Форум программистов «Весельчак У»
  *
Добро пожаловать, Гость. Пожалуйста, войдите или зарегистрируйтесь.
Вам не пришло письмо с кодом активации?

  • Рекомендуем проверить настройки временной зоны в вашем профиле (страница "Внешний вид форума", пункт "Часовой пояс:").
  • У нас больше нет рассылок. Если вам приходят письма от наших бывших рассылок mail.ru и subscribe.ru, то знайте, что это не мы рассылаем.
   Начало  
Наши сайты
Помощь Поиск Календарь Почта Войти Регистрация  
 
Страниц: [1]   Вниз
  Печать  
Автор Тема: поворот рисунка в делфи  (Прочитано 5734 раз)
0 Пользователей и 1 Гость смотрят эту тему.
Dashylka
Гость
« : 02-07-2009 18:05 » 

ПОМОГИте! разобраться в тексте программы:
Код:
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;
procedure tform1.restart_rect;
begin
     rectend := false;
     rectdrag := false;
     rectbegin := false;
     Rect_for_move.Bottom := 0;
     Rect_for_move.Top := 0;
     Rect_for_move.Left := 0;
     Rect_for_move.Right := 0;
     Image.Canvas.DrawFocusRect(Rect_for_move);
end;
« Последнее редактирование: 03-07-2009 05:12 от Алексей1153++ » Записан
PooH
Глобальный модератор

ru
Offline Offline
Пол: Мужской
... и можно без хлеба!


« Ответ #1 : 03-07-2009 05:04 » new

а чего не понятно-то?
Записан

Удачного всем кодинга! -=x[PooH]x=-
Страниц: [1]   Вверх
  Печать  
 

Powered by SMF 1.1.21 | SMF © 2015, Simple Machines