Модераторы: Snowy, Alexeis, MetalFan
  

Поиск:

Ответ в темуСоздание новой темы Создание опроса
> Повернуть Bitmap на любой угол 
:(
    Опции темы
Jonnik
Дата 7.11.2006, 19:52 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Участник
Сообщений: 90
Регистрация: 9.2.2006

Репутация: нет
Всего: нет
Текст программы как повернуть 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 и как в ней задовать параметры.
Желательно чтобы ктонибудь сделал рабочий прект и выложил на форуме.

Это сообщение отредактировал(а) Jonnik - 7.11.2006, 19:53
PM MAIL   Вверх
Alexeis
Дата 7.11.2006, 20:28 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Амеба
Group Icon


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

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

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

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



Это сообщение отредактировал(а) alexeis1 - 7.11.2006, 20:33


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

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

гениальность идеи состоит в том, что ее невозможно придумать
PM ICQ Skype   Вверх
Snowy
Дата 7.11.2006, 20:46 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


Профиль
Группа: Модератор
Сообщений: 11363
Регистрация: 13.10.2004
Где: Питер

Репутация: 18
Всего: 484
Как это "не понятно"?
Ты ж сам пример и привёл.
В этом кодн и приводится пример поворота на 15 градусов.
PM MAIL   Вверх
Alexeis
Дата 7.11.2006, 20:52 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Амеба
Group Icon


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

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


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

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

гениальность идеи состоит в том, что ее невозможно придумать
PM ICQ Skype   Вверх
sergejzr
Дата 7.11.2006, 20:54 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Un salsero
Group Icon


Профиль
Группа: Админ
Сообщений: 13285
Регистрация: 10.2.2004
Где: Германия г .Ганновер

Репутация: нет
Всего: 360
Из Delphi: Звук, графика и видео


--------------------
Me.
FB.
LinkedIn.
ORCID.
YT.
PM WWW IM ICQ Skype GTalk Jabber AOL YIM MSN   Вверх
Snowy
Дата 7.11.2006, 21:00 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


Профиль
Группа: Модератор
Сообщений: 11363
Регистрация: 13.10.2004
Где: Питер

Репутация: 18
Всего: 484
проект - пример



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

Присоединённый файл ( Кол-во скачиваний: 18 )
Присоединённый файл  rotate.zip 61,47 Kb
PM MAIL   Вверх
Jonnik
Дата 7.11.2006, 21:18 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Участник
Сообщений: 90
Регистрация: 9.2.2006

Репутация: нет
Всего: нет
Спасибо.
Но есть проблема. В этом архивчеке нет файла unit1.pas
PM MAIL   Вверх
Snowy
Дата 7.11.2006, 21:19 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


Профиль
Группа: Модератор
Сообщений: 11363
Регистрация: 13.10.2004
Где: Питер

Репутация: 18
Всего: 484
Цитата(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.
PM MAIL   Вверх
Jonnik
Дата 7.11.2006, 21:34 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Участник
Сообщений: 90
Регистрация: 9.2.2006

Репутация: нет
Всего: нет
Большое спасибо!!!
PM MAIL   Вверх
Girder
Дата 7.11.2006, 21:42 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Лентяй 2
***


Профиль
Группа: Участник Клуба
Сообщений: 1993
Регистрация: 12.5.2004

Репутация: 2
Всего: 155
http://vingrad.ru/DELPHI-SRC-001723
А также здесь полно... вариантов: http://forum.vingrad.ru/act-Search/f-2.html


--------------------
Как слышим, так и пишим.
Истина где-то там...
PM   Вверх
  
 Ответ в темуСоздание новой темы Создание опроса
Правила форума "Delphi: Звук, графика и видео"
Girder
Snowy
Alexeis

Запрещено:

1. Публиковать ссылки на вскрытые компоненты

2. Обсуждать взлом компонентов и делится вскрытыми компонентами

  • Литературу по Дельфи обсуждаем здесь
  • Действия модераторов можно обсудить здесь
  • С просьбами о написании курсовой, реферата и т.п. обращаться сюда
  • Вопросы по реализации алгоритмов рассматриваются здесь
  • 90% ответов на свои вопросы можно найти в DRKB (Delphi Russian Knowledge Base) - крупнейшем в рунете сборнике материалов по Дельфи
  • По вопросам разработки игр стоит заглянуть сюда

FAQ раздела лежит здесь!

Если Вам помогли и атмосфера форума Вам понравилась, то заходите к нам чаще! С уважением, Girder, Snowy.
 
0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема | Delphi: Звук, графика и видео | Следующая тема »

Подписаться на тему | Подписка на этот форум | Скачать/Распечатать тему


 




[ Время генерации скрипта: 0.0572 ]   [ Использовано запросов: 22 ]   [ GZIP включён ]


Реклама на сайте     Информационное спонсорство

 
 По вопросам размещения рекламы пишите на vladimir(sobaka)vingrad.ru
Отказ от ответственности     Powered by Invision Power Board(R) 1.3 © 2003  IPS, Inc.