Проблемы с вращением турели?

[Katerina1993]

Я написала небольшой класс на delphi, чтобы разворот объекта происходил в градусах. Например можно установить 90, 180, 270 градусов и объект будет поворачиваться в соответствующую сторону.

Здесь я использую ModifyWorldTransform для разворота объекта. Если указать статические параметры например 90, то объект разворачивается куда надо. Я решила попробовать использовать динамические параметры, прибавляю по 5 градусов каждые 20 миллисекунд (Компонент Timer).

В итоге поворот происходит только когда я перемещаю мышку по холсту, что мне кажется странным и вторая проблема разворот происходит с подвисанием. Собственно пример проблемы в прикрепленной гифке. (Перемещаю мышку разворот происходит и с подвисанием). На гифку подвисание не попала, когда записывала видео, вдруг все подвисания прекратились, однако программа притормаживает и турель поворачивает сразу на градусов 30.



Вот сам код и исходники. Прикреплённый файлRotateObj.zip (14,1 Кбайт, скачиваний: 10)

unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, AppEvnts, StdCtrls;
 
type
  TPoint1 = record x,y:Currency  ; end;
  TForm1 = class(TForm)
    Image1: TImage;
    ApplicationEvents1: TApplicationEvents;
    Label1: TLabel;
    Timer1: TTimer;
    Label2: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure ApplicationEvents1Message(var Msg: tagMSG;
      var Handled: Boolean);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
  TMatrix1 = class
  private
      a, b, c,d,tx,ty: Real;
      fr:TForm;
      bitmap0:TBitmap;
      Cs:TCanvas;
  public
    constructor Create(_bitmap:TBitmap;_Cs:TCanvas;_fr:TForm;_a, _b,_c,_d, _tx, _ty: Real);
    Procedure Draw();
    function identity ():TMatrix1;
    function appendTransform (x, y, scaleX, scaleY:Real; rotation:Integer; skewX, skewY, regX, regY:Real):TMatrix1;
    function append(a2, b2, c2, d2, tx2, ty2:Real):TMatrix1;
  end;
 
var
  Form1: TForm1;
  bmp1: TBitmap;
  x1:Integer = 225;
  y1:Integer = 275;
  rotate1:Integer = 90;
  pt:TPoint1;
  mtx:TMatrix1;
implementation
 
{$R *.dfm}
 
constructor TMatrix1.Create(_bitmap:TBitmap;_Cs:TCanvas;_fr:TForm;_a, _b,_c,_d, _tx, _ty: Real);
begin
   inherited Create;
   fr:=_fr;
   bitmap0:=_bitmap;
   Cs:=_Cs;
   a:=_a;
   b:=_b;
   c:=_d;
   tx:=_tx;
   ty:=_ty;
end;
 
procedure TMatrix1.Draw();
begin
  Cs.Draw(0,0,bitmap0);
end;
 
function TMatrix1.identity():TMatrix1;
begin
  a := 1;
  d := 1;
  b := 0;
  c := 0;
  tx := 0;
  ty := 0;
  Result:=mtx;
end;
 
function TMatrix1.appendTransform(x, y, scaleX, scaleY:Real; rotation:Integer; skewX, skewY, regX, regY:Real):TMatrix1;
var r, cos1, sin1:Real; a1:Integer;
begin
a1:=rotation mod 360;
 
 
    if a1 < 360 then
    begin
       r := rotation*PI/180;
       cos1 := cos(r);
       sin1 := sin(r);
    end
    else
    begin
      cos1 := 1;
      sin1 := 0;
    end;
   append(cos1*scaleX, sin1*scaleX, -sin1*scaleY, cos1*scaleY, x, y);
 
   tx := tx - (regX*a+regY*c);
   ty := ty - (regX*b+regY*d);
   fr.Caption:=FloatToStr(c);
  Result:=mtx;
end;
 
function TMatrix1.append(a2, b2, c2, d2, tx2, ty2:Real):TMatrix1;
var a1,b1,c1,d1:Real;
begin
  a1:=a;
  b1:=b;
  c1:=c;
  d1:=d;
 
  if (a2 <> 1) or (b2 <> 0) or (c2 <> 0) or (d2 <> 1) then
  begin
     a  := a1*a2+c1*b2;
     b  := b1*a2+d1*b2;
     c  := a1*c2+c1*d2;
     d  := b1*c2+d1*d2;
  end;
  tx:=a1*tx2+c1*ty2+tx;
  ty:=b1*tx2+d1*ty2+ty;
  Result:=mtx;
end;
 
