Версия для печати темы
Нажмите сюда для просмотра этой темы в оригинальном формате
Форум программистов > Delphi: Звук, графика и видео > Вращение картинки ?


Автор: WaReZMEN 20.9.2007, 05:23
Знаю что постов много но всеже нашел я код в интеренте

Код

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;


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

Автор: Alexeis 20.9.2007, 10:00
Не используйте сомнительных источников, когда есть ответ в FAQе
http://forum.vingrad.ru/index.php?show_type=faq&showtopic=157013

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

Автор: WaReZMEN 25.9.2007, 00:40
Попробовал оба способа получается таже хрень примерно smile вообщем не подходит :(

Автор: fse 1.10.2007, 13:01
Привет. От скуки решил велосипед свой написать: процедурку поворота картинки, всё той же картинки.
Постарался заточить под скорость.
Так, 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;

Powered by Invision Power Board (http://www.invisionboard.com)
© Invision Power Services (http://www.invisionpower.com)