طريقة عمل Resize لحقول ListBox بالماوس

أخواني

السلام عليكم ورحمة الله وبركاتة

أثناء تصفحي لاحدي المنتديات الاجنبية استوقفني Module اسمة basScrollBar وهذا الــ Module وظيفتة عمل Resize لحقول ListBox عن طريق الماوس وبعد تجارب توصلت لهذا المثال أتمني أن ينال الاعجاب

أنسخ هذا الموديول لقاعده بياناتك وجرب ... أو استورد الاكواد مباشرة من المثال المطروح أدناه

Option Compare Database
Option Explicit

Const SB_HORZ = 0
Const SB_VERT = 1

Private Declare Function GetScrollPos Lib "user32.dll" (ByVal hwnd As Long, _
														ByVal nBar As Long) As Long

Private Declare Function GetScrollRange Lib "user32.dll" (ByVal hwnd As Long, _
														  ByVal nBar As Long, _
														  ByRef lpMinPos As Long, _
														  ByRef lpMaxPos As Long) As Long


Private Declare Function apiGetFocus Lib "user32" _
				   Alias "GetFocus" () As Long


Public Function fScrollCol(lhWnd As Long, _
						   Optional lBar As Long = SB_HORZ) As Long

	Dim lRet As Long

	lRet = GetScrollPos(lhWnd, lBar)
	fScrollCol = lRet

End Function

Public Function fScrollPos(lhWnd As Long, _
						   Optional lBar As Long = SB_HORZ) As Integer

	Dim lRet As Long, lMin As Long, lMax As Long

	GetScrollRange lhWnd, lBar, lMin, lMax
	fScrollPos = Int((GetScrollPos(lhWnd, lBar) / lMax) * 100)

End Function


Public Function fhWnd(ctl As Control) As Long
On Error Resume Next

	ctl.SetFocus
	If Err Then
		fhWnd = 0
	Else
		fhWnd = apiGetFocus
	End If
	On Error GoTo 0

End Function

شكراً لكم علي سعة صدركم

ListBox_Resize.zip