Форум на Исходниках.RU

Форум на Исходниках.RU https://forum.sources.ru Форум на Исходниках.RU Форум на Исходниках.RU https://forum.sources.ru/index.php?showtopic=444071&view=findpost&p=3903009 Sat, 13 Apr 2024 12:08:07 +0000 Проблемы с вращением турели? https://forum.sources.ru/index.php?showtopic=444071&view=findpost&p=3903009 Цитата Katerina1993 @ 30.03.24, 02:59

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

Ничего странного - если мышка вне холста, то тот не получает сообытий про новое положение мышки. Если хочется получать такие события всегда - почитайте про mouse capture.]]> Mr.Delphist Delphi: Общие вопросы https://forum.sources.ru/index.php?showtopic=444071&view=findpost&p=3902354 Sat, 30 Mar 2024 15:16:44 +0000 Проблемы с вращением турели? https://forum.sources.ru/index.php?showtopic=444071&view=findpost&p=3902354

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 (, : 101)

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;

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.

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

]]> Katerina1993 Delphi: Общие вопросы https://forum.sources.ru/index.php?showtopic=444071&view=findpost&p=3902350 Sat, 30 Mar 2024 07:49:38 +0000 Проблемы с вращением турели? https://forum.sources.ru/index.php?showtopic=444071&view=findpost&p=3902350 img3.jpg (, : 102) ]]> Katerina1993 Delphi: Общие вопросы https://forum.sources.ru/index.php?showtopic=444071&view=findpost&p=3902349 Sat, 30 Mar 2024 06:52:00 +0000 Проблемы с вращением турели? https://forum.sources.ru/index.php?showtopic=444071&view=findpost&p=3902349 macomics Delphi: Общие вопросы https://forum.sources.ru/index.php?showtopic=444071&view=findpost&p=3902346 Sat, 30 Mar 2024 02:59:14 +0000 Проблемы с вращением турели? https://forum.sources.ru/index.php?showtopic=444071&view=findpost&p=3902346
Здесь я использую ModifyWorldTransform для разворота объекта. Если указать статические параметры например 90, то объект разворачивается куда надо. Я решила попробовать использовать динамические параметры, прибавляю по 5 градусов каждые 20 миллисекунд (Компонент Timer).

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

user posted image

Вот сам код и исходники. RotateObj.zip (, : 101)

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;

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 Delphi: Общие вопросы