Unicode dans un ListView

Messages postés
58
Date d'inscription
lundi 20 décembre 2004
Statut
Membre
Dernière intervention
3 janvier 2017
-
Bonjour,


Je voudrais écrire en unicode dans un contrôle ListView.

En utilisant Sendmessage et LVM_SETITEMTEXT je parviens à écrire , en ANSI, dans le ListView.
Mais je ne parviens pas à utiliser LVM_SETITEMTEXTW qui , peut-être, permet d'écrire en unicode...
Avec LVM_SETITEMTEXTW , Sendmessage me renvoie 0 à chaque fois.

Voici une partie de mon code:
Private Type LV_ITEM
    mask As Long
    iItem As Long
    iSubItem As Long
    State As Long
    stateMask As Long
    pszText As String
    cchTextMax As Long
    iImage As Long
    lParam As Long
    iIndent As Long
End Type

Public Const LVIF_INDENT As Long = &H10
Public Const LVIF_TEXT As Long = &H1
Public Const LVIF_PARAM = &H4
Public Const LVIF_STATE = &H8
Public Const LVIF_IMAGE = &H2

Public Const LVM_FIRST As Long = &H1000
Public Const LVM_SETITEMTEXT = (LVM_FIRST + 46)
Public Const LVM_SETITEMTEXTW = (LVM_FIRST + 116)

Public Sub SetText(ByVal lhwnd As Long, ByVal lIndex As Long, ByVal sNewText As String)
Dim lvi As LV_ITEM
Dim rep As Long

    With lvi
        lvi.iItem = lIndex
        lvi.mask = LVIF_TEXT
        lvi.pszText = sNewText
        lvi.cchTextMax = Len(sNewText)
    End With
    rep = SendMessage(lhwnd, LVM_SETITEMTEXTW, lIndex, lvi)

End Sub




Merci pour tout conseil.
Afficher la suite 

14 réponses

Messages postés
26503
Date d'inscription
mercredi 22 octobre 2003
Statut
Modérateur
Dernière intervention
15 octobre 2019
316
0
Merci
Merci de bien vouloir utiliser la coloration syntaxique (les balises de code) lorsque tu postes du code sur le forum.
Explications disponibles ici :
http://codes-sources.commentcamarche.net/faq/10686-le-nouveau-codes-sources-comment-ca-marche#balises-code

=> J'ai édité ton message pour le faire.
Commenter la réponse de jordane45
Messages postés
58
Date d'inscription
lundi 20 décembre 2004
Statut
Membre
Dernière intervention
3 janvier 2017
0
Merci
Merci Jordane45 pour tes explications et la correction de mon message.

--
Commenter la réponse de cs_youyou40
Messages postés
14008
Date d'inscription
samedi 29 décembre 2001
Statut
Modérateur
Dernière intervention
28 août 2015
61
0
Merci
Salut

De mémoire, une lettre Unicode se stocke sur deux octets.
Essaye d'utiliser LenB et pas Len pour définir cchTextMax.

Toujours de mémoire, pour ton texte, essaye d'ajouter un 0 derrière :
    .pszText = sNewText & Chr$(0)
mais comme les String de VB6 sont unicode, je ne sais pas si c'est bien nécessaire.

NB : Si tu utilises "With lvi", pas la peine de mettre lvi en tête des lignes qui suivent, sinon, ça n'a pas d'intérêt.
With lvi
.mask = ...
...
End With

Dernière chose : Il est impératif que le ListView Item auquel tu t'adresses existe déjà. Est-ce bien le cas ?
De mémore toujours (décidement), il me semble que l'index utilisé par les API débutent à 1 et pas à 0 comme en VB6 (ou l'inverse) - méfie-toi.
Vala
Jack [MVP VB]
NB : Je ne répondrai pas aux messages privés
Commenter la réponse de cs_Jack
Messages postés
58
Date d'inscription
lundi 20 décembre 2004
Statut
Membre
Dernière intervention
3 janvier 2017
0
Merci
Merci beaucoup cs_Jack pour ta réponse et tes remarques.

Entretemps, j'avais déjà ajouté le Chr$(0) (en réalité j'avais utilisé vbNullChar mais je crois que cela revient à peu près au même...) car en fait le string ne contient pas de caractère nul à la fin et aussi remplacé Len par LenB mais cela n'a pas résolu le problème.

