حرکت دادن اشیا با یک خط کد بدون DragDrop (شاید جالب و مفید)

سلام عزیزان دل
خدا بگم این VB6 زا چه کار بکنه که تا حالا چندین بار خواستم ببوسمش بزارم کنار ولی یک دفعه یک چیزی کشف و پیدا میکنم که تا یک هفته منو مشغول میکنه به خودش. (خدا ریش #c بکنه)


خب عزیزان کدی که برای شما قرار میدم استفاده از اون ساده است و توضیحات خاصی نداره. فقط به دلیل راحتی استفاده از اون کد را براتون میزارم

اول این کد را در قسمت General تعریف کنید:

Private Declare Function ReleaseCapture Lib "user32" () As Long

Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long





Const WM_NCLBUTTONDOWN = 161

Const HTCAPTION = 2

و در آخر این کد را در قسمت رویداد MouseDown اشیا قرار دهید. حتی Form1!

ReleaseCapture
PostMessage CONTROL.hWnd, WM_NCLBUTTONDOWN, HTCAPTION, ByVal 0


تنها توضیحی که لازم است در اینجا به جای CONTROL.hWnd نام اشیا را استفاده کنید
مثلا: Text1.hWnd / Lable1.hWnd / Command1.hWnd

و در آخر مقدار HTCAPTION برابر شده با 2 که کل شیء را جابه جا میکنه که اگر به مقدارهای زیر تقییر بدهید واکنش های متفاوتی انجام می دهد حتی تغییر اندازه. / شاد پیروز موفق باشید.

2 =Move
9 =FullSize
10 =Left
11 =Right
12 =Top
13 =TopLeft
14 =TopRight
15 =Down
16 =DownLeft
17 =DownRight


نمونه کد تمرینی و آزمایشی.

Private Declare Function ReleaseCapture Lib "user32" () As Long

Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long





Const WM_NCLBUTTONDOWN = 161

Const HTCAPTION = 2





Private Sub Command1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)





Dim Xx, Yy

    ReleaseCapture

    

    Select Case Command1.MousePointer

       Case 0: Command1.MousePointer = 5: PostMessage Command1.hWnd, WM_NCLBUTTONDOWN, 2, ByVal 0&

       Case 8: PostMessage Command1.hWnd, WM_NCLBUTTONDOWN, 17, ByVal 0&

       Case 6: PostMessage Command1.hWnd, WM_NCLBUTTONDOWN, 16, ByVal 0&

    End Select

    

  

Select Case X

  Case Is > Command1.Width - 120:  Xx = 1

    PostMessage Command1.hWnd, WM_NCLBUTTONDOWN, 11, ByVal 0&

  Case Is < 80: Xx = 2

    PostMessage Command1.hWnd, WM_NCLBUTTONDOWN, 10, ByVal 0&

End Select





Select Case Y

  Case Is > Command1.Height - 120: Yy = 4

  PostMessage Command1.hWnd, WM_NCLBUTTONDOWN, 15, ByVal 0&

  Case Is < 80: Yy = 8

  PostMessage Command1.hWnd, WM_NCLBUTTONDOWN, 12, ByVal 0&

End Select

 

 

End Sub





Private Sub Command1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)

Dim Xx, Yy

Command1.MousePointer = 0





Select Case X

  Case Is > Command1.Width - 120:  Xx = 1: Command1.MousePointer = 9

  Case Is < 80: Xx = 2: Command1.MousePointer = 9

End Select





Select Case Y

  Case Is > Command1.Height - 120: Yy = 4: Command1.MousePointer = 7

  Case Is < 80: Yy = 8: Command1.MousePointer = 7

End Select

 

 

Select Case Yy + Xx

  Case 5:   Command1.MousePointer = 8

  Case 10:  Command1.MousePointer = 8

  Case 9:  Command1.MousePointer = 6

  Case 6:   Command1.MousePointer = 6

End Select

 

End Sub

خیلی جالب بود من یه سورس مشابه این دارم ولی از چند تا کلاس طولانی استفاده شده توش که دقیقا همین کارو انجام میده اما این خیلی جالب بود که با این کد های کوتاه هم اسکیل و همم حرکت رو انجا میده ممنون:تشویق:

اختیار داری داداش اینکه چیزی نیست که
یک چیزهای در اینده میزارم که اصلا یک جور دیگه به وی بی نگاه کنی
برنامه نویسی برای اندورید با کامپایل و برنامه نویسی برای میکروکنترل با خود ویبی6 هم قرار میدم
حالا شما وایسا وقت پیدا بکنم. اون وقت میبینی.

انشالله ، منتظرم