شبیه سازی درگ ماوس

[mbshareat]

سلام
یه بازی جدید اومده که اصالتا مال موبایل بوده!اسمش Subway Surf هستش.
چپ و راست رفتن و پرش و از زیر رفتنش با درگ ماوسه.
میخواستم درگ ماوس رو شبیه سازی کنم اما موفق نشدم:
..
private
{ Private declarations }
Procedure WMHotkey( Var msg: TWMHotkey );message WM_HOTKEY;
procedure MDrag(X, Y: Integer);
..
procedure TForm1.FormCreate(Sender: TObject);
begin
RegisterHotkey (Handle, 1, MOD_Control, Ord('A'));
RegisterHotkey (Handle, 2, MOD_Control, Ord('W'));
RegisterHotkey (Handle, 3, MOD_Control, Ord('D'));
RegisterHotkey (Handle, 4, MOD_Control, Ord('S'));
end;
...
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
UnRegisterHotkey( Handle, 1 ) ;
UnRegisterHotkey( Handle, 2 ) ;
UnRegisterHotkey( Handle, 3 ) ;
UnRegisterHotkey( Handle, 4 ) ;
end;
procedure TForm1.MDrag(X,Y:Integer);
Var
St:Word;
begin
St:=30000;
Application.ProcessMessages;
Mouse_Event(MOUSEEVENTF_ABSOLUTE or MOUSEEVENTF_LEFTDOWN,St, St,0,0) ;
Mouse_Event(MOUSEEVENTF_ABSOLUTE or MOUSEEVENTF_MOVE,St+X*10000,St+Y*10000,0,0);
Mouse_Event(MOUSEEVENTF_ABSOLUTE or OUSEEVENTF_LEFTUp,St+X*10000,St+Y*10000,0,0);

Application.ProcessMessages;
end;
Function WindowClassName(H:THandle):String;
Var
aName:array [0..255] of char;
begin
GetClassName(H,aName, 256);
Result:=aName;
end;
Function WindowCaption(H:THandle):String;
Var
aText:array [0..255] of char;
begin
SendMessage(H, WM_GETTEXT,
SizeOf(aText), integer(@aText)) ;
Result:=aText;
end;

Procedure TForm1.WMHotkey( Var msg: TWMHotkey ) ;
Var
R:TRect;
Begin
label1.Caption:=WindowCaption(WindowfromPoint(Poin t(500,500)))+intToStr(msg.hotkey);
// if WindowCaption(WindowfromPoint(Point(500,500)))
// <>'Subway Surfe' then
// exit;
Case msg.hotkey of
1://Left
MDrag(-1,0);
2://Up
MDrag(0,-1);
3://Right
MDrag(1,0);
4://Down
MDrag(0,1);
End;
End;


شبیه سازی درگ ماوس برای شبیه ساز بازیهای PSP هم به دردم میخوره.
یه سوال ریز هم دارم:برای به دست آوردن مختصات دقیق نقطه برای ارسال با SendMessage باید محل پیکسل رو ضرب در چه عددی بکنیم؟ظاهرا به DPI ربط داره ولی چیزی ازش یادم نمیاد.
کسی راهنمایی میکنه؟

[idehrayan]

سلام
در لینک زیر چند روش ذکر شده
روشی ساده برای درگ کردن (http://barnamenevis.org/showthread.php?483335-%D8%B1%D9%88%D8%B4%DB%8C-%D8%B3%D8%A7%D8%AF%D9%87-%D8%A8%D8%B1%D8%A7%DB%8C-Drag-Drop-%DA%A9%D8%B1%D8%AF%D9%86)

[mbshareat]

بابا سوال رو درست بخونید.من چه کار به فرم برنامه دارم؟

[یوسف زالی]

فکرت رو دوست داشتم، ولی دلیل این که absolute کار کردی رو نفهمیدم.
این رو روی سیستم خودم نوشتم و تست کردم کار می کنه. تست کن خبر بده.



type
TMouseDragParam = (mdUp, mdDown, mdLeft, mdRight);
TMouseDragParams = set of TMouseDragParam;


procedure MouseDrag(Params: TMouseDragParams);
const
STEP = 10;
var
X, Y: DWORD;
begin
X := IfThen(mdRight in Params, STEP, 0) - IfThen(mdLeft in Params, STEP, 0);
Y := IfThen(mdDown in Params, STEP, 0) - IfThen(mdUp in Params, STEP, 0);

mouse_event(MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0);
Sleep(1);
mouse_event(MOUSEEVENTF_MOVE, X, Y, 0, 0);
Sleep(1);
mouse_event(MOUSEEVENTF_MOVE, X, Y, 0, 0);
Sleep(1);
mouse_event(MOUSEEVENTF_MOVE, X, Y, 0, 0);
Sleep(1);
mouse_event(MOUSEEVENTF_MOVE, X, Y, 0, 0);
Sleep(1);
mouse_event(MOUSEEVENTF_MOVE, X, Y, 0, 0);
Sleep(1);
mouse_event(MOUSEEVENTF_LEFTUP, 0, 0, 0, 0);
end;


اون 5 تا رو هم می شد for گرفت :لبخند:

[mbshareat]

سلام
من از دلفی قدیمی استفاده میکنم که ifthen نداره!
اما از MouseEvent بدون MOUSEEVENTF_ABSOLUTE استفاده کردم جواب نداد.
فکر می کردم توی کدم از SendMessage استفاده کرده ام.ممکنه MouseEvent به درد این کار نخوره.
منظورتون از کار می کنه چیه؟فقط تکون خوردن ماوس که برنامم انجام میداد اما توی بازی اتفاقی نمیافتاد.

حجم بازیش کلا 23 مگا بایته.نمی دونم میتونم تقاضا کنم برنامه تون رو روی بازی چک کنید؟
من میخوام ماوس از و سط صفحه به یکی از چهار طرف صد پیکسل درگ بشه!

نسخه XE2 دارم که برنامه رو بذارید تستش کنم و برای PSP تغییر بدم.فقط براتون زحمت میشه.

[یوسف زالی]

دلفی من نسخه 7 هست، دستور ifthen در یونیت های math و strutils وجود داره.
ایرادی نداره، بازی رو برام بفرستید تست می کنم.

[mbshareat]

سلام
دیشب اینترنت اونقدر کند بود که عملا با قطع چندان فرقی نداشت.
من از اینجا (http://dl.3sotdownload.com/dl/91/12/Subway%20Surfers%20PC%20%5Bwww.3sotdownload.com%5D .zip) دانلود کردم.باز هم معذرت میخوام که زحمت میدم.
يه نکته هم بگم:توي XP فقط داره نقاشي ميکنه و وارد بازي نميشيم اما توي ويندوز سون برام کار ميکنه!

[یوسف زالی]

روی بازی تست کردم درست کار می کنه.
فکر می کنم شما در جای دیگه ای اشتباه دارید.