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


Автор: Jonnik 7.11.2006, 19:52
Текст программы как повернуть Bitmap на любой угол. 

Код

const

  PixelMax = 32768;

type
  pPixelArray = ^TPixelArray;
  TPixelArray = array [0..PixelMax-1] of TRGBTriple;

procedure RotateBitmap_ads(SourceBitmap: TBitmap;
out DestBitmap: TBitmap; Center: TPoint; Angle: Double);
var
  cosRadians : Double;
  inX : Integer;
  inXOriginal : Integer;
  inXPrime : Integer;
  inXPrimeRotated : Integer;
  inY : Integer;
  inYOriginal : Integer;
  inYPrime : Integer;
  inYPrimeRotated : Integer;
  OriginalRow : pPixelArray;
  Radians : Double;
  RotatedRow : pPixelArray;
  sinRadians : Double;
begin
  DestBitmap.Width := SourceBitmap.Width;
  DestBitmap.Height := SourceBitmap.Height;
  DestBitmap.PixelFormat := pf24bit;
  Radians := -(Angle) * PI / 180;
  sinRadians := Sin(Radians);
  cosRadians := Cos(Radians);
  for inX := DestBitmap.Height-1 downto 0 do
  begin
    RotatedRow := DestBitmap.Scanline[inX];
    inXPrime := 2*(inX - Center.y) + 1;
    for inY := DestBitmap.Width-1 downto 0 do
    begin
      inYPrime := 2*(inY - Center.x) + 1;
      inYPrimeRotated := Round(inYPrime * CosRadians - inXPrime * sinRadians);
      inXPrimeRotated := Round(inYPrime * sinRadians + inXPrime * cosRadians);
      inYOriginal := (inYPrimeRotated - 1) div 2 + Center.x;
      inXOriginal := (inXPrimeRotated - 1) div 2 + Center.y;
      if (inYOriginal >= 0) and (inYOriginal <= SourceBitmap.Width-1) and
      (inXOriginal >= 0) and (inXOriginal <= SourceBitmap.Height-1) then
      begin
        OriginalRow := SourceBitmap.Scanline[inXOriginal];
        RotatedRow[inY] := OriginalRow[inYOriginal]
      end
      else
      begin
        RotatedRow[inY].rgbtBlue := 255;
        RotatedRow[inY].rgbtGreen := 0;
        RotatedRow[inY].rgbtRed := 0
      end;
    end;
  end;
end;

{Usage:}
procedure TForm1.Button1Click(Sender: TObject);
var
  Center : TPoint;
  Bitmap : TBitmap;
begin
  Bitmap := TBitmap.Create;
  try
    Center.y := (Image.Height div 2)+20;
    Center.x := (Image.Width div 2)+0;
    RotateBitmap_ads(
    Image.Picture.Bitmap,
    Bitmap,
    Center,
    Angle);
    Angle := Angle + 15;
    Image2.Picture.Bitmap.Assign(Bitmap);
  finally
    Bitmap.Free;
  end;
end;


В данной программе мне не понятно как пользоваться функцией RotateBitmap_ads и как в ней задовать параметры.
Желательно чтобы ктонибудь сделал рабочий прект и выложил на форуме.

Автор: Alexeis 7.11.2006, 20:28

M
alexeis1
Модератор: Название темы должно отражать ее суть!

Придумайте название по оригинальней.

Автор: Snowy 7.11.2006, 20:46
Как это "не понятно"?
Ты ж сам пример и привёл.
В этом кодн и приводится пример поворота на 15 градусов.

Автор: Alexeis 7.11.2006, 20:52
Jonnik, Работает это код нормально. 
RotateBitmap_ads(SourceBitmap: TBitmap; out DestBitmap: TBitmap; Center: TPoint; Angle: Double);
SourceBitmap: TBitmap - исходный битмап
DestBitmap: TBitmap - результирующий битмап
Center: TPoint; - точка вокруг которой производится вращение.
Angle: Double - угол поворота.

