PDA

View Full Version : سوال: تغيير مكان تكست باكس با پائين نگه داشتن موس



abas1388
سه شنبه 07 اردیبهشت 1389, 14:41 عصر
سلام
آيا اين امكان وجود دارد كه با پائين نگه داشتن موس (قسمت راست كليك ) و فوكوس بر روي يك تكست باكس ، آن را به مكان ديگري از فرم منتقل كنيم .اينكار از طريق كليد هاي صفحه كليد قابل انجام است ولي از طريق موس نميدانم شدنيه يا نه ؟
با تشكر

butterfly8528
سه شنبه 07 اردیبهشت 1389, 20:55 عصر
سلام دوست عزیز .

منظورت اینه که با موس بتونی text box رو جا به جا کنی ؟

abas1388
چهارشنبه 08 اردیبهشت 1389, 11:36 صبح
سلام دوست عزیز .

منظورت اینه که با موس بتونی text box رو جا به جا کنی ؟
سلام
بله
با تشكر

butterfly8528
چهارشنبه 08 اردیبهشت 1389, 16:50 عصر
سلام .

قبلا چند بار این سوال پرسیده شده و به نتیجه هم رسیده بود، اگه میگشتی پیدا میکردی !

روش اول :



Dim xo&, yo&

Private Sub Text1_DragDrop(Source As Control, X As Single, Y As Single)
Text1.Left = X - xo + Label1.Left
Text1.Top = Y - yo + Label1.Top
End Sub

Private Sub Text1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
xo = X
yo = Y
Text1.Drag
End Sub

Private Sub Form_DragDrop(Source As Control, X As Single, Y As Single)
Text1.Left = X - xo
Text1.Top = Y - yo
End Sub




روش دوم :



Private Declare Function ReleaseCapture Lib "user32" () As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" ( _
ByVal hWnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
lParam As Any) As Long

Public Sub ObjectMove(Obj As Object)

Dim lngReturnValue As Long

Call ReleaseCapture
lngReturnValue = SendMessage(Obj.hWnd, &HA1, 2, 0&)

End Sub


Private Sub Text1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
ObjectMove Text1
End Sub



روش دوم برای اشیایی که خاصیت hWnd ندارند ( مانند Label ) قابل استفاده نیست !

موفق باشی .

abas1388
چهارشنبه 08 اردیبهشت 1389, 18:16 عصر
سلام
ضمن تشكراز شما استاد بزرگوار ، روش دوم مد نظر بنده ميباشد كه در محيط وي بي قابل اجرا است اما اين جابجائي تكست باكس بوسيله موس را در محيط اكسس مي خواستم اجرا كنم كه متأسفانه كد فوق در محيط اكسس قابل اجرا نمي باشد و هنگام اجرا از قطعه كد lngReturnValue = SendMessage(Obj.hWnd, &HA1, 2, 0&) ايراد گرفته ميشود و خطاي ران تايم شماره 438 با اين عنوان كه آبجكت نميتواند خاصيت فوق را ساپورت كند صادر ميشود .
به هر حال ممنون از اينكه زحمت كشيديد .