تماس با ما: 02166057992 چت آنلاین   ورود

آموزش: حرکت دادن اشیا با یک خط کد بدون 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 که کل شیء را جابه جا میکنه که اگر به مقدارهای زیر تقییر بدهید واکنش های متفاوتی انجام میدهد تغییر اندازه. / شاد پیروز موفق باشید.

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



برنامه نویس
جهت کسب اطلاعات بیشتر به انجمن برنامه نویس مراجعه نمایید

نظرات شما

WhatsApp chat