procedure TForm1.FormCreate(Sender: TObject);
 
begin
  bmp1 := TBitmap.Create;
  bmp1.LoadFromFile('.\WeaponQuadSkin.bmp');
 
  mtx:=TMatrix1.Create(bmp1,Image1.Canvas,Form1,1,0,0,0,0,0);
 
  Timer1.Enabled:=True;
 
end;
 
procedure TForm1.ApplicationEvents1Message(var Msg: tagMSG;
  var Handled: Boolean);
var P : TPoint;
begin
if Msg.message = WM_MOUSEMOVE then
begin
 //P:=Image1.ScreenToClient(Mouse.CursorPos);
 //pt.x := P.X;
 //pt.y := P.Y;
 
end;
end;
 
procedure TForm1.Timer1Timer(Sender: TObject);
var mtx1:TMatrix1; HDC2:THandle; M:TXFORM;
begin
  Form1.Image1.Canvas.Brush.Color:=clWhite;
  Form1.Image1.Canvas.FillRect(Form1.Image1.ClientRect);
   mtx.identity();
 
   rotate1:=rotate1+5;
 
   mtx.appendTransform(x1, y1, 1, 1, rotate1, 0, 0, 16, 29.5);
 
 
 
   hDc2 := Image1.Canvas.Handle;
 
   SetGraphicsMode(hDc2, GM_ADVANCED);
   fillChar(M, sizeOf(M), 0);
   M.eM11 := mtx.a;
   M.eM12 := mtx.b;
   M.eM21 := mtx.c;
   M.eM22 := mtx.d;
   M.eDx := mtx.tx;
   M.eDy := mtx.ty;
 
   ModifyWorldTransform(hDc2, M, MWT_LEFTMULTIPLY);
 
   mtx.Draw();
 
end;
 
end.

Как сделать разворот более плавным и без использования мыши?

P.S. По плану мышь тоже будет включена в работу для нее даже создан компонент. Турель будет следить за курсором, но я предпочитаю самой написать код. Сейчас delphi 7 выдает результат который я не могу объяснить.

Сообщение отредактировано: Katerina1993 - 30.03.24, 02:59

[macomics]

Добавьте в начале procedure TForm1.Timer1Timer(Sender: TObject); строчку Image1.Invalidate;

[Katerina1993]

Добавила, ничего не изменилось.
Прикреплённый файлimg3.jpg (41,88 Кбайт, скачиваний: 12)

[Katerina1993]

Все исправила, оказывается нужно сохранить параметры используя функцию SaveDc, а потом восстановить RestoreDC.

SetGraphicsMode(hDc2, GM_ADVANCED);
   SaveDC(hDc2);
   fillChar(M, sizeOf(M), 0);
   M.eM11 := mtx.a;
   M.eM12 := mtx.b;
   M.eM21 := mtx.c;
   M.eM22 := mtx.d;
   M.eDx := mtx.tx;
   M.eDy := mtx.ty;
 
   ModifyWorldTransform(hDc2, M, MWT_LEFTMULTIPLY);
 
  Cs.Draw(0,0,bitmap0);
  RestoreDC(HDC2,1);

Код выше я перенесла в процедуру TMatrix1.Draw() и вызываю ее в TForm1.Timer1Timer.
Полностью код и исходники: Прикреплённый файлRotateObj.zip (14,19 Кбайт, скачиваний: 8)

unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, AppEvnts, StdCtrls;
 
type
  TPoint1 = record x,y:Currency  ; end;
  TForm1 = class(TForm)
    Image1: TImage;
    ApplicationEvents1: TApplicationEvents;
    Label1: TLabel;
    Timer1: TTimer;
    Label2: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure ApplicationEvents1Message(var Msg: tagMSG;
      var Handled: Boolean);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
  TMatrix1 = class
  private
      a, b, c,d,tx,ty: Real;
      fr:TForm;
      bitmap0:TBitmap;
      Cs:TCanvas;
  public
    constructor Create(_bitmap:TBitmap;_Cs:TCanvas;_fr:TForm;_a, _b,_c,_d, _tx, _ty: Real);
    Procedure Draw();
    function identity ():TMatrix1;
    function appendTransform (x, y, scaleX, scaleY:Real; rotation:Integer; skewX, skewY, regX, regY:Real):TMatrix1;
    function append(a2, b2, c2, d2, tx2, ty2:Real):TMatrix1;
  end;
 
var
  Form1: TForm1;
  bmp1: TBitmap;
  x1:Integer = 225;
  y1:Integer = 275;
  rotate1:Integer = 90;
  pt:TPoint1;
  mtx:TMatrix1;
