1 ضمیمه
جابجائی همزمان دو تا فرم با دراگ کردن عنوان فرم اصلی
با سلام
با استفاده از کد های زیر در یک ماژول عمومی :
Public Declare Function SendMessage Lib "User32" _
Alias "SendMessageA" _
(ByVal hWnd As Long, ByVal wMsg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long
Public Declare Function ReleaseCapture Lib "User32" () As Long
Public Const WM_NCLBUTTONDOWN = &HA1 'when left mouse button is clicked
Public Const HTCAPTION = 2 'signed that mouse is working on titlebar.
و با استفاده از کد زیر در رویداد MouseDown یک کنترل مثل یک لیبل میتوانیم با چپ کلیک و پائین نگه داشتن موس فرم را جابجا کنیم:
If Button = 1 Then
Call ReleaseCapture
Call SendMessage(Me.hWnd(), WM_NCLBUTTONDOWN, HTCAPTION, 0&)
' Call SendMessage(Form("Form2").hWnd(), WM_NCLBUTTONDOWN, HTCAPTION, 0&)
End If
حالا سوال اینجاست که آیا میتوان با همین کد که فرم جاری رو جابجا میکنه همزمان فرم دیگری رو جابجا کنیم ؟
در رخداد Form_Timer و تنظیم TimerInterval مساوی عدد 1 اینکار شدنیه ولی هدف بنده اینست که از Form_Timer استفاده نکنم و با همان تابع Call SendMessage اینکار صورت بکیره
لطفاً نمونه ضمیمه رو ملاحظه بفرمائید!
با تشکر
نقل قول: جابجائی همزمان دو تا فرم با دراگ کردن عنوان فرم اصلی
سلام
از کدهای زیر در رویداد MouseDown و MouseMove کنترل مربوطه در فرم اصلی استفاده کن !
Public xX As Single
Public yY As Single
Public winTop As Single
Public winLft As Single
Private Sub TitelBarCtl_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
winTop = Me.WindowTop
winLft = Me.WindowLeft
xX = X
yY = Y
End Sub
Private Sub TitelBarCtl_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If X > xX Then
X = X - xX
winLft = winLft + X
Else
X = xX - X
winLft = winLft - X
End If
If Y > yY Then
Y = Y - yY
winTop = winTop + Y
Else
Y = yY - Y
winTop = winTop - Y
End If
Select Case Button
Case vbKeyLButton
Me.Move winLft, winTop
Forms("Form2").Move Me.WindowLeft, Me.WindowTop + Me.WindowHeight
End Select
End Sub
در اینجا نام کنترل مربوطه TitelBarCtl فرض شده
نقل قول: جابجائی همزمان دو تا فرم با دراگ کردن عنوان فرم اصلی
نقل قول:
نوشته شده توسط
eb_1345
سلام
از کدهای زیر در رویداد MouseDown و MouseMove کنترل مربوطه در فرم اصلی استفاده کن !
Public xX As Single
Public yY As Single
Public winTop As Single
Public winLft As Single
Private Sub TitelBarCtl_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
winTop = Me.WindowTop
winLft = Me.WindowLeft
xX = X
yY = Y
End Sub
Private Sub TitelBarCtl_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If X > xX Then
X = X - xX
winLft = winLft + X
Else
X = xX - X
winLft = winLft - X
End If
If Y > yY Then
Y = Y - yY
winTop = winTop + Y
Else
Y = yY - Y
winTop = winTop - Y
End If
Select Case Button
Case vbKeyLButton
Me.Move winLft, winTop
Forms("Form2").Move Me.WindowLeft, Me.WindowTop + Me.WindowHeight
End Select
End Sub
در اینجا نام کنترل مربوطه TitelBarCtl فرض شده
سلام
بسیار بسیار عالی:تشویق::تشویق::تشویق:
بی نهایت سپاسگزارم