Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Мультимедиа в Delphi
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 15.06.2014, 21:41   #11
type_Oleg
Старожил
 
Аватар для type_Oleg
 
Регистрация: 02.03.2008
Сообщений: 2,538
По умолчанию

XE5, понятно, через API. Ну да , компактно получилось.
type_Oleg на форуме Ответить с цитированием
Старый 15.06.2014, 22:02   #12
Armageddets
Форумчанин
 
Регистрация: 30.06.2012
Сообщений: 145
По умолчанию

Да - это был бы идеальный вариант, если бы он работал не с компонентом image, а переменной типа TBitmap. Я попробую конечно его применить к моему примеру - посмотрим, что получится.

Также уже начал подставлять формулу в свою процедуру от type_Oleg. В принципе пока достиг того же результата, что и был до этого. Изображение поворачивается но размывается постепенно.

Процедура получилась следующей:

procedure IMGRotate(IMG:TBitmap; Angle:single);
var X,Y:uint;
buf:TBitmap;
x0,y0:Integer; //center katrinki
sinus, cosinus: Extended;
Result:Tpoint;

begin
Buf:=TBitmap.Create;
Buf.Width:=IMG.Height;
Buf.Height:=IMG.Width;

//tochka vokrug kotoroy nizhno vertet - tsentr izobrazheniya
x0 := img.Width div 2;
y0 := img.Height div 2;
Angle:=Angle*PI/180;

for X:=0 to IMG.width-1 do
begin
for Y:=0 to IMG.Height-1 do
begin
//vichislyaem koordinati
Result.X:=Round(x0+(x-x0)*Cos(Angle)-(y-y0)*Sin(Angle));
Result.Y:=Round(y0+(x-x0)*Sin(Angle)+(y-y0)*Cos(Angle));


Buf.Canvas.Pixels[x,y]:=Img.Canvas.Pixels[Result.X,Result.Y];
//beliy tsvet delaem prozrachnim
if (Buf.Canvas.Pixels[x,y]=clWhite) then
Buf.Canvas.Pixels[x,y]:=Buf.TransparentColor;
end;
end;
IMG.Canvas.Draw(0,0,Buf);
Buf.FreeImage;
Buf.Free;
end;

Прилагаю собственно само приложение для наглядности, если нужно. Пока буду дальше работать над алгоритмом.
Вложения
Тип файла: rar Автомобиль.rar (165.3 Кб, 16 просмотров)
Armageddets вне форума Ответить с цитированием
Старый 16.06.2014, 01:55   #13
XE5
Заблокирован
 
Регистрация: 02.03.2014
Сообщений: 439
По умолчанию

Цитата:
Да - это был бы идеальный вариант, если бы он работал не с компонентом image, а переменной типа TBitmap
Что мешает использовать TImage как буфер?
Код:
var
  Image: TImage;
begin
  Image := TImage.Create;
 // и т. д.
По приведённому коду ошибка заключается в том, что при повороте всегда нужно использовать ИСХОДНОЕ изображение, а не то, что было уже повёрнуто. Чуть поправил, чтоб был ясен смысл
Код:
unit Unit1;

interface

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

type

  
  TCar=record
  X,Y,Angle:integer;
  Speed,Ves,Power,SpeedLimit:real;
  qGo,qBack:boolean;
  end;

  TForm1 = class(TForm)
    Timer1: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FormKeyUp(Sender: TObject; var Key: Word;
      Shift: TShiftState);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  Buf, CarIMG, OuthCarIMG:TBitmap;
  path:string;
  Car:TCar;
  procedure IMGRotate(IMG:TBitmap; Angle:single);

