اسکرول دیتا گرید با ماوس

[mostafag]

سلام دوستان

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

آیا کدی وجود داره که بتونه این خاصیت رو به این شی بده؟ :متفکر:

(من خیلی جستجو کردم چیزی که بتونه جوابمو بده پیدا نکردم)

با تشکر از همه شما عزیزان :لبخندساده:

[mostafag]

سلام به همه شما دوستان عزیز

یعنی هیچ کس در این رابطه نظری نداره
یعنی این همه برنامه نویس کسی تا به حال به این فکر نکرده

کسی راه حلی یا چیزی به ذهنش نمی رسه؟!!!!!!!! :متفکر:

یعنی کسی توی این سایت به این بزرگی تا به حال به همچین چیزی فکر نکرده!!!!! :متعجب: :افسرده:

[returnx]

اسکرول وسط ماوس بربر با 16 هست یعنی زمانی که روی Datagrid ماوس فشار داده بشه اگر اسکرول وسط ماوس فشار داده بشه عدد 16 رو به ما بر میگردونه خوب ممیشه با همین خاصیت ها یه کار هایی کرد.

[mostafag]

سلام دوست عزیز
بالاخره یه نفر جواب داد :اشتباه:
با تشکر از پاسخگویی شما

من این کد رو داخل یه دکمه نوشتم


DataGrid1.Scroll DataGrid1.Col , DataGrid1.Row + 2

این کد درست عمل می کنه و هر بار که دکمه فشار داده میشه میاد و دیتاگرید رو به تعداد دو ردیف اسکرول میده
فقط من می خوام این کد زمانی اجرا بشه که ما اسکرول رو داریم بالا یا پایین می کنیم
من با توجه به نوشته دوست عزیزمون این کد رو در رویداد MouseDown دیتاگرید نوشتم


If Button = 16 Then
DataGrid1.Scroll DataGrid1.Col, DataGrid1.Row + 2
End If


اما هیچ عکس العملی نشون نداد :متفکر: :گیج:
من تا حالا نشنیده بودم که اسکرول موس کد اسکی داشته باشه(اصلا آیا این کد اسکی اسکرول موس هست؟ :متفکر: )
راستی فقط اگه مقدار Button رو به 1 (کلیک چپ) یا 2 (کلیک راست)یا 4 (کلیک وسط موس نه اسکرول) تغییر بدید با مثلا کلیک چپ کردن جواب می گیرید و دیتا گرید اسکرول میشه

اما اگه میشه یکم در مورد این 16 توضیح بدید
آیا این کد اسکی هست یا چیزه دیگه اصلا باید کجا بنویسیم :متفکر:

باز هم از شما و همه دوستان برنامه نویس تشکر میکنم :لبخندساده:

[mostafag]

سلام به همه
دوستان اگه چیزی میدونید دریغ نکنید

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

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

آیا بوسیله Api خاصی میشه این کار رو کرد؟
اگه کسی می دونه بگه
این موضوع خیلی بدرد بخوره
با تشکر از همه :لبخندساده:

[MEhdi Sobhani]

سلام
من خیلی وقته از این کدها استفاده میکنم و با این در واقع میتونی اسکرول رو روی هر کنترلی استفاده کنی .
یه مقدار زیاده .
اول این کدها و باید بزاری داخل یه ماژول :



