TAMANHO COLUNA LISTVIEW

 Tópico anterior Próximo tópico Novo tópico

TAMANHO COLUNA LISTVIEW

VB / VBA

 Compartilhe  Compartilhe  Compartilhe
#477182 - 16/10/2017 19:07:17

MILTONSILVA94
CANOAS / RIO GRANDE DO SUL
Cadast. em:Janeiro/2015


 Anexos estao visíveis somente para usuários registrados

Oi JABA, efetuei teste no exemplo, e somente na coluna C ele não deixa mexer. As demais ele aceita...
Para que nenhuma coluna seja permitido, aonde preciso alterar no código?



#477184 - 16/10/2017 19:40:15

JABA
CABO FRIO
Cadast. em:Agosto/2005


Última edição em 16/10/2017 19:47:43 por JABA

Aqui.

Case HDN_BEGINTRACK
                     List1.AddItem _
                           "HDN_BEGINTRACK" & _
                           vbTab & _
                           "(attempting to) resize " & HTI.iItem
                    
                     If HTI.iItem = 2 Then WindowProc = 1: Exit Function



Essa é a única parte que lhe interessa, o restante dos CASE você pode deletar. O que determina a coluna é o valor que você coloca para o HTI.iItem. Como ele está com o valor 2, a segunda coluna é que será monitorada. Se você quiser monitorar todas, é só fazer um loop pegando os indices do cabeçalho. O código completo ficaria assim:

Friend Function WindowProc(hwnd As Long, _
                           msg As Long, _
                           wp As Long, _
                           lp As Long) As Long
  
   Static nm As NMHDR
   Static pt As POINTAPI
   Static HTI As HD_HITTESTINFO
    
   Dim hHeader As Long
   Dim thisIndex As Long
  
   If hwnd = ListView1.hwnd Then
  
      Select Case msg
         Case WM_NOTIFY
        
           'Pass along to default window procedure.
            WindowProc = CallWindowProc(GetProp(hwnd, _
                                               "OldWindowProc"), _
                                               hwnd, msg, _
                                               wp, lp)
            
           'Get the notification message
            Call CopyMemory(nm, ByVal lp, Len(nm))
            
           'get the hwnd of the header
            hHeader = SendMessage(ListView1.hwnd, _
                                         LVM_GETHEADER, _
                                         0&, _
                                         ByVal 0&)
            
            If hHeader Then

              'get the current cursor position in the header
               Call GetCursorPos(pt)
               Call ScreenToClient(hHeader, pt)
              
              'get the header's hit-test info
               With HTI
                  .flags = HHT_ONHEADER Or HHT_ONDIVIDER
                  .pt = pt
               End With
  
               Call SendMessage(hHeader, HDM_HITTEST, 0&, HTI)
                    
              'react to the HDN_* code
               Select Case nm.code
            
                  Case HDN_BEGINTRACK

                    Dim i As Integer

                    For i = 0 To ListView1.ColumnHeaders.Count - 1
                        If HTI.iItem = i Then WindowProc = 1: Exit Function
                    Next

               End Select
              
            End If 'If hHeader Then
        
      End Select  'Select Case msg
  
   End If  'If hwnd = ListView1.hwnd

   WindowProc = CallWindowProc(GetProp(hwnd, _
                               "OldWindowProc"), _
                               hwnd, msg, wp, lp)
            
  'keep the last list entry in view
   List1.ListIndex = List1.ListCount - 1

End Function


_______________________________________________________________________________________________

Se a alma ou espírito são imateriais, como eles fazem para se localizarem quando o corpo está em movimento?



#477499 - 28/10/2017 21:56:01

MILTONSILVA94
CANOAS / RIO GRANDE DO SUL
Cadast. em:Janeiro/2015


Última edição em 28/10/2017 22:08:59 por MILTONSILVA94

 Anexos estao visíveis somente para usuários registrados

Oi JABA,

Obrigado!
Modifiquei no if para pegar as colunas apartir da '0', para que abranja todas as colunas do listview.
      If HTI.iItem >= 0 Then WindowProc = 1: Exit Function

