VPF::Вращение картинки ? - Форум программистов

WaReZMEN

Дата 20.9.2007, 05:23 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 683
Регистрация: 9.6.2006
Где: Россия, Санкт-Пет ербург

Репутация: нет
Всего: 3

Знаю что постов много но всеже нашел я код в интеренте

Код


procedure TForm1.BitBtn1Click(Sender: TObject);

var
  bm, bm1: TBitMap;
  x, y: integer;
  r, a: single;
  xo, yo: integer;
  s, c: extended;
begin
 bm := TBitMap.Create;
  bm:=Image1.Picture.Bitmap;
  xo := bm.Width div 2;
  yo := bm.Height div 2;
  bm1 := TBitMap.Create;
  bm1.Width := bm.Width;
  bm1.Height := bm.Height;
  a := 45;
  repeat
    for y := 0 to bm.Height - 1 do
    begin
      for x := 0 to bm.Width - 1 do
      begin
        r := sqrt(sqr(x - xo) + sqr(y - yo));
        SinCos(a + arctan2((y - yo), (x - xo)), s, c);
        bm1.Canvas.Pixels[x,y] := bm.Canvas.Pixels[
        round(xo + r * c), round(yo + r * s)];
      end;
      Application.ProcessMessages;
    end;
    PatBlt(Image2.Canvas.Handle, 0, 0, Image2.ClientWidth, Image2.ClientHeight, WHITENESS);
    Image2.Canvas.Draw(xo, yo, bm1);
    a := a + 0.05;

    Application.ProcessMessages;
  until
    Form1.Tag <> 0;
 
  bm1.Destroy;
end;

вообщем когда вращеш картинку откудато появляются артифакты не понятные на картинки прикрепленои они красного цвета

Присоединённый файл ( Кол-во скачиваний: 19 )

Untitled_1.jpg 28,68 Kb

Alexeis

Дата 20.9.2007, 10:00 (ссылка)

(нет голосов)

Загрузка ...

Амеба

Профиль
Группа: Админ
Сообщений: 11743
Регистрация: 12.10.2005
Где: Зеленоград

Репутация: 55
Всего: 459

Не используйте сомнительных источников, когда есть ответ в FAQе
http://forum.vingrad.ru/index.php?show_typ...howtopic=157013

Решение в факе намного быстрее и грамотнее. С недавнего времени у нас заработал фак по разделу "Delphi: Звук, графика и видео". Пользуйтесь.

--------------------

Vit вечная память.

Обсуждение действий администрации форума производятся только в этом форуме

гениальность идеи состоит в том, что ее невозможно придумать

WaReZMEN

Дата 25.9.2007, 00:40 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 683
Регистрация: 9.6.2006
Где: Россия, Санкт-Пет ербург

Репутация: нет
Всего: 3

Попробовал оба способа получается таже хрень примерно smile

вообщем не подходит :(

fse

Дата 1.10.2007, 13:01 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 75
Регистрация: 28.9.2007
Где: г. Рязань

Репутация: нет
Всего: 1

Привет. От скуки решил велосипед свой написать: процедурку поворота картинки, всё той же картинки.
Постарался заточить под скорость.
Так, 800x600 поворачивается за 130 мс. Много или мало, судите сами! ;)
Вот код, может пригодится, и автору тоже;)

Код


procedure TForm1.RotateBmp(BmpIn, BmpOut: TBitmap; Angle: Double);
type
  TBGR = record
    B, G, R: Byte;
  end;
  TBMPLine = array[0..MaxInt div 16] of TBGR;
  PBMPLine = ^TBMPLine;
var
  I: Integer;
  InLines: array of PBMPLine;
  OutLines: array of PBMPLine;
  OutX, OutY: Integer;
  InX, InY: Double;
  InCenterX, InCenterY: Integer;
  OutCenterX, OutCenterY: Integer;
  SinA, CosA: Double;

  procedure PointRotateOZ(const X, Y: Double; out RotX, RotY: Double);
  begin
    RotX := X*CosA - Y*SinA;
    RotY := X*SinA + Y*CosA;
  end;

begin
  if BmpIn = BmpOut then Exit;

  BmpIn.PixelFormat := pf24bit;
  BmpOut.PixelFormat := pf24bit;

  Angle := (180 + Angle) / 180 * Pi;
  SinA := Sin(Angle);
  CosA := Cos(Angle);

  InCenterX := BmpIn.Width div 2;
  InCenterY := BmpIn.Height div 2;

  BmpOut.Width := 0;
  BmpOut.Width := Round(Sqrt(Sqr(InCenterX) + Sqr(InCenterY)) * 2);
  BmpOut.Height := BmpOut.Width;

  OutCenterX := BmpOut.Width div 2;
  OutCenterY := BmpOut.Height div 2;

  SetLength(InLines, BmpIn.Height);
  SetLength(OutLines, BmpOut.Height);

  for I := 0 to BmpIn.Height - 1 do
    InLines[I] := BmpIn.ScanLine[I];
  for I := 0 to BmpOut.Height - 1 do
    OutLines[I] := BmpOut.ScanLine[I];

  for OutX := 0 to BmpOut.Width - 1 do
    for OutY := 0 to BmpOut.Height - 1 do
    begin
      PointRotateOZ(OutCenterX - OutX, OutCenterY - OutY, InX, InY);
      InX := Round(InX + InCenterX);
      InY := Round(InY + InCenterY);
      if (InX < 0) or (InX >= BmpIn.Width) or (InY < 0) or (InY >= BmpIn.Height) then Continue;
      OutLines[OutY]^[OutX] := InLines[Round(InY)]^[Round(InX)];
    end;
end;

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Звук, графика и видео \| Следующая тема »