Foro | | | | | | - Page 1 - |
| 
Nico
Madysa | Hallöchen miteinander!
Das Unicode-Listview selbst zu basteln klappt mittlerweile recht gut, nur stehen wir jetzt vor der Schwierigkeit, es vernünftig zu sortieren.
KompilierenMarkierenSeparieren $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 Problem: In der ersten Spalte werden die Einträge alphabetisch sortiert, in der zweiten hingegen nicht. Das hat zur Folge, das manche Zellen leer bleiben, andere dagegen überschrieben werden.
Mein Ansatz: Jede Zeile wird zunächst in ein (eigentlich unsichtbares) einspaltiges Listview geschrieben. Dadurch gibt es keine Probleme mit dem Sortieren. Danach werden die Zeilen des Listviews in ein zweites, sichtbares, unsortiertes Listview geschrieben.
Hierbei bin ich jedoch irgendwie unfähig, die Zeilen des Listviews auszulesen. Ich erhalte von der Message LVM_GETITEMTEXTW irgendwie nur Leerstrings.
Erkennt irgendjemand etwas, das ich nicht erkenne?
Saluto,
Nico
PS: Anhangs è sich eine CSV/TXT-File per Testzwecke. |
 | | | | | | |
| | | | | | | - Page 1 - |
| 
Dieter
Zornow | Habs doch noch geschafft so gehts, lag an der Dimensionierung in der Schleife
KompilierenMarkierenSeparieren
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 | Genau Dieter, du warst schneller.
Ich hatte einfach ein "Dispose b#" in die Schleife gesetzt. Aber so ist es besser.
KompilierenMarkierenSeparieren $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 | 
Wie durfte ich auch annehmen, dass Windows mir sagt, wo der String liegt!
Dank sei euch beiden, Dieter und Thomas, jetzt klappt es. Dietmar wird sich freuen. 
KompilierenMarkierenSeparieren $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 wollte ich eigentlich aus der sortierten Listview eine neue nTest.txt erzeugen. Bin gescheitert.
Nico, sind in dem Script entsprechende PROCs vorhanden, mit denen eine neue UTF-txt erzeugt werden kann? |
| | | | | | |
| |
Nico
Madysa | Öhhhhm ... Nicht, dass ich wüsste.
Doch prinzipiell müsstest du das Listview nur zeilenweise auslesen und diese Zeilen dann gewöhnlich in un Textdatei schreiben. Mit "x0Dzz" als Zeilentrenner. ("
" im Unicodeformat) Rewrite böte sich dafür wohl nicht an, weil es "
" verwendet, du müsstest daher alles in einen Bereich klatschen oder PutChar verwenden. Mal sehen, ob ich heute noch Zeit (und Lust  ) finde, etwas hinzupinseln. |
| | | | | | |
| | 
Dietmar
Horn |
Dietmar wird sich freuen.
Stimmt!
Also auch mein Dank gilt allen an der Problemlösung Beteiligten!
Thomas F. sei darüber hinaus per das Zurverfügungstellen der vorläufigen Deutsch-Polnische-Vokabelliste gedankt!
Das größte Problem im Zusammenhang mit unserem Polonia-Projekt potrebbe somit erst mal gelöst sein - weitere werden bestimmt folgen ...
Zum Glück haben wir in unserem Verein zwei polnische Muttersprachler, die die Vokabeln und Texte nach und nach erweitern und korrekturlesen können.
Sobald das Polonia-Projekt etwas weiter fortgeschritten und vorzeigbar ist, werden wir dieses der Community vorstellen.
Saluto
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 | ich denke du solltest das -1 beibehalten
whileloop 0,getcount(hsort&) -1
Da die Zählung bei Zeile 0 beginnt und getcount() bei 1 wird sonst zuviel eingelesen, bei deinem neuen Code wird bei mir ohne das -1 der letzte Beitrag 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, ein wenig zu viel ausgeklammert ...
Habs korrigiert, danke.
Das Schreiben einer TXT-File kommt später. Es ist doch nicht so einfach, wie ich erwartet habe. |
| | | | | | |
| |
Nico
Madysa | Haha, macht es kurz und nennt mich Genie!
Das Problem ist, dass Profan unglaublich nutzlos wird, sobald es an Unicode geht. Die Schwierigkeit ist nämlich folgende:
1. Bevor Io l' Text auslese, kenne ich seine Länge nicht, ergo muss ich eine feste Puffergröße nehmen. (Dieter hat 200 genommen.)
2. Da in Unicode praktisch fast jedes zweite Byte ein Nullbyte ist, kann ich String$() nicht verwenden um die Zeichen aus dem Bereich zu lesen. StringW$() geht ebenso wenig, da es nur jedes zweite Byte ignoriert und den Text damit in Ansi umwandelt. Folglich bleibt mir nur, mit Char$() den gesamten Bereich auszulesen.
3. Dementsprechend ist jeder ausgelesene String 200 Bytes lang, am Ende folgt ein Nullbyte dem nächsten.
4. Der eigentliche Knackpunkt, der mir Schwierigkeiten bereitet hat. Um die überflüssigen End-Nullbytes zu tilgen, darf nicht Trim$() verwandt werden! Es tilgt in den meisten Fällen nämlich auch das zweite Byte des letzten Zeichens.
5. Der Umweg dafür ist Translate$(text$,"zz",""), damit sollte kein Bug mehr auftreten.
6. Ebenfalls sollte man herausfinden, dass Unicode-TXT-File zur Erkennung mit den Bytes 255,254 beginnen. (XProfan: "xFFxFE")
7. Auch erkenne ich endlich den Nutzen von Clear bereich#. Diesem Dreckspatz von Windows muss man halt alles hinterherräumen.
Dieser Code liest die Textdatei ein und sichert sie unter einem anderen Namen, wenn man auf ESC drückt.
KompilierenMarkierenSeparieren $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
|
| | | | | | |
| | | | | | - Page 2 - |
| |
Dieter
Zornow | Super gemacht,
die Länge des ausgelesenen Strings kannst du aber erfahren "LVM_GETITEMTEXT" gibt als Ergebnis die Länge des Strings zurück, so dass du eigentlich keine feste Dimensione annehmen musst.
Du könntest einfach x& = sendmessgeW(...,~LVM_GETITEMTEXTW,..,..) abfragen und danach den Bereich 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, das hatte ich in der Zwischenzeit schon wieder ganz vergessen!
Hier ist die translatelose Variante. Änderungen sind minimal, die betroffene Zeile lautet jetzt
Dim b#,2 * u_SendMessageW(hList&,$1073,z%,LVI#).
KompilierenMarkierenSeparieren $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 nach einer UListView.Inc [...]  - bereitest Du sowas auf?  |
| | | | | | |
|
AnswerThemeninformationenDieses Thema hat 5 subscriber: |
(451)
Deutsch
English
Français
Español
Italia