Форум: "Потрепаться";
Текущий архив: 2006.01.22;
Скачать: [xml.tar.bz2];

Вниз

поворот изображения. В чем ошибка?   Найти похожие ветки 

← →
TimeTable   (2005-12-27 23:13) [0]

Доброго времени суток, помогите найти ошибку в коде, если она имеется, или какие ошибки могут возникнуть при использовании следующего кода. Код поворота BmpШки на определенный угол, дело в том, что на некоторых компьютерах, происходит ошибка во время поворота, хотя поворачивается одна и таже картинка.

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;

Взято из DelphiWorld!

---

← →
Johnmen ©   (2005-12-27 23:25) [1]

Код - это конечно хорошо и правильно. Но где же сама ошибка?

---

← →
TimeTable   (2005-12-28 00:15) [2]

Есть image, используя этот код я поворачиваю изображение, но на некоторых компьютерахх, после выполнения "поворота" пропадает изображение, или искажается, растягивается, или сужается до неузнаваемости

---

← →
wicked ©   (2005-12-28 00:36) [3]

> Взято из DelphiWorld!

что лишний раз подтверждает, куда должен этот вот самый отправиться - в район мусорной корзины....
по сабжу - найди нормальный код интерполяции текстуры по 4-м точкам: всё же лучше будет считать положение этих 4-х точек, а затем выводить по ним битмап....
а код абсолютно доверия не вызывает - автор ну явно не знаком с содержимым модуля math, например.... также в коде жестко забит формат битмапа - pf24bit.... терпеть это можно только при одном условии - автор явно оговорил это.... а судя по вопросу - нифига этого не было....

резюме: пробуй превращать все битмапы, которые кормятся этой процедуре, в формат pf24bit, а еще лучше - выбрось такой код на помойку и найди ему замену... аффинного текстурного наложения хватит только так...

---

← →
TimeTable   (2005-12-28 00:56) [4]

Спасибо за помощь, буду разбираться :)

---

← →
з. танька   (2005-12-28 01:01) [5]

как-то делала растровые часы для инстика, ето малость измененный код из книжки Краснова про директ-икс. делала давно так что не смейтесь.

procedure RotateImage(var BitmapOriginal, Result: TBitmap; Const iRotationAxis,
 jRotationAxis: Integer; Const AngleOfRotation: Double);
const
 MaxPixelCount = 32768;

type
 TRGBTripleArray = array[0..MaxPixelCount-1] of TRGBTriple;
 pRGBTripleArray = ^TRGBTripleArray;
var
   cosTheta   : Extended;
   i          : Integer;
   iOriginal  : Integer;
   iPrime     : Integer;
   j          : Integer;
   jOriginal  : Integer;
   jPrime     : Integer;
   RowOriginal: pRGBTripleArray;
   RowRotated : pRGBTRipleArray;
   sinTheta   : Extended;
   ug         : Real;
begin
  ug := AngleOfRotation / 360*2*pi;
  Result.PixelFormat := pf24bit;
  sinTheta := Sin(ug);
  cosTheta := Cos(ug);
  for j := Result.Height-1 downto 0 do
  begin
    RowRotated := Result.Scanline[j];
    jPrime := j - jRotationAxis;
    for i := Result.Width-1 downto 0 do
    begin
     iPrime := i - iRotationAxis;
     iOriginal := iRotationAxis + Round(iPrime * CosTheta - jPrime * sinTheta);
     jOriginal := jRotationAxis + Round(iPrime * sinTheta + jPrime * cosTheta);
     if (iOriginal >=0) and (iOriginal <=BitmapOriginal.Width-1) and
        (jOriginal >=0) and (jOriginal <=BitmapOriginal.Height-1)
     then begin
       RowOriginal := BitmapOriginal.Scanline[jOriginal];
       RowRotated[i] := RowOriginal[iOriginal]
     end
     else begin
       RowRotated[i].rgbtBlue := 0;
       RowRotated[i].rgbtGreen := 0;
       RowRotated[i].rgbtRed := 0
    end
  end
 end;
 Result.Canvas.Draw(0,0, Result);
end;

зы: формат тоже 24-битный! но мона переделать... если захотеть!

---

← →
TimeTable   (2005-12-28 01:09) [6]

PS: мне черно белое изображение нужно повернуть, может можно сделать проще?

---

← →
Ломброзо ©   (2005-12-28 01:33) [7]

TimeTable   (28.12.05 01:09) [6]

