TAMANHO COLUNA LISTVIEW

MILTONSILVA94 16/10/2017 19:07:17
#477182
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?
JABA 16/10/2017 19:40:15
#477184
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
MILTONSILVA94 28/10/2017 21:56:01
#477499
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
....
JABA 29/10/2017 03:51:37
#477500
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
MILTONSILVA94 02/11/2017 13:03:01
#477565
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
JABA 04/11/2017 23:27:35
#477599
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
MILTONSILVA94 08/11/2017 20:57:37
#477729
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,
JABA 09/11/2017 00:46:46
#477739
Coloque a função [txt-color=#0000f0]WindowProc [/txt-color]como [txt-color=#0000f0]public[/txt-color].
MILTONSILVA94 09/11/2017 21:27:18
#477752
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.
JABA 09/11/2017 21:58:53
#477753
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.
Página 2 de 3 [24 registro(s)]
Tópico encerrado , respostas não são mais permitidas
Voltar