Private Declare Function ExtFloodFill Lib "GDI32" (ByVal hDC As Long, ByVal X As Long, ByVal Y As Long, ByVal colorCode As Long, ByVal fillType As Long) As Long
Private Declare Function GetWindowRect Lib "USER32" (ByVal hWnd As Long, lpRect As RECT) As Long
Const FLOODFILLBORDER = 0
Const FLOODFILLSURFACE = 1
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Declare Function CallWindowProc Lib "user32.dll" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal Wparam As Long, ByVal Lparam As Long) As Long
Private Declare Function SetWindowLong Lib "user32.dll" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Const MK_CONTROL = &H8
Public Const MK_LBUTTON = &H1
Public Const MK_RBUTTON = &H2
Public Const MK_MBUTTON = &H10
Public Const MK_SHIFT = &H4
Private Const GWL_WNDPROC = -4
Private Const WM_MOUSEWHEEL = &H20A
Private Const WM_LBUTTONDBLCLK = &H203
Declare Function Polygon Lib "GDI32" (ByVal hDC As Long, lpPoint As POINTAPI, ByVal nCount As Long) As Long
Declare Function Ellipse Lib "GDI32" (ByVal hDC As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Type POINTAPI
X As Long
Y As Long
End Type
Dim LocalHwnd As Long
Dim LocalPrevWndProc As Long
Dim MyForm As Form
Private Function WindowProc(ByVal Lwnd As Long, ByVal Lmsg As Long, ByVal Wparam As Long, ByVal Lparam As Long) As Long
Dim MouseKeys As Long
Dim Rotation As Long
Dim Xpos As Long
Dim Ypos As Long
If Lmsg = WM_MOUSEWHEEL Then
MouseKeys = Wparam And 65535
Rotation = Wparam / 65536
Xpos = Lparam And 65535
Ypos = Lparam / 65536
MouseWheel MouseKeys, Rotation, Xpos, Ypos
End If
WindowProc = CallWindowProc(LocalPrevWndProc, Lwnd, Lmsg, Wparam, Lparam)
End Function
Public Sub WheelHook(PassedForm As Form)
'Exit Sub
On Error Resume Next
Set MyForm = PassedForm
LocalHwnd = PassedForm.hWnd
LocalPrevWndProc = SetWindowLong(LocalHwnd, GWL_WNDPROC, AddressOf WindowProc)
End Sub
Public Sub WheelUnHook()
Dim WorkFlag As Long
On Error Resume Next
WorkFlag = SetWindowLong(LocalHwnd, GWL_WNDPROC, LocalPrevWndProc)
Set MyForm = Nothing
End Sub
Sub MouseWheel(MouseKeys, Rotation, Xpos, Ypos)
On Local Error Resume Next
Dim ctl As Control
Dim bHandled As Boolean
Dim bOver As Boolean
For Each ctl In MyForm.Controls
On Error Resume Next
bOver = (ctl.Visible And IsOver(ctl.hWnd, Xpos, Ypos))
'On Error GoTo 0
If bOver Then
If TypeOf ctl Is MSFlexGrid Then
FlexGridScroll ctl, MouseKeys, Rotation, Xpos, Ypos
bHandled = True
Exit For
End If
End If
bOver = False
Next ctl

End Sub
Public Sub FlexGridScroll(ByRef FG As MSFlexGrid, ByVal MouseKeys As Long, ByVal Rotation As Long, ByVal Xpos As Long, ByVal Ypos As Long)
Dim NewValue As Long
Dim Lstep As Single

On Error Resume Next
With FG
Lstep = .Height / .RowHeight(0)
Lstep = Int(Lstep)
If .Rows < Lstep Then Exit Sub
Do While Not (.RowIsVisible(.TopRow + Lstep))
Lstep = Lstep - 1
Loop
If Rotation > 0 Then
NewValue = .TopRow - Lstep
If NewValue < 1 Then
NewValue = 1
End If
Else
NewValue = .TopRow + Lstep
If NewValue > .Rows - 1 Then
NewValue = .Rows - 1
End If
End If
.TopRow = NewValue
End With
End Sub

Public Function IsOver(ByVal hWnd As Long, ByVal lX As Long, ByVal lY As Long) As Boolean
Dim rectCtl As RECT
GetWindowRect hWnd, rectCtl
With rectCtl
IsOver = (lX >= .Left And lX <= .Right And lY >= .Top And lY <= .Bottom)
End With
End Function


این کد در واقع میگرده و کنترلهای فرم رو اسکن میکنه اگر نوعش فلکگرید بود تابع فلکساسکرول رو اجرا میکنه .
اما روش استفاده از این دستورات .
هر فرمی که می خوای اسکرول ماوس روش فعال بشه باید داخلش ( load یا activate و ... ) تابع WheelHook FormName رو اجرا کنی و وقتی خواستی اسکرولش غیر فعال بشه wheelunhook رو اجرا میکنی

موفق وپیروز باشی .

[returnx]

بله من اشتباه کردم اسکرول وسط ماوس همون 4 هست.

[mostafag]

سلام
با تشکر از آقای مهدی سبحانی

من از کد شما استفاده کردم و اول کد رو داخل ماژول کپی کردم
بعد این کد رو داخل Form_Load نوشتم(البته Form_Activate رو هم امتحان کردم)



WheelHook Form1

اما زمانی که برنامه رو اجرا می کنم به این خط گیر میده



Public Sub FlexGridScroll(ByRef FG As MSFlexGrid, ByVal MouseKeys As Long, ByVal Rotation As Long, ByVal Xpos As Long, ByVal Ypos As Long)


می تونید بگید ایرادش چیه؟؟ :متفکر::ناراحت:

عکس خطایی هم که میده رو ضمیمه کردم
با تشکر از شما

[MEhdi Sobhani]

سلام
با تشکر از آقای مهدی سبحانی

من از کد شما استفاده کردم و اول کد رو داخل ماژول کپی کردم
بعد این کد رو داخل Form_Load نوشتم(البته Form_Activate رو هم امتحان کردم)



WheelHook Form1
اما زمانی که برنامه رو اجرا می کنم به این خط گیر میده



Public Sub FlexGridScroll(ByRef FG As MSFlexGrid, ByVal MouseKeys As Long, ByVal Rotation As Long, ByVal Xpos As Long, ByVal Ypos As Long)
می تونید بگید ایرادش چیه؟؟ :متفکر::ناراحت:

عکس خطایی هم که میده رو ضمیمه کردم
با تشکر از شما
سلام احتمالا منظور نوع MSFlexGrid هست .
چک کنید ببینید این در کامپوننتهاتون هست یا نه .
یه فلکس گرید روی یه فرم داشته باشید این تایپ خودکار اضافه شده .

در ادامه اینکه تابع اصلی همون تابع MouseWheel هست که با چند تا پارامتر سادش موقع اسکرال موس اجرا میشه .
این تابع فلکسگریداسکرال واسه راحتی کار نوشته شده .
می تونید داخل همون تابع mousewheel کدها رو اضافه کنید واسه اسکرال فلکسگرید یا هر کار دیگه ای .

[mostafag]

سلام دوباره

من می خوام این کار رو برای دیتا گرید انجام بدم

میشه یه نمونه کد ساده که داخلش که دیتا گرید باشه که اسکرول بشه قرار بدید
اگه این کار رو بکنید واقعا ممنون میشم

چون من هر کاری کردم نشد که نشد

[MEhdi Sobhani]

سلام دوباره

من می خوام این کار رو برای دیتا گرید انجام بدم

میشه یه نمونه کد ساده که داخلش که دیتا گرید باشه که اسکرول بشه قرار بدید
اگه این کار رو بکنید واقعا ممنون میشم

چون من هر کاری کردم نشد که نشد



Public Sub DataGridScroll(ByRef DG As DataGrid, ByVal MouseKeys As Long, ByVal Rotation As Long, ByVal Xpos As Long, ByVal Ypos As Long)
If Rotation > 0 Then
FG.Scroll 0, DG.row + 1
Else
FG.Scroll 0, DG.row - 1
End If
End Sub



این ساب رو به جای اون ساب قبلی در تابع mousewheel فراخوانی کن .
فقط اینکه من امتحانش نکردم .
مثلا اینکه باید چک کنی مقدار row جدید که دیتاگرید میخواد بهش اسکرال کنه کمتر از 0 یا بیشتر از ستونهای دیتا گرید نباشه .
در کل Rotation واسه اسکرال به بالا مثبت و به پایین منفی هست . (شاید هم عککس این دقیق خاطرم نیست )
با دونستن همین همه کار میشه کرد .