حرکت دادن اشیا با یک خط کد بدون 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
پاسخ با نقل قول
