منع أعمدة ListView من تغيير حجم من قبل المستخدم
صفحة 1 من اصل 1 • شاطر
منع أعمدة ListView من تغيير حجم من قبل المستخدم
بسم الله الرحمن الرحيم
قد ترغب فى بعض الاحيان أن تمنع المستخدم لمشروعك من تعديل حجم أعمد ListView عن طريق الوقوف على تلك الاعمدة بالماس و سحبها فى اى اتجاه ......لذلك أذا اردت ان تمنع ذلك أتبع مايلى :
1_ قم بإنشاء موديل ثم ادراج الكود التالى بداخلة :
2 _ فى حدث التحميل للنافذة أكتب الكود التالى :
قد ترغب فى بعض الاحيان أن تمنع المستخدم لمشروعك من تعديل حجم أعمد ListView عن طريق الوقوف على تلك الاعمدة بالماس و سحبها فى اى اتجاه ......لذلك أذا اردت ان تمنع ذلك أتبع مايلى :
1_ قم بإنشاء موديل ثم ادراج الكود التالى بداخلة :
- الكود:
Option Explicit
' GetWindowsLong Constants
Private Const GWL_WNDPROC = (-4)
' Windows Message Constants
Private Const WM_NOTIFY = &H4E
Private Const WM_DESTROY = &H2
' Column Header Notification Meassage Constants
Private Const HDN_FIRST = -300&
Private Const HDN_BEGINTRACK = (HDN_FIRST - 6)
' Column Header Item Info Message Constants
Private Const HDI_WIDTH = &H1
' Notify Message Header Type
Private Type NMHDR
hWndFrom As Long
idFrom As Long
code As Long
End Type
' Notify Message Header for Listview
Private Type NMHEADER
hdr As NMHDR
iItem As Long
iButton As Long
lPtrHDItem As Long ' HDITEM FAR* pItem
End Type
' Header Item Type
Private Type HDITEM
mask As Long
cxy As Long
pszText As Long
hbm As Long
cchTextMax As Long
fmt As Long
lParam As Long
iImage As Long
iOrder As Long
End Type
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function CallWindowProc Lib "user32" 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 Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private mlPrevWndProc As Long
Private Function WindowProc(ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim tNMH As NMHDR
Dim tNMHEADER As NMHEADER
Dim tITEM As HDITEM
Select Case Msg
Case WM_NOTIFY
' Copy the Notify Message Header to a Header Structure
CopyMemory tNMH, ByVal lParam, Len(tNMH)
Select Case tNMH.code
Case HDN_BEGINTRACK
' If the user is trying to Size a Column Header...
' Extract Information about the Header being Sized
CopyMemory tNMHEADER, ByVal lParam, Len(tNMHEADER)
' Get Item Info. about the header (i.e. Width)
CopyMemory tITEM, ByVal tNMHEADER.lPtrHDItem, Len(tITEM)
' Don't allow Zero Width Columns to be Sized.
If (tITEM.mask And HDI_WIDTH) = HDI_WIDTH And tITEM.cxy = 0 Then
WindowProc = 1
Exit Function
End If
End Select
Case WM_DESTROY
' Remove Subclassing when Listview is Destroyed (Form unloaded.)
WindowProc = CallWindowProc(mlPrevWndProc, hWnd, Msg, wParam, lParam)
Call SetWindowLong(hWnd, GWL_WNDPROC, mlPrevWndProc)
Exit Function
End Select
' Call Default Window Handler
WindowProc = CallWindowProc(mlPrevWndProc, hWnd, Msg, wParam, lParam)
End Function
Public Sub SubClassHwnd(ByVal hWnd As Long)
mlPrevWndProc = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf WindowProc)
End Sub
2 _ فى حدث التحميل للنافذة أكتب الكود التالى :
- الكود:
Option Explicit
Private Sub Form_Load()
Dim lIndex As Long
SubClassHwnd ListView1.hWnd
With ListView1
.View = lvwReport
For lIndex = 1 To 5
.ColumnHeaders.Add , "COL" & lIndex, "Column " & lIndex, IIf(lIndex = 3, 0, (.Width - 200) / 4)
Next
End With
End Sub
السنى- ........
- تاريخ التسجيل : 18/02/2011
المساهمات : 249
النقاط : 464
التقيم : 25
الجنس :
| |
صفحة 1 من اصل 1
صلاحيات هذا المنتدى:
لاتستطيع الرد على المواضيع في هذا المنتدى
الثلاثاء مارس 26, 2024 6:26 pm من طرف moslema_r
» شركة تنظيف استراحات بالرياض
الأحد مارس 24, 2024 10:49 pm من طرف moslema_r
» كشف تسربات المياه في جدة
السبت مارس 23, 2024 7:23 pm من طرف gmalnagy
» خدمات كشف تسربات المياه بخصم 25% - اتصل الان
السبت مارس 23, 2024 7:22 pm من طرف gmalnagy
» شركة تنظيف ثريات بالرياض
الخميس مارس 21, 2024 7:23 pm من طرف moslema_r
» كهربائي منازل بالرياض
الأحد مارس 17, 2024 1:52 pm من طرف رانيا حماد
» افضل شركة نقل عفش بالرياض نقل باكستاني 40% خصم | موقع الانوار
الأحد مارس 17, 2024 1:25 pm من طرف رانيا حماد
» افضل معلم جبس بالرياض تركيب جبس بورد بالرياض 20% خصم اتصل الآن
الأحد مارس 17, 2024 1:09 pm من طرف رانيا حماد
» شراء اثاث مستعمل بالكويت بخصم 30%
الأحد مارس 17, 2024 12:54 pm من طرف رانيا حماد
» افضل فني كهربائي منازل بالرياض جودة 100% | اتصل الآن
الأحد مارس 17, 2024 12:36 pm من طرف رانيا حماد