implementation
{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin

path:=ExtractFileDir(Application.ExeName);
Buf:=TBitmap.Create;
Buf.Width:=640;
Buf.Height:=480;

CarIMG:=Tbitmap.Create;
CarIMG.Transparent:=true;
CarIMG.LoadFromFile(path+'\0.bmp');
OuthCarIMG:=Tbitmap.Create;
OuthCarIMG.Transparent:=true;
OuthCarIMG.LoadFromFile(path+'\0.bmp');

Car.X:=320;
Car.Y:=240;
Car.Speed:=0;
Car.qGo:=false;
Car.qBack:=false;
Car.Ves:=1.1;
Car.Power:=2.4;
Car.Angle:=0;
Car.SpeedLimit:=Car.Power-Car.Ves;
if Car.SpeedLimit<0 then Car.SpeedLimit:=0;


end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin

  buf.Canvas.Brush.Color:=clGreen;
  buf.Canvas.Rectangle(0,0,640,480);

  Buf.Canvas.Draw(Car.X,Car.Y,OuthCarIMG);

  form1.Canvas.Draw(0,0,Buf);

  //razgon
  if (Car.qGo=true) and (Car.SpeedLimit>=(Car.Speed+Car.Power-Car.Ves) ) then
  Car.Speed:=Car.Speed+(Car.Power-Car.Ves);
  //zadniy hod
  if (Car.qBack=true) and (Car.SpeedLimit>=-(Car.Speed-Car.Power+Car.Ves) ) then
  Car.Speed:=Car.Speed-(Car.Power-Car.Ves);

  //konets razgona
  if (Car.Speed-Car.Power+Car.Ves>=0) and (Car.qGo=false) then
  Car.Speed:=Car.Speed-Car.Power+Car.Ves;
  //konets zadnego hoda
  if (Car.Speed+Car.Power-Car.Ves<=0) and (Car.qBack=false) then
  Car.Speed:=Car.Speed+Car.Power-Car.Ves;

  //itogovaya skorost
  //esli oboroti skorosti pozvolyayut sdvinut mashinu
  if (Car.Speed>Car.Ves) then
  Car.Y:=Car.Y-trunc(Car.Speed);
  if (Car.Speed<-Car.Ves) then
  Car.Y:=Car.Y-trunc(Car.Speed);
  //ogranichenie
  if Car.Y+63<=0 then Car.Y:=480;

  form1.Caption:='Speed='+floattostr(Car.speed)+'| Ves='+floattostr(Car.Ves)
  +'| SpeedLimit='+floattostr(Car.SpeedLimit)+'| Angle='+floattostr(Car.Angle);

end;

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin

  if key=VK_UP then
  Car.qGo:=true;

  if key=VK_Down then
  Car.qBack:=true;

  if Key=Vk_Right then
  begin
  Car.Angle:=Car.Angle+1;
  if Car.Angle>360 then Car.Angle:=0;
  IMGRotate(CarIMG, -Car.Angle);
  end;

  if Key=Vk_Left then
  begin
  Car.Angle:=Car.Angle-1;
  if Car.Angle<0 then Car.Angle:=360;
  IMGRotate(CarIMG, Car.Angle);
  end;

end;

procedure TForm1.FormKeyUp(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin

  if key=VK_UP then Car.qGo:=false;
  if key=VK_Down then Car.qBack:=false;


end;

procedure IMGRotate(IMG:TBitmap; Angle:single);
var X,Y:uint;
    buf:TBitmap;
    x0,y0:Integer; //center katrinki
    sinus, cosinus: Extended;
    Result:Tpoint;

begin
  Buf:=TBitmap.Create;
  Buf.Assign(IMG);
  //tochka vokrug kotoroy nizhno vertet - tsentr izobrazheniya
  x0 := img.Width div 2;
  y0 := img.Height div 2;
  Angle:=Angle*PI/180;

  for X:=0 to IMG.width do
  begin
    for Y:=0 to IMG.Height do
    begin
    //vichislyaem koordinati
    Result.X:=Round(x0+(x-x0)*Cos(Angle)-(y-y0)*Sin(Angle));
    Result.Y:=Round(y0+(x-x0)*Sin(Angle)+(y-y0)*Cos(Angle));
    Buf.Canvas.Pixels[x,y]:=Img.Canvas.Pixels[Result.X,Result.Y];
    //beliy tsvet delaem prozrachnim
    if (Buf.Canvas.Pixels[x,y]=clWhite) then
    Buf.Canvas.Pixels[x,y]:=0;
    end;
  end;
  OuthCarIMG.Assign(buf);
  Buf.FreeImage;
  Buf.Free;
end;

end.

Последний раз редактировалось XE5; 16.06.2014 в 03:10.
XE5 вне форума Ответить с цитированием
Старый 16.06.2014, 11:54   #14
Armageddets
Форумчанин
 
Регистрация: 30.06.2012
Сообщений: 145
По умолчанию

Огромное спасибо. Проблема решена. Спасибо всем за помошь.
Armageddets вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Поворот изображения Sanya.Kushner Мультимедиа в Delphi 1 29.12.2013 19:59
поворот изображения на форме (либо поворот файла с картинкой) mystiql Microsoft Office Access 2 21.06.2011 22:03
поворот изображения DeDoK Общие вопросы Delphi 4 06.09.2010 21:34
Поворот изображения Djony_91 Мультимедиа в Delphi 1 26.05.2010 16:15
поворот изображения Пепел Феникса Мультимедиа в Delphi 1 21.06.2009 19:53