Foro | | | | | | - Página 1 - |
| 
Nico
Madysa | Hallöchen miteinander!
Das Unicode-Listview incluso a remendar klappt mittlerweile bastante bien, sólo posición wir ahora antes Schwierigkeit, lo vernünftig a sortieren.
KompilierenMarcaSeparación $H Messages.ph
var id% = 1
Struct CREATESTRUCT = lpCreateParams&, hInstance&, hMenu&, hwndParent&, cy%, cx%, y%, x%, style&, lpszName&, lpszClass&, dwExStyle&
Struct LVCOLUMN = Mask&, FMT&, CX&, Text&, cchTextMaxLen&, Subitem&
Struct LVITEM = IMASK&, ITEM&, ISUBITEM&, State&, StateMask&, ITEXT&, ITEXTMAX&, IIMAGE&, ILPARAM&
proc UTF
parameters text$
declare b#
Dim b#,2*len(text$)+2
StringW b#,0 = text$
text$ = Char$(b#,0,SizeOf(b#)-2)
return text$
endproc
proc CreateW
if %pCount > 10
parameters Class$,Name$,style&,x%,y%,dx%,dy%,pWnd&,pid%,hInst&,exstyle&
else
parameters Class$,Name$,style&,x%,y%,dx%,dy%,pWnd&,pid%,hInst&
var exstyle& = 0
endif
Class$ = UTF(Class$)
Name$ = UTF(Name$)
var cs# = New(CREATESTRUCT)
With cs#
.lpCreateParams& = SizeOf(cs#)
.hInstance& = hInst&
.hMenu& = if(u_IsMenu(id%),id%,0)
.hwndParent& = pWnd&
.cy% = dy%
.cx% = dx%
.y% = y%
.x% = x%
.style& = style&
.lpszName& = Addr(Name$)
.lpszClass& = Addr(Class$)
.dwExStyle& = exstyle&
EndWith
var handle& = u_CreateWindowExW(exstyle&,Addr(Class$),Addr(Name$),style&,x%,y%,dx%,dy%,pWnd&,id%,hInst&,cs#)
inc id%
ifnot handle&
Class$ = WinError$(%WinError)
MessageBox("Es trat folgender Fehler auf:
" + Class$,"F E H L E R !!!",4096)
endif
Dispose cs#
return handle&
endproc
$10 = von A-Z
$20 = von Z-A
$04 = keine Mehrfachauswahl
subproc Create.GridBoxW
parameters pWnd&,def$,stl%,x%,y%,dx%,dy%
declare s$
var hList& = CreateW("SysListView32","",$50000209 + stl%,x%,y%,dx%,dy%,pWnd&,0,%hInstance,$200)
u_SendMessageW(hList&,$1036,0,$00000023)
var LVC# = New(LVCOLUMN)
With LVC#
.Subitem& = 0
.MASK& = $7
whileloop 0,(len(def$,";") 3) - 1
s$ = SubStr$(def$,3*&loop + 1,";")
.TEXT& = Addr(s$)
.FMT& = val(SubStr$(def$,3*&loop + 2,";"))
.CX& = val(SubStr$(def$,3*&loop + 3,";"))
.cchTextMaxLen& = len(s$)
u_SendMessageW(hList&,$1061,&loop,LVC#)
EndWhile
EndWith
Dispose LVC#
return hList&
endproc
proc InsertStringW
parameters pList&,s$,index%
declare ss$
var LVI# = New(LVITEM)
var d$ = UTF(Get("ListDel"))
With LVI#
.IMASK&=$1
.ITEM& = index%
whileloop len(s$,d$)
ss$ = SubStr$(s$,&loop,d$)
.iText& = Addr(ss$)
.ITEXTMAX& = len(ss$)
.ISUBITEM& = &loop - 1
ifnot &loop - 1
u_SendMessageW(pList&,$104D,index%,LVI#)
else
u_SendMessageW(pList&,$104C,index%,LVI#)
endif
EndWhile
EndWith
endproc
proc LoadText
parameters d$
Die CSV-Datei wird eingelesen
declare b#,t$,tt$
Dim b#,FileSize(d$)
BlockRead(d$,b#,0,SizeOf(b#))
d$ = Char$(b#,2,SizeOf(b#)-2)
Dispose b#
Die Zeilen werden im Sortier-Listview alphabetisch geordnet
whileloop 0,len(d$,"x0Dzx0Az")-1
InsertStringW(hSort&,SubStr$(d$,&loop+1,"x0Dzx0Az"),&loop)
EndWhile
Die Substrings jeder Zeile sind mit einem Semikolon getrennt
Set("ListDel",";")
Das Sortier-Listview wird ins Anzeigelistview übertragen
Aus einer Spalte werden zwei
var LVI# = New(LVITEM)
LVI#.IMASK&=$1
LVI#.ITEXTMAX& = 128
LVI#.ISUBITEM& = 0
whileloop 0,len(d$,"x0Dzx0Az")-1
LVI#.ITEM& = &loop
print u_SendMessageW(hSort&,$1073,&loop,LVI#) Text auslesen
b# = LVI#.iText&
Dim b#,10
d$ = Char$(b#,0,SizeOf(b#)) In Stringvariable schreiben
InsertStringW(hList&,d$,&loop) übertragen
EndWhile
Dispose LVI#,b#
endproc
declare hUser&,hGDI&,hKrnl&
declare hSort&,hList&
cls
var font& = Create("Font","Times New Roman",16,0,0,0,0)
hUser& = ImportDLL("USER32","u_")
hSort& = Create("GridBoxW",%hWnd,UTF("Sortieren")+";0;100",$10,100,5,110,200)
hList& = Create("GridBoxW",%hWnd,UTF("Deutsch")+";0;100;"+UTF("Polnisch")+";2;200",$00,210,5,410,200)
SetFont hList&,font&
Format
"Wort1;Wort2
Wort3;Wort4;..."
LoadText LoadFile("Quell-Datei laden","Test.txt")
whilenot IsKey(27)
waitinput
wend
FreeDLL hUser&
FreeDLL hGDI&
FreeDLL hKrnl&
DeleteObject font&
end
Das Problema: In el ersten Spalte voluntad el Einträge alphabetisch sortiert, en el zweiten hingegen no. Das ha a Folge, el manche Zellen leer bleiben, otro dagegen überschrieben voluntad.
Mein Ansatz: Jede Línea se primero en una (eigentlich unsichtbares) einspaltiges Listview geschrieben. Dadurch hay no Problemas con el Sortieren. Danach voluntad el Zeilen des Listviews en una zweites, sichtbares, unsortiertes Listview geschrieben.
Hierbei bin Yo sin embargo irgendwie unfähig, el Zeilen des Listviews auszulesen. Yo erhalte de el Message LVM_GETITEMTEXTW irgendwie sólo Leerstrings.
Erkennt irgendjemand algo, el Yo no erkenne?
Saludo,
Nico
PS: Anhangs befindet se una CSV/TXT-Expediente para Testzwecke. |
 | | | | | | |
| | | | | | | - Página 1 - |
| 
Dieter
Zornow | Habs todavía geschafft así gehts, lag a el Dimensionierung en el Bucle
KompilierenMarcaSeparación
proc LoadText
parameters d$
Die CSV-Datei wird eingelesen
declare b#,t$,tt$
Dim b#,FileSize(d$)
BlockRead(d$,b#,0,SizeOf(b#))
d$ = Char$(b#,2,SizeOf(b#)-2)
Dispose b#
Die Zeilen werden im Sortier-Listview alphabetisch geordnet
whileloop 0,len(d$,"x0Dzx0Az")-1
InsertStringW(hSort&,SubStr$(d$,&loop+1,"x0Dzx0Az"),&loop)
EndWhile
Dispose LVI#,b#
return
Die Substrings jeder Zeile sind mit einem Semikolon getrennt
var del$ = UTF(";")
Set("ListDel",";")
Das Sortier-Listview wird ins Anzeigelistview übertragen
Aus einer Spalte werden zwei
var LVI# = New(LVITEM)
LVI#.IMASK&= $1
LVI#.ITEXT&= Lvi#+36
LVI#.ITEXTMAX& = 200
LVI#.ISUBITEM& = 0
Dim b#,200
whileloop 0,getcount(hsort&) -1 len(d$,"x0Dzx0Az")-1
LVI#.ITEM& = &loop
u_SendMessageW(hSort&,$1073,&loop,LVI#) Text auslesen
b# = LVI#.iText&
d$ = Char$(b#,0,SizeOf(b#))In Stringvariable schreiben
InsertStringW(hList&,d$,&loop)übertragen
EndWhile
Dispose LVI#,b#
ENDPROC
|
| | | | Er ist ein Mann wie ein Baum. Sie nennen ihn Bonsai., Win 7 32 bit und Win 7 64 bit, mit XProfan X2 | 04.07.2009 ▲ |
| | |
| | 
Thomas
Freier | Exactamente Dieter, du warst más rápido.
Tuve simplemente una "Dispose b#" en el Bucle gesetzt. Aber así es mejor.
KompilierenMarcaSeparación $H Messages.ph
var id% = 1
Struct CREATESTRUCT = lpCreateParams&, hInstance&, hMenu&, hwndParent&, cy%, cx%, y%, x%, style&, lpszName&, lpszClass&, dwExStyle&
Struct LVCOLUMN = Mask&, FMT&, CX&, Text&, cchTextMaxLen&, Subitem&
Struct LVITEM = IMASK&, ITEM&, ISUBITEM&, State&, StateMask&, ITEXT&, ITEXTMAX&, IIMAGE&, ILPARAM&
proc UTF
parameters text$
declare b#
Dim b#,2*len(text$)+2
StringW b#,0 = text$
text$ = Char$(b#,0,SizeOf(b#)-2)
return text$
endproc
proc CreateW
if %pCount > 10
parameters Class$,Name$,style&,x%,y%,dx%,dy%,pWnd&,pid%,hInst&,exstyle&
else
parameters Class$,Name$,style&,x%,y%,dx%,dy%,pWnd&,pid%,hInst&
var exstyle& = 0
endif
Class$ = UTF(Class$)
Name$ = UTF(Name$)
var cs# = New(CREATESTRUCT)
With cs#
.lpCreateParams& = SizeOf(cs#)
.hInstance& = hInst&
.hMenu& = if(u_IsMenu(id%),id%,0)
.hwndParent& = pWnd&
.cy% = dy%
.cx% = dx%
.y% = y%
.x% = x%
.style& = style&
.lpszName& = Addr(Name$)
.lpszClass& = Addr(Class$)
.dwExStyle& = exstyle&
EndWith
var handle& = u_CreateWindowExW(exstyle&,Addr(Class$),Addr(Name$),style&,x%,y%,dx%,dy%,pWnd&,id%,hInst&,cs#)
inc id%
ifnot handle&
Class$ = WinError$(%WinError)
MessageBox("Es trat folgender Fehler auf:
" + Class$,"F E H L E R !!!",4096)
endif
Dispose cs#
return handle&
endproc
$10 = von A-Z
$20 = von Z-A
$04 = keine Mehrfachauswahl
subproc Create.GridBoxW
parameters pWnd&,def$,stl%,x%,y%,dx%,dy%
declare s$
var hList& = CreateW("SysListView32","",$50000209 + stl%,x%,y%,dx%,dy%,pWnd&,0,%hInstance,$200)
u_SendMessageW(hList&,$1036,0,$00000023)
var LVC# = New(LVCOLUMN)
With LVC#
.Subitem& = 0
.MASK& = $7
whileloop 0,(len(def$,";") 3) - 1
s$ = SubStr$(def$,3*&loop + 1,";")
.TEXT& = Addr(s$)
.FMT& = val(SubStr$(def$,3*&loop + 2,";"))
.CX& = val(SubStr$(def$,3*&loop + 3,";"))
.cchTextMaxLen& = len(s$)
u_SendMessageW(hList&,$1061,&loop,LVC#)
EndWhile
EndWith
Dispose LVC#
return hList&
endproc
proc InsertStringW
parameters pList&,s$,index%
declare ss$
var LVI# = New(LVITEM)
var d$ = UTF(Get("ListDel"))
With LVI#
.IMASK&=$1
.ITEM& = index%
whileloop len(s$,d$)
ss$ = SubStr$(s$,&loop,d$)
.iText& = Addr(ss$)
.ITEXTMAX& = len(ss$)
.ISUBITEM& = &loop - 1
ifnot &loop - 1
u_SendMessageW(pList&,$104D,index%,LVI#)
else
u_SendMessageW(pList&,$104C,index%,LVI#)
endif
EndWhile
EndWith
endproc
proc LoadText
parameters d$
Die CSV-Datei wird eingelesen
declare b#,t$,tt$
Dim b#,FileSize(d$)
BlockRead(d$,b#,0,SizeOf(b#))
d$ = Char$(b#,2,SizeOf(b#)-2)
Dispose b#
Die Zeilen werden im Sortier-Listview alphabetisch geordnet
whileloop 0,len(d$,"x0Dzx0Az")-1
Set("ListDel", "|")
InsertStringW(hSort&,SubStr$(d$,&loop+1,"x0Dzx0Az"),&loop)
Set("ListDel", ";")
InsertStringW(dList&,SubStr$(d$,&loop+1,"x0Dzx0Az"),&loop)
EndWhile
Set("ListDel",";")
var LVI# = New(LVITEM)
LVI#.IMASK&= $1
LVI#.ITEXT&= Lvi#+36
LVI#.ITEXTMAX& = 200
LVI#.ISUBITEM& = 0
whileloop 0,getcount(hsort&) -1len(d$,"x0Dzx0Az")-1
LVI#.ITEM& = &loop
u_SendMessageW(hSort&,$1073,&loop,LVI#)Text auslesen
Dim b#,200
b# = LVI#.iText&
d$ = Char$(b#,0,SizeOf(b#))In Stringvariable schreiben
InsertStringW(hList&,d$,&loop)übertragen
dispose b#
EndWhile
Dispose LVI#,b#
endproc
declare hUser&,hGDI&,hKrnl&
declare hSort&,hList&
cls
var font& = Create("Font","Arial",16,0,0,0,0)
hUser& = ImportDLL("USER32","u_")
hSort& = Create("GridBoxW",%hWnd,UTF("Sortieren")+";0;100",$10,0,0,0,0)
hList& = Create("GridBoxW",%hWnd,UTF("Deutsch")+";0;150;"+UTF("Polnisch")+";0;150",$00,0,0,0,0)
SetFont hList&,font&
var dList& = Create("GridBoxW",%hWnd,UTF("Deutsch")+";0;150;"+UTF("Polnisch")+";0;150",$00,0,0,0,0)
SetFont dList&,font&
Format
"Wort1;Wort2
Wort3;Wort4;..."
var BUT1&=Create("Button",%hwnd,"A-Z polnisch",470,10,100,22)
SetFont BUT1&,font&
EnableWindow but1&,1
var BUT2&=Create("Button",%hwnd,"A-Z deutsch",320,10,100,22)
SetFont BUT2&,font&
EnableWindow but2&,0
LoadText "Test.txt"
SetWindowPos hList&=290,50-310,200;0
whilenot IsKey(27)
waitinput
If GetFocus(BUT1&)
SetWindowPos hList&=0,0-0,0;0
SetWindowPos dList&=290,50-310,200;0
EnableWindow but1&,0
EnableWindow but2&,1
ElseIf GetFocus(BUT2&)
SetWindowPos dList&=0,0-0,0;0
SetWindowPos hList&=290,50-310,200;0
EnableWindow but1&,1
EnableWindow but2&,0
EndIf
wend
FreeDLL hUser&
FreeDLL hGDI&
../../funktionsreferenzen/XProfan/freedll/'>FreeDLL hKrnl&
DeleteObject font&
end
|
| | | | | | |
| |
Nico
Madysa | 
Como durfte Yo auch annehmen, dass Windows me sagt, wo el String liegt!
Dank sei euch beiden, Dieter y Thomas, ahora klappt lo. Dietmar se se freuen. 
KompilierenMarcaSeparación $H Messages.ph
var id% = 1
Struct CREATESTRUCT = lpCreateParams&, hInstance&, hMenu&, hwndParent&, cy%, cx%, y%, x%, style&, lpszName&, lpszClass&, dwExStyle&
Struct LVCOLUMN = Mask&, FMT&, CX&, Text&, cchTextMaxLen&, Subitem&
Struct LVITEM = IMASK&, ITEM&, ISUBITEM&, State&, StateMask&, ITEXT&, ITEXTMAX&, IIMAGE&, ILPARAM&
proc UTF
parameters text$
declare b#
Dim b#,2*len(text$)+2
StringW b#,0 = text$
text$ = Char$(b#,0,SizeOf(b#)-2)
return text$
endproc
proc CreateW
if %pCount > 10
parameters Class$,Name$,style&,x%,y%,dx%,dy%,pWnd&,pid%,hInst&,exstyle&
else
parameters Class$,Name$,style&,x%,y%,dx%,dy%,pWnd&,pid%,hInst&
var exstyle& = 0
endif
Class$ = UTF(Class$)
Name$ = UTF(Name$)
var cs# = New(CREATESTRUCT)
With cs#
.lpCreateParams& = SizeOf(cs#)
.hInstance& = hInst&
.hMenu& = if(u_IsMenu(id%),id%,0)
.hwndParent& = pWnd&
.cy% = dy%
.cx% = dx%
.y% = y%
.x% = x%
.style& = style&
.lpszName& = Addr(Name$)
.lpszClass& = Addr(Class$)
.dwExStyle& = exstyle&
EndWith
var handle& = u_CreateWindowExW(exstyle&,Addr(Class$),Addr(Name$),style&,x%,y%,dx%,dy%,pWnd&,id%,hInst&,cs#)
inc id%
ifnot handle&
Class$ = WinError$(%WinError)
MessageBox("Es trat folgender Fehler auf:
" + Class$,"F E H L E R !!!",4096)
endif
Dispose cs#
return handle&
endproc
$200 = edierbar
$10 = von A-Z
$20 = von Z-A
$04 = keine Mehrfachauswahl
subproc Create.GridBoxW
parameters pWnd&,def$,stl%,x%,y%,dx%,dy%
declare s$
var hList& = CreateW("SysListView32","",$50000009 + stl%,x%,y%,dx%,dy%,pWnd&,0,%hInstance,$200)
u_SendMessageW(hList&,$1036,0,$00000023)
var LVC# = New(LVCOLUMN)
With LVC#
.Subitem& = 0
.MASK& = $7
whileloop 0,(len(def$,";") 3) - 1
s$ = SubStr$(def$,3*&loop + 1,";")
.TEXT& = Addr(s$)
.FMT& = val(SubStr$(def$,3*&loop + 2,";"))
.CX& = val(SubStr$(def$,3*&loop + 3,";"))
.cchTextMaxLen& = len(s$)
u_SendMessageW(hList&,$1061,&loop,LVC#)
EndWhile
EndWith
Dispose LVC#
return hList&
endproc
proc InsertStringW
parameters pList&,s$,index%
declare ss$
var LVI# = New(LVITEM)
var d$ = UTF(Get("ListDel"))
With LVI#
.IMASK&=$1
.ITEM& = index%
whileloop len(s$,d$)
ss$ = SubStr$(s$,&loop,d$)
.iText& = Addr(ss$)
.ITEXTMAX& = len(ss$)
.ISUBITEM& = &loop - 1
ifnot &loop - 1
u_SendMessageW(pList&,$104D,index%,LVI#)
else
u_SendMessageW(pList&,$104C,index%,LVI#)
endif
EndWhile
EndWith
endproc
proc LoadText
parameters d$
Die CSV-Datei wird eingelesen
declare b#,t$,tt$
Dim b#,FileSize(d$)
BlockRead(d$,b#,0,SizeOf(b#))
d$ = Char$(b#,2,SizeOf(b#)-2)
Dispose b#
Die Zeilen werden im Sortier-Listview alphabetisch geordnet
whileloop 0,len(d$,"x0Dzx0Az")-1
InsertStringW(hSort&,SubStr$(d$,&loop+1,"x0Dzx0Az"),&loop)
EndWhile
Die Substrings jeder Zeile sind mit einem Semikolon getrennt
Set("ListDel",";")
Das Sortier-Listview wird ins Anzeigelistview übertragen
Aus einer Spalte werden zwei
var LVI# = New(LVITEM)
LVI#.IMASK&= $1
LVI#.ITEXT&= LVI#+36
LVI#.ITEXTMAX& = 200
LVI#.ISUBITEM& = 0
whileloop 0,getcount(hsort&) - 1 len(d$,"x0Dzx0Az")-1
LVI#.ITEM& = &loop
u_SendMessageW(hSort&,$1073,&loop,LVI#)Text auslesen
Dim b#,200
b# = LVI#.iText&
d$ = Char$(b#,0,SizeOf(b#))In Stringvariable schreiben
InsertStringW(hList&,d$,&loop)übertragen
Dispose b#
EndWhile
Dispose LVI#
endproc
declare hUser&,hGDI&,hKrnl&
declare hSort&,hList&
cls
var font& = Create("Font","Times New Roman",16,0,0,0,0)
hUser& = ImportDLL("USER32","u_")
hSort& = Create("GridBoxW",%hWnd,UTF("Sortieren")+";0;100",$10,0,0,0,0)
ShowWindow(hSort&,0)
hList& = Create("GridBoxW",%hWnd,UTF("Deutsch")+";0;300;"+UTF("Polnisch")+";2;300",$00,0,0,width(%hWnd),height(%hWnd))
SetFont hList&,font&
WindowTitle "Bitte warten, Wortliste wird geladen ..."
Format
"Wort1;Wort2
Wort3;Wort4;..."
LoadText LoadFile$("Quelldatei laden ...","*.txt")
WindowTitle "Je 100 deutsche und polnische Wörter"
whilenot IsKey(27)
waitinput
wend
FreeDLL hUser&
FreeDLL hGDI&
FreeDLL hKrnl&
DeleteObject font&
end
|
| | | | | | |
| |
Thomas
Freier | Davor Yo quería eigentlich de el sortierten Listview una neue nTest.txt erzeugen. Bin gescheitert.
Nico, son en el Script entsprechende PROCs disponible, con denen una neue UTF-txt producido voluntad kann? |
| | | | | | |
| |
Nico
Madysa | Öhhhhm ... No, dass Yo saber.
Doch prinzipiell müsstest Si es usted el Listview sólo zeilenweise auslesen y esta Zeilen entonces gewöhnlich en un Textdatei escribir. Mit "x0Dzz" como Zeilentrenner. ("
" en el Unicodeformat) Rewrite böte se dafür probablemente no a, porque lo "
" verwendet, du müsstest por lo tanto alles en una Zona klatschen oder PutChar uso. Tiempo sehen, si Yo heute todavía Tiempo (y Lust  ) finde, algo hinzupinseln. |
| | | | | | |
| | 
Dietmar
Horn |
Dietmar se se freuen.
Stimmt!
Also auch mein Dank gilt allen a el Problemlösung Beteiligten!
Thomas F. sei darüber hinaus para el Zurverfügungstellen el vorläufigen Alemán-Polnische-Vokabelliste gedankt!
Das größte Problema en el Zusammenhang con unserem Polonia-Projekt dürfte somit sólo veces gelöst ser - weitere voluntad determinado folgen ...
Zum Glück haben wir en unserem Verein zwei polnische Muttersprachler, el el Vokabeln y Textos después de y después de erweitern y korrekturlesen puede.
Sobald el Polonia-Projekt algo más fortgeschritten y vorzeigbar es, voluntad wir dieses Comunidad vorstellen.
Saludo
Dietmar |
| | | | Multimedia für Jugendliche und junge Erwachsene - MMJ Hoyerswerda e.V. [...]  Windows 95 bis Windows 7 Profan² 6.6 bis XProfan X2 mit XPSE Das große XProfan-Lehrbuch: [...] | 05.07.2009 ▲ |
| | |
| |
Dieter
Zornow | Yo denke du solltest el -1 beibehalten
whileloop 0,getcount(hsort&) -1
Como el Zählung en Línea 0 beginnt y getcount() en 1 se sonst zuviel eingelesen, en deinem neuen Code se en me sin el -1 el letzte Contribución zweimal eingelesen. |
| | | | Er ist ein Mann wie ein Baum. Sie nennen ihn Bonsai., Win 7 32 bit und Win 7 64 bit, mit XProfan X2 | 05.07.2009 ▲ |
| | |
| |
Nico
Madysa | Verdammt, una wenig a viel ausgeklammert ...
Habs korrigiert, danke.
Das Carta uno TXT-Expediente kommt später. Es doch no así simplemente, Yo esperado habe. |
| | | | | | |
| |
Nico
Madysa | Haha, macht lo kurz y nennt mich Genie!
Das Problema es, dass Profano unglaublich nutzlos se, sobald lo a Unicode va. El Schwierigkeit es nämlich folgende:
1. Antes de que yo el Texto auslese, saber Yo seine Longitud no, ergo muss Yo una feste Puffergröße nehmen. (Dieter 200 genommen.)
2. Como en Unicode praktisch fast cada zweite Byte una Nullbyte es, kann Yo String$() no uso a Signo de el Zona a lesen. StringW$() va ebenso wenig, como lo sólo cada zweite Byte ignoriert y el Texto así en Ansi umwandelt. Folglich restos me sólo, con Char$() el gesamten Zona auszulesen.
3. Dementsprechend es cada ausgelesene String 200 Bytes lang, al Ende folgt una Nullbyte el nächsten.
4. Der eigentliche Knackpunkt, el me Schwierigkeiten bereitet ha. Um el überflüssigen End-Nullbytes a tilgen, darf no Trim$() verwandt voluntad! Lo tilgt en el meisten Fällen nämlich auch el zweite Byte des letzten Zeichens.
5. Der Umweg dafür es Translate$(texto$,"zz",""), así debería kein Bug mehr auftreten.
6. Ebenfalls debería uno herausfinden, dass Unicode-TXT-Archivos a Erkennung con el Bytes 255,254 beginnen. (XProfan: "xFFxFE")
7. Auch erkenne Yo endlich el Nutzen de Claro bereich#. Diesem Dreckspatz de Windows muss uno sólo alles hinterherräumen.
Dieser Code liest el Textdatei una y sichert ellos bajo una otro Namen, si uno en ESC drückt.
KompilierenMarcaSeparación $H Messages.ph
var id% = 1
Struct CREATESTRUCT = lpCreateParams&, hInstance&, hMenu&, hwndParent&, cy%, cx%, y%, x%, style&, lpszName&, lpszClass&, dwExStyle&
Struct LVCOLUMN = Mask&, FMT&, CX&, Text&, cchTextMaxLen&, Subitem&
Struct LVITEM = IMASK&, ITEM&, ISUBITEM&, State&, StateMask&, ITEXT&, ITEXTMAX&, IIMAGE&, ILPARAM&
proc UTF
parameters text$
declare b#
Dim b#,2*len(text$)+2
StringW b#,0 = text$
text$ = Char$(b#,0,SizeOf(b#)-2)
return text$
endproc
proc CreateW
if %pCount > 10
parameters Class$,Name$,style&,x%,y%,dx%,dy%,pWnd&,pid%,hInst&,exstyle&
else
parameters Class$,Name$,style&,x%,y%,dx%,dy%,pWnd&,pid%,hInst&
var exstyle& = 0
endif
Class$ = UTF(Class$)
Name$ = UTF(Name$)
var cs# = New(CREATESTRUCT)
With cs#
.lpCreateParams& = SizeOf(cs#)
.hInstance& = hInst&
.hMenu& = if(u_IsMenu(id%),id%,0)
.hwndParent& = pWnd&
.cy% = dy%
.cx% = dx%
.y% = y%
.x% = x%
.style& = style&
.lpszName& = Addr(Name$)
.lpszClass& = Addr(Class$)
.dwExStyle& = exstyle&
EndWith
var handle& = u_CreateWindowExW(exstyle&,Addr(Class$),Addr(Name$),style&,x%,y%,dx%,dy%,pWnd&,id%,hInst&,cs#)
inc id%
ifnot handle&
Class$ = WinError$(%WinError)
MessageBox("Es trat folgender Fehler auf:
" + Class$,"F E H L E R !!!",4096)
endif
Dispose cs#
return handle&
endproc
$200 = edierbar
$10 = von A-Z
$20 = von Z-A
$04 = keine Mehrfachauswahl
subproc Create.GridBoxW
parameters pWnd&,def$,stl%,x%,y%,dx%,dy%
declare s$
var hList& = CreateW("SysListView32","",$50000009 + stl%,x%,y%,dx%,dy%,pWnd&,0,%hInstance,$200)
u_SendMessageW(hList&,$1036,0,$00000023)
var LVC# = New(LVCOLUMN)
With LVC#
.Subitem& = 0
.MASK& = $7
whileloop 0,(len(def$,";") 3) - 1
s$ = SubStr$(def$,3*&loop + 1,";")
.TEXT& = Addr(s$)
.FMT& = val(SubStr$(def$,3*&loop + 2,";"))
.CX& = val(SubStr$(def$,3*&loop + 3,";"))
.cchTextMaxLen& = len(s$)
u_SendMessageW(hList&,$1061,&loop,LVC#)
EndWhile
EndWith
Dispose LVC#
return hList&
endproc
proc InsertStringW
parameters pList&,s$,index%
declare ss$
var LVI# = New(LVITEM)
var d$ = UTF(Get("ListDel"))
With LVI#
.IMASK&=$1
.ITEM& = index%
whileloop len(s$,d$)
ss$ = SubStr$(s$,&loop,d$)
.iText& = Addr(ss$)
.ITEXTMAX& = len(ss$)
.ISUBITEM& = &loop - 1
ifnot &loop - 1
u_SendMessageW(pList&,$104D,index%,LVI#)
else
u_SendMessageW(pList&,$104C,index%,LVI#)
endif
EndWhile
EndWith
endproc
proc LoadText
parameters d$
case d$ = "" : return
Die CSV-Datei wird eingelesen
declare b#,t$,tt$
Dim b#,FileSize(d$)
BlockRead(d$,b#,0,SizeOf(b#))
d$ = Char$(b#,2,SizeOf(b#)-2)
Dispose b#
Die Zeilen werden im Sortier-Listview alphabetisch geordnet
whileloop 0,len(d$,"x0Dzx0Az")-1
InsertStringW(hSort&,SubStr$(d$,&loop+1,"x0Dzx0Az"),&loop)
EndWhile
Die Substrings jeder Zeile sind mit einem Semikolon getrennt
Set("ListDel",";")
Das Sortier-Listview wird ins Anzeigelistview übertragen
Aus einer Spalte werden zwei
var LVI# = New(LVITEM)
LVI#.IMASK&= $1
LVI#.ITEXT&= LVI#+36
LVI#.ITEXTMAX& = 200
LVI#.ISUBITEM& = 0
whileloop 0, Getcount(hSort&) -1
LVI#.ITEM& = &loop
u_SendMessageW(hSort&,$1073,&loop,LVI#)Text auslesen
Dim b#,200
b# = LVI#.iText&
d$ = Char$(b#,0,SizeOf(b#))In Stringvariable schreiben
InsertStringW(hList&,d$,&loop)übertragen
Dispose b#
EndWhile
Dispose LVI#
endproc
proc Save
declare z%,s$,b#
var d$ = SaveFile$("Unicode-Text speichern","DeuPol2.txt")
case d$ = "" : return
WindowTitle "Es wird gesichert ..."
var LVI# = New(LVITEM)
LVI#.IMASK&= $1
LVI#.ITEXT&= LVI#+36
LVI#.ITEXTMAX& = 200
Dim b#,200
b# = LVI#.ITEXT&
clear b#
Dispose b#
var gesamt$ = ""
whileloop 0,GetCount(hList&) - 1
z% = &loop
LVI#.ITEM& = z%
whileloop 0,1
LVI#.ISUBITEM& = &loop
u_SendMessageW(hList&,$1073,z%,LVI#)Text auslesen
Dim b#,200
b# = LVI#.ITEXT&
gesamt$ = gesamt$ + Translate$(Char$(b#,0,200),"zz","") + if(&loop,"x0Dzx0Az",";z") if(&loop,"x0Dzx0Az",";z")
clear b#
Dispose b#
EndWhile
EndWhile
gesamt$ = Translate$(del$(gesamt$,len(gesamt$)-4,4),"x7Cz","x7Cx01")
gesamt$ = del$(gesamt$,len(gesamt$)-4,4)
Dim b#,len(gesamt$)+2
Char b#,0 = "xFFxFE" + gesamt$
BlockWrite d$,b#,0,SizeOf(b#)
Dispose b#
endproc
declare hUser&,hGDI&,hKrnl&
declare hSort&,hList&
cls
var font& = Create("Font","Times New Roman",16,0,0,0,0)
hUser& = ImportDLL("USER32","u_")
hSort& = Create("GridBoxW",%hWnd,UTF("Sortieren")+";0;100",$10,0,0,0,0)
ShowWindow(hSort&,0)
hList& = Create("GridBoxW",%hWnd,UTF("Deutsch")+";0;300;"+UTF("Polnisch")+";2;300",$00,0,0,width(%hWnd),height(%hWnd))
SetFont hList&,font&
WindowTitle "Bitte warten, Wortliste wird geladen ..."
Format
"Wort1;Wort2
Wort3;Wort4;..."
LoadText LoadFile$("Quelldatei laden ...","deupol.txt")
WindowTitle "Je 100 deutsche und polnische Wörter (ESC um zu sichern)"
whilenot IsKey(27)
waitinput
wend
Save
FreeDLL hUser&
FreeDLLGDI&
FreeDLL hKrnl&
DeleteObject font&
end
|
| | | | | | |
| | | | | | - Página 2 - |
| |
Dieter
Zornow | Super gemacht,
el Longitud des ausgelesenen Cuerdas kannst du aber erfahren "LVM_GETITEMTEXT" son como Ergebnis el Longitud des Cuerdas zurück, así dass du eigentlich no feste Größe annehmen musst.
Usted könntest simplemente x& = sendmessgeW(...,~LVM_GETITEMTEXTW,..,..) abfragen y danach el Zona dimensionieren. |
| | | | Er ist ein Mann wie ein Baum. Sie nennen ihn Bonsai., Win 7 32 bit und Win 7 64 bit, mit XProfan X2 | 06.07.2009 ▲ |
| | |
| |
Nico
Madysa | ... 
Verdammt, había Yo en el Zwischenzeit ya otra vez bastante vergessen!
Hier Es el translatelose Variante. Los cambios son minimal, el betroffene Línea lautet ahora
Dim b#,2 * u_SendMessageW(hList&,$1073,z%,LVI#).
KompilierenMarcaSeparación $H Messages.ph
var id% = 1
Struct CREATESTRUCT = lpCreateParams&, hInstance&, hMenu&, hwndParent&, cy%, cx%, y%, x%, style&, lpszName&, lpszClass&, dwExStyle&
Struct LVCOLUMN = Mask&, FMT&, CX&, Text&, cchTextMaxLen&, Subitem&
Struct LVITEM = IMASK&, ITEM&, ISUBITEM&, State&, StateMask&, ITEXT&, ITEXTMAX&, IIMAGE&, ILPARAM&
proc UTF
parameters text$
declare b#
Dim b#,2*len(text$)+2
StringW b#,0 = text$
text$ = Char$(b#,0,SizeOf(b#)-2)
return text$
endproc
proc CreateW
if %pCount > 10
parameters Class$,Name$,style&,x%,y%,dx%,dy%,pWnd&,pid%,hInst&,exstyle&
else
parameters Class$,Name$,style&,x%,y%,dx%,dy%,pWnd&,pid%,hInst&
var exstyle& = 0
endif
Class$ = UTF(Class$)
Name$ = UTF(Name$)
var cs# = New(CREATESTRUCT)
With cs#
.lpCreateParams& = SizeOf(cs#)
.hInstance& = hInst&
.hMenu& = if(u_IsMenu(id%),id%,0)
.hwndParent& = pWnd&
.cy% = dy%
.cx% = dx%
.y% = y%
.x% = x%
.style& = style&
.lpszName& = Addr(Name$)
.lpszClass& = Addr(Class$)
.dwExStyle& = exstyle&
EndWith
var handle& = u_CreateWindowExW(exstyle&,Addr(Class$),Addr(Name$),style&,x%,y%,dx%,dy%,pWnd&,id%,hInst&,cs#)
inc id%
ifnot handle&
Class$ = WinError$(%WinError)
MessageBox("Es trat folgender Fehler auf:
" + Class$,"F E H L E R !!!",4096)
endif
Dispose cs#
return handle&
endproc
$200 = edierbar
$10 = von A-Z
$20 = von Z-A
$04 = keine Mehrfachauswahl
subproc Create.GridBoxW
parameters pWnd&,def$,stl%,x%,y%,dx%,dy%
declare s$
var hList& = CreateW("SysListView32","",$50000009 + stl%,x%,y%,dx%,dy%,pWnd&,0,%hInstance,$200)
u_SendMessageW(hList&,$1036,0,$00000023)
var LVC# = New(LVCOLUMN)
With LVC#
.Subitem& = 0
.MASK& = $7
whileloop 0,(len(def$,";") 3) - 1
s$ = SubStr$(def$,3*&loop + 1,";")
.TEXT& = Addr(s$)
.FMT& = val(SubStr$(def$,3*&loop + 2,";"))
.CX& = val(SubStr$(def$,3*&loop + 3,";"))
.cchTextMaxLen& = len(s$)
u_SendMessageW(hList&,$1061,&loop,LVC#)
EndWhile
EndWith
Dispose LVC#
return hList&
endproc
proc InsertStringW
parameters pList&,s$,index%
declare ss$
var LVI# = New(LVITEM)
var d$ = UTF(Get("ListDel"))
With LVI#
.IMASK&=$1
.ITEM& = index%
whileloop len(s$,d$)
ss$ = SubStr$(s$,&loop,d$)
.iText& = Addr(ss$)
.ITEXTMAX& = len(ss$)
.ISUBITEM& = &loop - 1
ifnot &loop - 1
u_SendMessageW(pList&,$104D,index%,LVI#)
else
u_SendMessageW(pList&,$104C,index%,LVI#)
endif
EndWhile
EndWith
endproc
proc LoadText
parameters d$
case d$ = "" : return
Die CSV-Datei wird eingelesen
declare b#,t$,tt$
Dim b#,FileSize(d$)
BlockRead(d$,b#,0,SizeOf(b#))
d$ = Char$(b#,2,SizeOf(b#)-2)
Dispose b#
Die Zeilen werden im Sortier-Listview alphabetisch geordnet
whileloop 0,len(d$,"x0Dzx0Az")-1
InsertStringW(hSort&,SubStr$(d$,&loop+1,"x0Dzx0Az"),&loop)
EndWhile
Die Substrings jeder Zeile sind mit einem Semikolon getrennt
Set("ListDel",";")
Das Sortier-Listview wird ins Anzeigelistview übertragen
Aus einer Spalte werden zwei
var LVI# = New(LVITEM)
LVI#.IMASK&= $1
LVI#.ITEXT&= LVI#+36
LVI#.ITEXTMAX& = 200
LVI#.ISUBITEM& = 0
whileloop 0, Getcount(hSort&) -1
LVI#.ITEM& = &loop
u_SendMessageW(hSort&,$1073,&loop,LVI#)Text auslesen
Dim b#,200
b# = LVI#.iText&
d$ = Char$(b#,0,SizeOf(b#))In Stringvariable schreiben
InsertStringW(hList&,d$,&loop)übertragen
Dispose b#
EndWhile
Dispose LVI#
endproc
proc Save
declare z%,s$,b#
var d$ = SaveFile$("Unicode-Text speichern","DeuPol2.txt")
case d$ = "" : return
WindowTitle "Es wird gesichert ..."
var LVI# = New(LVITEM)
LVI#.IMASK&= $1
LVI#.ITEXT&= LVI#+36
LVI#.ITEXTMAX& = 200
Dim b#,200
b# = LVI#.ITEXT&
clear b#
Dispose b#
var gesamt$ = ""
whileloop 0,GetCount(hList&) - 1
z% = &loop
LVI#.ITEM& = z%
whileloop 0,1
LVI#.ISUBITEM& = &loop
Dim b#,2 * u_SendMessageW(hList&,$1073,z%,LVI#) Text auslesen; dem Bereich wird das doppelte zugewiesen,
weil die Message die Textlänge und nicht den Speicher ausgibt
b# = LVI#.ITEXT&
gesamt$ = gesamt$ + Char$(b#,0,SizeOf(b#)) + if(&loop,"x0Dzx0Az",";z")
clear b#
Dispose b#
EndWhile
EndWhile
gesamt$ = Translate$(del$(gesamt$,len(gesamt$)-4,4),"x7Cz","x7Cx01")
gesamt$ = del$(gesamt$,len(gesamt$)-4,4)
Dim b#,len(gesamt$)+2
Char b#,0 = "xFFxFE" + gesamt$
BlockWrite d$,b#,0,SizeOf(b#)
Dispose b#
endproc
declare hUser&,hGDI&,hKrnl&
declare hSort&,hList&
cls
var font& = Create("Font","Times New Roman",16,0,0,0,0)
hUser& = ImportDLL("USER32","u_")
hSort& = Create("GridBoxW",%hWnd,UTF("Sortieren")+";0;100",$10,0,0,0,0)
ShowWindow(hSort&,0)
hList& = Create("GridBoxW",%hWnd,UTF("Deutsch")+";0;300;"+UTF("Polnisch")+";2;300",$00,0,0,width(%hWnd),height(%hWnd))
SetFont hList&,font&
WindowTitle "Bitte warten, Wortliste wird geladen ..."
Format
"Wort1;Wort2
Wort3;Wort4;..."
LoadText LoadFile$("Quelldatei laden ...","deupol.txt")
WindowTitle "Je 100 deutsche und polnische Wörter (ESC um zu sichern)"
whilenot IsKey(27)
waitinput
wend
Save
FreeDLL hUser&
FreeDLLGDI&
FreeDLL hKrnl&
DeleteObject font&
end
|
| | | | | | |
| |  | Das klingt después de uno UListView.Inc [...]  - bereitest Usted algo como en?  |
| | | | | | |
|
RespuestaThemeninformationenDieses Thema ha 5 subscriber: |
(454)
Deutsch
English
Français
Español
Italia