Автор: sergejzr 7.11.2006, 20:54
Из http://forum.vingrad.ru/delphi-media-sound-drawing-graphics-video.html

Автор: Snowy 7.11.2006, 21:00
проект - пример



Добавлено @ 21:05 
Там ещё один недокументированный ньюанс - исходная картинка болжна быть 24-битной.
Решается это конвертацией исходного битмапа в 24-битный.
В примере прописано.

Автор: Jonnik 7.11.2006, 21:18
Спасибо.
Но есть проблема. В этом архивчеке нет файла unit1.pas

Автор: Snowy 7.11.2006, 21:19
Цитата(Jonnik @  7.11.2006,  22:18 Найти цитируемый пост)
Но есть проблема. В этом архивчеке нет файла unit1.pas
Хм. Неужели забыл...
Ладно, держи.
Код

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    Image1: TImage;
    Image2: TImage;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

const

  PixelMax = 32768;

type
  pPixelArray = ^TPixelArray;
  TPixelArray = array [0..PixelMax-1] of TRGBTriple;

procedure RotateBitmap_ads(SourceBitmap: TBitmap;
out DestBitmap: TBitmap; Center: TPoint; Angle: Double);
var
  cosRadians : Double;
  inX : Integer;
  inXOriginal : Integer;
  inXPrime : Integer;
  inXPrimeRotated : Integer;
  inY : Integer;
  inYOriginal : Integer;
  inYPrime : Integer;
  inYPrimeRotated : Integer;
  OriginalRow : pPixelArray;
  Radians : Double;
  RotatedRow : pPixelArray;
  sinRadians : Double;
begin
  DestBitmap.Width := SourceBitmap.Width;
  DestBitmap.Height := SourceBitmap.Height;
  DestBitmap.PixelFormat := pf24bit;
  Radians := -(Angle) * PI / 180;
  sinRadians := Sin(Radians);
  cosRadians := Cos(Radians);
  for inX := DestBitmap.Height-1 downto 0 do
  begin
    RotatedRow := DestBitmap.Scanline[inX];
    inXPrime := 2*(inX - Center.y) + 1;
    for inY := DestBitmap.Width-1 downto 0 do
    begin
      inYPrime := 2*(inY - Center.x) + 1;
      inYPrimeRotated := Round(inYPrime * CosRadians - inXPrime * sinRadians);
      inXPrimeRotated := Round(inYPrime * sinRadians + inXPrime * cosRadians);
      inYOriginal := (inYPrimeRotated - 1) div 2 + Center.x;
      inXOriginal := (inXPrimeRotated - 1) div 2 + Center.y;
      if (inYOriginal >= 0) and (inYOriginal <= SourceBitmap.Width-1) and
      (inXOriginal >= 0) and (inXOriginal <= SourceBitmap.Height-1) then
      begin
        OriginalRow := SourceBitmap.Scanline[inXOriginal];
        RotatedRow[inY] := OriginalRow[inYOriginal]
      end
      else
      begin
        RotatedRow[inY].rgbtBlue := 255;
        RotatedRow[inY].rgbtGreen := 0;
        RotatedRow[inY].rgbtRed := 0
      end;
    end;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  c: TPoint;
  b: TBitmap;
begin
  c.X := Image1.Width div 2; c.Y := Image1.Height div 2;
  b := TBitmap.Create; Image1.Picture.Bitmap.PixelFormat := pf24bit;
  RotateBitmap_ads(Image1.Picture.Bitmap, b, c, 30);
  Image2.Picture.Bitmap := b; b.Free;
end;

end.

Автор: Jonnik 7.11.2006, 21:34
Большое спасибо!!!

Автор: Girder 7.11.2006, 21:42
http://vingrad.ru/DELPHI-SRC-001723
А также здесь полно... вариантов: http://forum.vingrad.ru/act-Search/f-2.html

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