Dentro do módulo 1 têm a função 'HookFunc', no qual preciso informar o nome do form que funcionará a rotina. Mas preciso adicionar para todos os formulários (exemplo para mais de um form) como poderia declarar os outros forms?

Public Function HookFunc(ByVal hwnd As Long, _
                         ByVal msg As Long, _
                         ByVal wp As Long, _
                         ByVal lp As Long) As Long
    Dim foo As Long
    Dim obj As frmAgendamentosConsultas
....




#477500 - 29/10/2017 03:51:37

JABA
CABO FRIO
Cadast. em:Agosto/2005


Essas funções funcionam através do hwnd dos controles. Você pode ver que dentro da função "WindowProc" tem uma verificação disso para o listView quando ele faz "If hwnd = ListView1.hwnd Then".  Sendo assim, ao encontrar o form desejado, você tem que passar o hwnd do controle desejado para a função. Para percorrer todos os controles de cada form aberto e mostrar o hwnd, você pode fazer assim:

Dim frm As Form

For Each frm In Forms
    For Each Controle In frm.Controls
        MsgBox Controle.hWnd
    Next
Next


_______________________________________________________________________________________________

Se a alma ou espírito são imateriais, como eles fazem para se localizarem quando o corpo está em movimento?



#477565 - 02/11/2017 13:03:01

MILTONSILVA94
CANOAS / RIO GRANDE DO SUL
Cadast. em:Janeiro/2015


Olá JABA,

Adiciono dentro do if - 'If hwnd = lvwLista.hwnd Then' ? Porém não deu resultado.

Friend Function WindowProc(hwnd As Long, _
                           msg As Long, _
                           wp As Long, _
                           lp As Long) As Long  'Início da função para bloquear movimento de colunas no listview

    Static nm As NMHDR
    Static pt As POINTAPI
    Static HTI As HD_HITTESTINFO

    Dim hHeader As Long
    Dim thisIndex As Long

Dim frm As Form  'Sugestão JABA
Dim Controle As Form

    If hwnd = lvwLista.hwnd Then
        Select Case msg
            Case WM_NOTIFY
                WindowProc = CallWindowProc(GetProp(hwnd, _
                                            "OldWindowProc"), _
                                            hwnd, msg, _
                                            wp, lp)  'Passe para o procedimento de janela padrão

                Call CopyMemory(nm, ByVal lp, Len(nm))  'Obter a mensagem de notificação

                hHeader = SendMessage(lvwLista.hwnd, _
                                      LVM_GETHEADER, _
                                      0&, _
                                      ByVal 0&)  'Pegar o hwnd do cabeçalho

                If hHeader Then
                    Call GetCursorPos(pt)  'Obter a posição atual do cursor no cabeçalho
                    Call ScreenToClient(hHeader, pt)
    
                    With HTI  'Obter a informação de teste de sucesso do cabeçalho
                       .flags = HHT_ONHEADER Or HHT_ONDIVIDER
                       .pt = pt
                    End With
                        Call SendMessage(hHeader, HDM_HITTEST, 0&, HTI)
                    Select Case nm.code  'Reagir ao código HDN_ *
                        Case HDN_BEGINTRACK  'Rotina adicionada
                            Dim i As Integer
                                For i = 0 To lvwLista.ColumnHeaders.Count - 1  'Fim da rotina adicionada
                                    If HTI.iItem >= 0 Then WindowProc = 1: Exit Function
                                Next
                    End Select
                End If
        End Select
        
For Each frm In Forms
    For Each Controle In frm.Controls
        MsgBox Controle.hwnd
    Next
Next


    End If
        WindowProc = CallWindowProc(GetProp(hwnd, _
                                    "OldWindowProc"), _
                                    hwnd, msg, wp, lp)
End Function  'Fim da função



#477599 - 04/11/2017 23:27:35

JABA
CABO FRIO
Cadast. em:Agosto/2005


Última edição em 04/11/2017 23:31:03 por JABA