implementation
 
{$R *.dfm}
 
constructor TMatrix1.Create(_bitmap:TBitmap;_Cs:TCanvas;_fr:TForm;_a, _b,_c,_d, _tx, _ty: Real);
begin
   inherited Create;
   fr:=_fr;
   bitmap0:=_bitmap;
   Cs:=_Cs;
   a:=_a;
   b:=_b;
   c:=_d;
   tx:=_tx;
   ty:=_ty;
end;
 
procedure TMatrix1.Draw();
var HDC2:THandle; M:TXFORM;
begin
   mtx.identity();
   mtx.appendTransform(x1, y1, 1, 1, rotate1, 0, 0, 16, 29.5);
 
   hDc2 := Cs.Handle;
 
   SetGraphicsMode(hDc2, GM_ADVANCED);
   SaveDC(hDc2);
   fillChar(M, sizeOf(M), 0);
   M.eM11 := mtx.a;
   M.eM12 := mtx.b;
   M.eM21 := mtx.c;
   M.eM22 := mtx.d;
   M.eDx := mtx.tx;
   M.eDy := mtx.ty;
 
   ModifyWorldTransform(hDc2, M, MWT_LEFTMULTIPLY);
 
  Cs.Draw(0,0,bitmap0);
  RestoreDC(HDC2,1);
end;
 
function TMatrix1.identity():TMatrix1;
begin
  a := 1;
  d := 1;
  b := 0;
  c := 0;
  tx := 0;
  ty := 0;
  Result:=mtx;
end;
 
function TMatrix1.appendTransform(x, y, scaleX, scaleY:Real; rotation:Integer; skewX, skewY, regX, regY:Real):TMatrix1;
var r, cos1, sin1:Real; a1:Integer;
begin
a1:=rotation mod 360;
 
 
    if a1 < 360 then
    begin
       r := rotation*PI/180;
       cos1 := cos(r);
       sin1 := sin(r);
    end
    else
    begin
      cos1 := 1;
      sin1 := 0;
    end;
   append(cos1*scaleX, sin1*scaleX, -sin1*scaleY, cos1*scaleY, x, y);
 
   tx := tx - (regX*a+regY*c);
   ty := ty - (regX*b+regY*d);
   fr.Caption:=FloatToStr(c);
  Result:=mtx;
end;
 
function TMatrix1.append(a2, b2, c2, d2, tx2, ty2:Real):TMatrix1;
var a1,b1,c1,d1:Real;
begin
  a1:=a;
  b1:=b;
  c1:=c;
  d1:=d;
 
  if (a2 <> 1) or (b2 <> 0) or (c2 <> 0) or (d2 <> 1) then
  begin
     a  := a1*a2+c1*b2;
     b  := b1*a2+d1*b2;
     c  := a1*c2+c1*d2;
     d  := b1*c2+d1*d2;
  end;
  tx:=a1*tx2+c1*ty2+tx;
  ty:=b1*tx2+d1*ty2+ty;
  Result:=mtx;
end;
 
procedure TForm1.FormCreate(Sender: TObject);
 
begin
  bmp1 := TBitmap.Create;
  bmp1.LoadFromFile('.\WeaponQuadSkin.bmp');
 
  mtx:=TMatrix1.Create(bmp1,Image1.Canvas,Form1,1,0,0,0,0,0);
 
  Timer1.Enabled:=True;
 
end;
 
procedure TForm1.ApplicationEvents1Message(var Msg: tagMSG;
  var Handled: Boolean);
//var P : TPoint;
begin
if Msg.message = WM_MOUSEMOVE then
begin
 //P:=Image1.ScreenToClient(Mouse.CursorPos);
 //pt.x := P.X;
 //pt.y := P.Y;
 
end;
end;
 
procedure TForm1.Timer1Timer(Sender: TObject);
 
begin
 
  Form1.Image1.Canvas.Brush.Color:=clWhite;
  Form1.Image1.Canvas.FillRect(Form1.Image1.ClientRect);
 
 
   rotate1:=rotate1+5;
 
   mtx.Draw();
 
 
end;
 
end.

Теперь все работает без зависания и использования мышки.

Сообщение отредактировано: Katerina1993 - 30.03.24, 15:18

[Mr.Delphist]

Цитата Katerina1993 @ 30.03.24, 02:59

поворот происходит только когда я перемещаю мышку по холсту, что мне кажется странным

Ничего странного - если мышка вне холста, то тот не получает сообытий про новое положение мышки. Если хочется получать такие события всегда - почитайте про mouse capture.