Поверните монитор на нужный угол. А вообще функция PlgBlt, если мне не изменяет мой английский, делает то же самое в одну строчку.

---

← →
Fenik ©   (2005-12-28 21:19) [8]

> TimeTable  (27.12.05 23:13)

Ошибка не в процедуре, а в применении.

> wicked ©  (28.12.05 00:36) [3]
> что лишний раз подтверждает, куда должен этот вот самый отправиться - в район мусорной корзины....
> а код абсолютно доверия не вызывает - автор ну явно не знаком с содержимым модуля math, например..

Код был выложен мною несколько лет назад вот здесь:
http://kladovka.net.ru/delphibase/?action=viewfunc&topic=mediaimg&id=10186 ,
откуда и перекочевал на DelphiWorld.

Тогда я ещё только начинал изучать Delphi :))
Недавно переписал эту процедуру. Теперь раза в три быстрее и без ограничения в bpp.

uses
  Windows, Graphics, Math, UQPixels;

procedure RotateOptimized(SrcBmp, DestBmp: TBitmap; Angle: Double; BackColor: TColor);
{
Angle - угол поворота, в градусах.
Для каждой точки результирующего растра (Dest) находится
соответствующая точка исходного (Src) по формуле:
XOld = XCenter + (XNew - XCenter)*Cos(A) - (YNew - YCenter)*Sin(A)
YOld = YCenter + (XNew - XCenter)*Sin(A) + (YNew - YCenter)*Cos(A)
Если найденая точка (XOld, YOld) не принадлежит исходному растру, то
точка (XNew, YNew) на результирующем растре закрашивается цветом BackColor.
-----
В данной процедуре XCenter и YCenter заданы по умолчанию как
середины ширины и высоты нового изображения соответственно.
-----
Для случаев 90, 180, 270 градусов лучше написать отдельные процедуры.
}
const
  BigValue = 65536; { 2^16 }
type
  TRGBTripleArray = array [0..32768] of TRGBTriple;
  PRGBTripleArray = ^TRGBTripleArray;
var
  XOld, YOld, xNew, yNew, xNewBig, yNewBig,
  W, H, ICos, ISin: Integer;
  DCos, DSin, Left, Top: Extended;
  QPSrc, QPDest: TQuickPixels;
begin
  W := SrcBmp.Width;
  H := SrcBmp.Height;
  SinCos(DegToRad(Abs(Angle)), DSin, DCos);
  DestBmp.Width  := Round(Abs(W * DCos) + Abs(H * DSin));
  DestBmp.Height := Round(Abs(W * DSin) + Abs(H * DCos));
  if Angle > 0 then
    SinCos(DegToRad(-Angle), DSin, DCos);
  ISin := Round(DSin * BigValue);
  ICos := Round(DCos * BigValue);
  Left := (W - DestBmp.Width * DCos + DestBmp.Height * DSin) / 2;
  Top  := (H - DestBmp.Width * DSin - DestBmp.Height * DCos) / 2;
  QPSrc := TQuickPixels.Create;
  QPDest := TQuickPixels.Create;
  try
    QPSrc.Attach(SrcBmp);
    QPDest.Attach(DestBmp);
    for YOld := 0 to DestBmp.Height - 1 do begin
      xNewBig := Round((Left - (YOld * DSin)) * BigValue);
      yNewBig := Round((Top  + (YOld * DCos)) * BigValue);
      for XOld := 0 to DestBmp.Width - 1 do begin
        xNew := xNewBig shr 16;
        yNew := yNewBig shr 16;
        if (xNew >= 0) and (xNew < W) and (yNew >= 0) and (yNew < H)
          then QPDest.SetPixel(XOld, YOld, QPSrc.GetPixel(xNew, yNew))
          else QPDest.SetPixel(XOld, YOld, BackColor);
        Inc(xNewBig, ICos);
        Inc(yNewBig, ISin);
      end;
    end;
  finally
    QPSrc.Free;
    QPDest.Free;
  end;
end;

UQPixels брать здесь: http://www.delphimaster.ru/articles/pixels/index.html

---

← →
Fenik ©   (2005-12-28 21:54) [9]

> [8]
> type
>  TRGBTripleArray = array [0..32768] of TRGBTriple;
>  PRGBTripleArray = ^TRGBTripleArray;

Этот артефакт не нужен.

---

← →
Fenik ©   (2005-12-29 16:46) [10]

Блин, что-то я New и Old перепутал местами :)

---

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

Форум: "Потрепаться";
Текущий архив: 2006.01.22;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.49 MB
Время: 0.047 c