Merci pour la remarque concernant le With (je n'avais pas fait attention) et concernant l'index, oui, pour une ListView cela commence à 0 mais je fais mes tests sur un ListView comportant plusieurs dizaines de lignes.

Ce code fonctionne correctement si je "supprime" le W de LVM_SETITEMW (mais bien sûr la string est alors interprétée comme du ANSI et ce n'est pas ce que je veux).

J'ai modifié aussi la façon d'appeler la string en utilisant un pointeur (j'ai lu que VB transforme tout en ANSI lorsqu'il appelle une API et que pour éviter ça il fallait utiliser un pointeur)
et j'ai utilisé la version W de Sendmessage mais cela ne marche toujours pas....

Voici le nouveau code

Private Declare Function SendMessageW Lib "user32" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

Private Type LV_ITEM
mask As Long
iItem As Long
iSubItem As Long
State As Long
stateMask As Long
pszText As Long
cchTextMax As Long
iImage As Long
lParam As Long
iIndent As Long
End Type

Public Const LVIF_INDENT As Long = &H10
Public Const LVIF_TEXT As Long = &H1
Public Const LVIF_PARAM = &H4
Public Const LVIF_STATE = &H8
Public Const LVIF_IMAGE = &H2

Public Const LVM_FIRST As Long = &H1000
Public Const LVM_SETITEM = (LVM_FIRST + 6)
Public Const LVM_SETITEMW = (LVM_FIRST + 76)
Public Const LVM_SETITEMTEXT = (LVM_FIRST + 46)
Public Const LVM_SETITEMTEXTW = (LVM_FIRST + 116)


Public Sub SetText(ByVal lhwnd As Long, ByVal lIndex As Long, ByVal sNewText As String)
Dim lvi As LV_ITEM
Dim rep As Long

With lvi
.iItem = lIndex
.mask = LVIF_TEXT
.pszText = StrPtr(sNewText & vbNullChar)
.cchTextMax = LenB(sNewText) + 2
End With
rep = SendMessageW(lhwnd, LVM_SETITEMW, lIndex, lvi)

End Sub
--
Commenter la réponse de cs_youyou40
Messages postés
14008
Date d'inscription
samedi 29 décembre 2001
Statut
Modérateur
Dernière intervention
28 août 2015
61
0
Merci
Oui, mieux vaut utiliser les pointeurs et ton usage est correct.
Tu peux oublier le '0' final dans ce cas là.

Pourquoi le + 2 ?
Pourquoi LVM_SETITEMW et pas LVM_SETITEMTEXTW ?

Je viens de parcourir quelques sources où il est question d'Unicode et de ListView :
- StrPtr : usage obligatoire
- Par contre, Len suffit
- J'ai vu aussi une utilisation très light qui semble fonctionner chez eux :
With lvi
.pszText = StrPtr(sNewText)
.cchTextMax = Len(sNewText)
End With
rep = SendMessageW(lhwnd, LVM_SETITEMTEXTW, lIndex, lvi)
Pas de .iITem ni de .mask
Peut-être essayer aussi le format
... LVM_SETITEMTEXTW, ByVal lIndex, lvi)

rappel définition
Private Declare Function SendMessageW _
Lib "user32" (ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
lParam As Any) As Long
A tester
Commenter la réponse de cs_Jack
Messages postés
58
Date d'inscription
lundi 20 décembre 2004
Statut
Membre
Dernière intervention
3 janvier 2017
0
Merci
Le +2 , parce que ... j'ai un peu tout essayé : sans rien ajouter , puis +1 puis +2 au cas où ...
J'avais commencé par LVM_SETITEMTEXTW mais cela ne marchait pas alors je suis passé à LVM_SETITEMW, pour lequel j'ai trouvé davantage de lecture sur le net....
Pour l'un comme pour l'autre , tout va bien sans le W (mais la string UTF16 est alors interprétée en ANSI avec les traditionnels point d'interrogation si les caractères n'existent pas dans la page de code du ListView) mais SendMessageW échoue des que je remets les W ....
J'ai essayé la version light mais cela ne marche pas (même sans le W: je crois que .mask doit obligatoirement avoir le flag LVIF_TEXT pour passer du texte)...

J'ai lu aussi que pour certains cela marchait....

Merci pour ton aide

--
Commenter la réponse de cs_youyou40
Messages postés
14008
Date d'inscription
samedi 29 décembre 2001
Statut
Modérateur
Dernière intervention
28 août 2015
61
0
Merci
Je te propose une alternative : Transformer la chaine ANSI en UTF-8 avant de l'utiliser dans l'API :
Cette procédure convertit une chaine en un tableau de bytes :
Soit tu reconvertis le tableau de bytes en String,
soit tu envoies le tableau de bytes à l'API.

Nécessite l'ajout de la référence à "Microsoft ActiveX Data Objects 2.8 Library" qui est le fichier "msado28.tlb" placé sous "Program files/Common files/System/ado".
Les fichiers tlb ne sont que des déclarations : pas la peine de l'inclure dans un package de compilation.

Private Function zConvertStringToUtf8Bytes(ByRef strText As String) As Byte()

Dim objStream As ADODB.Stream
Dim data() As Byte

' init du stream
Set objStream = New ADODB.Stream
objStream.Charset = "utf-8"
objStream.Mode = adModeReadWrite
objStream.Type = adTypeText
objStream.Open

' écrit les bytes originaux dans le stream
objStream.WriteText strText
objStream.Flush

' Repositionne en tête du stream
objStream.Position = 0
objStream.Type = adTypeBinary
' Saute les 3 premiers bytes identifiant l'UTF-8
'##### Voir s'il ne faudrait pas mieux les laisser
objStream.Read 3
data = objStream.Read()

' Ferme le stream et renvoie le résultat
objStream.Close
zConvertStringToUtf8Bytes = data

End Function
cs_Jack
Messages postés
14008
Date d'inscription
samedi 29 décembre 2001
Statut
Modérateur
Dernière intervention
28 août 2015
61 -
Conversion tableau de bytes en string :
TheString = StrConv(data(), vbUnicode)

mais le plus sûr, serait d'envoyer le tableau de byte, avec
cchTextMax = UBound(theTableau) + 1
pszText = theTableau(0)
Le "+1" pour l'index 0
Commenter la réponse de cs_Jack
Messages postés
58
Date d'inscription
lundi 20 décembre 2004
Statut
Membre
Dernière intervention
3 janvier 2017
0
Merci
Je viens de tester mais cela ne fonctionne toujours pas:
zConvertStringToUtf8Byte marche très bien, la string UTF16 est bien convertie en UTF-8 .
J'ai essayé avec ou sans BOM, mais SendMessageW renvoit toujours 0....

Merci encore.
Commenter la réponse de cs_youyou40
Messages postés
14008
Date d'inscription
samedi 29 décembre 2001
Statut
Modérateur
Dernière intervention
28 août 2015
61
0
Merci
Pour ma curiosité :
Quels caractères posent donc tant de problèmes ?
Langue autre que français ?
Sur quel OS/Windows ?
OS en quelle langue ?
Commenter la réponse de cs_Jack
Messages postés
58
Date d'inscription
lundi 20 décembre 2004
Statut
Membre
Dernière intervention
3 janvier 2017
0
Merci
C'est un utilitaire multi-langues qui permet d'éditer des fichiers eux aussi multi-langues : donc par exemple les entêtes de colonnes du ListView seront en russe , par exemple pour un utilisateur russe, et le contenu du ListView pourra être en chinois si le fichier à éditer est en chinois. C'est pour cela que je ne peux pas me contenter de jouer sur le charset du ListView avec des strings ANSI....
L'OS est Windows, la langue de l'OS dépend de l'utilisateur.
--
Commenter la réponse de cs_youyou40
Messages postés
14008
Date d'inscription
samedi 29 décembre 2001
Statut
Modérateur
Dernière intervention
28 août 2015
61
0
Merci
Bon, j'arrivai pas à dormir.
Voilà le fruit de mes recherches et adaptations :
-1- Utiliser une police de ListView = "Arial Unicode MS"
sinon, aucun rendu possible
-2- Le Font.Charset dépend de la région

Code :
Déclarations (en plus des tiennes)
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

Private Const STANDARD_RIGHTS_REQUIRED As Long = &HF0000
Private Const SYNCHRONIZE As Long = &H100000
Private Const PROCESS_ALL_ACCESS As Long = (STANDARD_RIGHTS_REQUIRED Or SYNCHRONIZE Or &HFFF)
Private Const MEM_COMMIT As Long = &H1000
Private Const PAGE_READWRITE As Long = &H4
Private Const MEM_RELEASE As Long = &H8000

Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hWnd As Long, lpdwProcessId As Long) As Long
Private Declare Function CloseHandle Lib "kernel32.dll" (ByVal Handle As Long) As Long
Private Declare Function OpenProcess Lib "kernel32.dll" (ByVal dwDesiredAccessas As Long, ByVal bInheritHandle As Long, ByVal dwProcId As Long) As Long
Private Declare Function VirtualAllocEx Lib "kernel32.dll" (ByVal hProcess As Long, ByVal lpAddress As Long, ByVal dwSize As Long, ByVal flAllocationType As Long, ByVal flProtect As Long) As Long
Private Declare Function VirtualFreeEx Lib "kernel32.dll" (ByVal hProcess As Long, ByVal lpAddress As Long, ByVal dwSize As Long, ByVal dwFreeType As Long) As Long
Private Declare Function WriteProcessMemory Lib "kernel32.dll" (ByVal hProcess As Long, ByVal lpBaseAddress As Long, ByRef lpBuffer As Any, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long

Routine d'écriture :
Private Function ListView_SetItemText(ByVal hWnd As Long, _
ByVal iItem As Long, _
ByVal iSubItem As Long, _
ByVal ItemText As String) As Boolean
Dim PID As Long
Dim hProcess As Long
Dim nSize As Long
Dim plvItem As Long
Dim p_MyItemText As Long
Dim myItem As LV_ITEM

nSize = LenB(StrConv(ItemText, vbFromUnicode))

GetWindowThreadProcessId hWnd, PID
hProcess = OpenProcess(PROCESS_ALL_ACCESS, False, PID)

If hProcess <> 0 Then
plvItem = VirtualAllocEx(hProcess, 0, Len(myItem), MEM_COMMIT, PAGE_READWRITE)
p_MyItemText = VirtualAllocEx(hProcess, 0, nSize, MEM_COMMIT, PAGE_READWRITE)

myItem.iSubItem = iSubItem
myItem.pszText = p_MyItemText

If plvItem And p_MyItemText Then
Call WriteProcessMemory(hProcess, p_MyItemText, ByVal ItemText, nSize, 0)
Call WriteProcessMemory(hProcess, plvItem, myItem, Len(myItem), 0)

Call SendMessage(hWnd, LVM_SETITEMTEXT, iItem, ByVal plvItem)

ListView_SetItemText = True

CloseHandle (hWnd)
CloseHandle (hProcess)
Call VirtualFreeEx(hProcess, plvItem, 0, MEM_RELEASE)
Call VirtualFreeEx(hProcess, p_MyItemText, 0, MEM_RELEASE)
End If
End If

End Function

Exemple de prépa d'une ListView de test :
    With ListView1
.Font.Name = "Arial Unicode MS"
.Font.Charset = 134 ' Chinois

.ListItems.Add , , "Coucou Coucou Coucou Coucou Coucou"
.ListItems.Add , , "Coucou Coucou Coucou Coucou Coucou"
.ListItems.Add , , "Coucou Coucou Coucou Coucou Coucou"
.ListItems.Add , , "Coucou Coucou Coucou Coucou Coucou"
.ListItems.Add , , "Coucou Coucou Coucou Coucou Coucou"
End With

Code du bouton pour modifier le texte d'un Item :
Private Sub Command1_Click()

' Voir les exemples de textes sur
' http://www.cyberactivex.com/UnicodeTutorialVb.htm

Dim sTemp As String
Dim aByte() As Byte
Dim theString As String
Dim LCID As Long
Dim r As Long

' LCID : Voir http://msdn.microsoft.com/en-us/goglobal/bb964664.aspx

' Chinois
sTemp = "CHS: " & ChrW$(&H6B22) & ChrW$(&H8FCE)
LCID = 2052
aByte = StrConv(sTemp, vbFromUnicode, LCID)
theString = StrConv(aByte, vbUnicode)
Call ListView_SetItemText(ListView1.hWnd, 2, 0, theString)

Exit Sub

'--- Pour les suivants, il faut modifier le Charset de la fonte
' mais ça modifie aussi les textes déjà existant !
' Koréen
sTemp = "KOR: " & ChrW$(&HC5EC) & ChrW$(&HBCF4) & ChrW$(&HC138) & ChrW$(&HC694)
LCID = 1042
aByte = StrConv(sTemp, vbFromUnicode, LCID)
theString = StrConv(aByte, vbUnicode)
Call ListView_SetItemText(ListView1.hWnd, 1, 0, theString)

' Hindi
sTemp = "HIN: " & ChrW$(&H930) & ChrW$(&H935) & ChrW$(&H93E) & ChrW$(&H917) & ChrW$(&H924)
LCID = 1081
aByte = StrConv(sTemp, vbFromUnicode, LCID)
theString = StrConv(aByte, vbUnicode)
Call ListView_SetItemText(ListView1.hWnd, 3, 0, theString)

' For r = 5 To UBound(aByte)
' Debug.Print r, aByte(r)
' Next r

End Sub

Bonne digestion !
Commenter la réponse de cs_Jack
Messages postés
58
Date d'inscription
lundi 20 décembre 2004
Statut
Membre
Dernière intervention
3 janvier 2017
0
Merci
Je ne dors pas non plus....

Merci pour ton travail .... mais cela revient à faire ce que je fais jusqu'à présent: l'écriture dans le listview se fait en ANSI, donc il faut adapter le charset à chaque fois et on ne peut pas avoir différentes langues (ou plutôt des langues utilisant des charsets différents) en même temps dans le listview ...

Pour les conversions, de utf16 à ANSI et vice-versa, j'utilise les api widechartomultibyte et multibytetowidechar et les codepage mais c'est beaucoup plus simple avec strconv et les LCID...

Merci encore pour ton aide et ta patience.
Commenter la réponse de cs_youyou40
Messages postés
14008
Date d'inscription
samedi 29 décembre 2001
Statut
Modérateur
Dernière intervention
28 août 2015
61
0
Merci
lol; je viens seulement de comprendre ton problème de fond!
Oui, en effet, l'écriture est en ANSI préalablement bidouillé.
Excuses; je n'avais pas saisi la nuance.

Si tu ne trouve pas de solution viable, l'idée, si tu veux t'afranchir des Charset dans la ListView :
- Utiliser une TextBox (ou autre) invisible pour préparer les chaines ANSI issues des chaines utf16
- Récupérer l'image graphique du texte de cette TextBox
- Insérer l'image graphique en lieu et place du texte dans la ListView
Dans ce cas, peu importera la fonte et le charset dans la ListView.
Par contre, cela t'interdira l'édition de ce texte par l'utilisateur (LabelEdit)

J'ai déjà utiliser des Combobox dans des ListView (par API bien sûr) : On doit pouvoir aussi gérer des Image ou PictureBox en lieu et place des textes.
cs_Jack
Messages postés
14008
Date d'inscription
samedi 29 décembre 2001
Statut
Modérateur
Dernière intervention
28 août 2015
61 -
VB.Net est beaucoup plus pointu et efficace concernant les fontes, charset and co
Commenter la réponse de cs_Jack
Messages postés
58
Date d'inscription
lundi 20 décembre 2004
Statut
Membre
Dernière intervention
3 janvier 2017
0
Merci
Bonjour et encore merci pour ton aide cs_Jack .

J'ai testé ton idée et cela fonctionne mais le listview n'est pas totalement opérationnel (édition en particulier comme tu le disais).

Je crois avoir compris pourquoi ma solution avec LVM_SETITEMW ou LVM-SETITEMTEXTW ne marche pas: le listView standard de VB 6 (celui de la boite à outils de l'IDE, qui provient de Microsoft Windows Common Controls 6.0 (MSCOMCTL.OCX) ) ne doit pas supporter ces 2 messages.

Par contre, en créant le listview avec CreateWindowExW et en utilsant les versions W des messages et des pointeurs pour passer les strings, cela fonctionne.

Créer la listview
sclass = "SysListView32"
hListView = CreateWindowExW(WS_EX_OVERLAPPEDWINDOW, StrPtr(sclass), "", WS_CHILD Or _
    WS_VISIBLE Or LVS_REPORT, 10, 10, 500, 200, Form1.hWnd, 0, App.hInstance, ByVal CLng(0))

Ajouter des colonnes (par exemple une colonne de largeur 100 pixels avec le contenu de myString en entête, myString étant une chaine Unicode quelconque par exemple ChrW(&H65B0) & " - " & ChrW(&H429) qui contient du chinois et du russe)
With objColumn
.mask = LVCF_TEXT Or LVCF_WIDTH
.cchTextMax = Len(myString)
.pszText = StrPtr(myString)
.cx = 100
End With
rep = SendMessageW(hListView, LVM_INSERTCOLUMNW, 0, objColumn)
Ajouter des items
with lvi
.iItem = 0
.mask = LVIF_IMAGE Or LVIF_TEXT
.cchTextMax = Len(myString1)
.pszText = StrPtr(myString1)
end With
rep = SendMessageW(hListView, LVM_INSERTITEMW, 0, lvi)
redimensionner les colonnes
rep = SendMessageW(hListView, LVM_SETCOLUMNWIDTH, 0, ByVal CLng(200))

et surtout écrire les items et subitems
Public Sub SetText(ByVal lhwnd As Long, ByVal lIndex As Long, ByVal sNewText As String)
Dim lvi As LV_ITEM
Dim rep As Long
With lvi
.iItem = lIndex
.mask = LVIF_TEXT
.pszText = StrPtr(sNewText)
.cchTextMax = Len(sNewText)
End With
rep = SendMessageW(lhwnd, LVM_SETITEMTEXTW, lIndex, lvi)

End Sub


Quant à VB.NET, mon application VB6 est assez importante et je n'ai pas envie de tout réécrire en .NET ...
Commenter la réponse de cs_youyou40