منتدى مصر التقني
هل تريد التفاعل مع هذه المساهمة؟ كل ما عليك هو إنشاء حساب جديد ببضع خطوات أو تسجيل الدخول للمتابعة.

منع أعمدة ListView من تغيير حجم من قبل المستخدم

اذهب الى الأسفل

منع أعمدة ListView من تغيير حجم من قبل المستخدم  Empty منع أعمدة ListView من تغيير حجم من قبل المستخدم

مُساهمة من طرف السنى الأحد يوليو 28, 2013 3:02 pm

بسم الله الرحمن الرحيم

قد ترغب فى بعض الاحيان أن تمنع المستخدم لمشروعك من تعديل حجم أعمد 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
الجنس : ذكر

الرجوع الى أعلى الصفحة اذهب الى الأسفل

الرجوع الى أعلى الصفحة

ََ

مواضيع ذات صلة


 
صلاحيات هذا المنتدى:
لاتستطيع الرد على المواضيع في هذا المنتدى