Por esse código, você pode monitorar qualquer ListView. Para teste, substitua o código que está dentro do botão monitorar por ele.

   Dim frm As Form
   Dim controle As Object
    
    For Each frm In Forms
        For Each controle In frm.Controls
            If TypeOf controle Is ListView Then
                Call HookWindow(controle.hwnd, Me)
            End If
        Next
    Next


=======================================================================

Dei uma pequena modificada nesta função:

Friend Function WindowProc(hwnd As Long, msg As Long, wp As Long, lp As Long) As Long
  
   Static nm As NMHDR
   Static pt As POINTAPI
   Static HTI As HD_HITTESTINFO
    
   Dim hHeader As Long
   Dim thisIndex As Long
    
      Select Case msg
         Case WM_NOTIFY
        
           'Pass along to default window procedure.
            WindowProc = CallWindowProc(GetProp(hwnd, "OldWindowProc"), hwnd, msg, wp, lp)
            
           'Get the notification message
            Call CopyMemory(nm, ByVal lp, Len(nm))
            
           'get the hwnd of the header
            hHeader = SendMessage(hwnd, LVM_GETHEADER, 0&, ByVal 0&)
            
            If hHeader Then

              'get the current cursor position in the header
               Call GetCursorPos(pt)
               Call ScreenToClient(hHeader, pt)
              
              'get the header's hit-test info
               With HTI
                  .flags = HHT_ONHEADER Or HHT_ONDIVIDER
                  .pt = pt
               End With
  
               Call SendMessage(hHeader, HDM_HITTEST, 0&, HTI)
                    
              'react to the HDN_* code
               Select Case nm.code
                                
                  Case HDN_BEGINTRACK
                    
                     If HTI.iItem >= 0 Then WindowProc = 1: Exit Function
                  
               End Select
              
            End If
        
      End Select

   WindowProc = CallWindowProc(GetProp(hwnd, "OldWindowProc"), hwnd, msg, wp, lp)

End Function



_______________________________________________________________________________________________

Se a alma ou espírito são imateriais, como eles fazem para se localizarem quando o corpo está em movimento?



#477729 - 08/11/2017 20:57:37

MILTONSILVA94
CANOAS / RIO GRANDE DO SUL
Cadast. em:Janeiro/2015


 Anexos estao visíveis somente para usuários registrados

Obrigado JABA.

Coloquei em anexo o projeto. Simulei a rotina para 2 forms com o código e quando chamo o form 2 a rotina não funciona, somente funciona para o primeiro form.

Aguardo retorno,



#477739 - 09/11/2017 00:46:46

JABA
CABO FRIO
Cadast. em:Agosto/2005


 Anexos estao visíveis somente para usuários registrados

Coloque a função WindowProc como public.

_______________________________________________________________________________________________

Se a alma ou espírito são imateriais, como eles fazem para se localizarem quando o corpo está em movimento?



#477752 - 09/11/2017 21:27:18

MILTONSILVA94
CANOAS / RIO GRANDE DO SUL
Cadast. em:Janeiro/2015


 Anexos estao visíveis somente para usuários registrados

Oi JABA, 100% funcional a rotina, efetuei vários testes!

Uma dúvida, quando clico no meio da coluna acaba diminuindo seu tamanho conforme pode ser visto na imagem. É possível evitar isso?

Aguardo retorno.



#477753 - 09/11/2017 21:58:53

JABA
CABO FRIO
Cadast. em:Agosto/2005


Citação:
Uma dúvida, quando clico no meio da coluna acaba diminuindo seu tamanho conforme pode ser visto na imagem. É possível evitar isso?


Testei aqui e não aconteceu isso. Deve ser algum tipo de configuração que você colocou no list.

_______________________________________________________________________________________________

Se a alma ou espírito são imateriais, como eles fazem para se localizarem quando o corpo está em movimento?



 Tópico anterior Próximo tópico Novo tópico


Tópico encerrado, respostas não sao permitidas
Encerrado por MILTONSILVA94 em 13/11/2017 20:13:44