Forum | | | | | | - page 1 - |
| 
Nico
Madysa | Hallöchen miteinander!
cela Unicode-Listview selbst trop bricoler klappt mittlerweile droite bien, seulement stehen wir maintenant avant qui difficulté, es vernünftig trop sortieren.
KompilierenMarqueSéparation $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
cela Problem: dans qui ersten Spalte volonté qui Einträge alphabetisch sortiert, dans qui zweiten hingegen pas. cela hat zur Folge, cela manche Zellen vide rester, autre dagegen überschrieben volonté.
mon Ansatz: chacun la ligne wird zunächst dans un (eigentlich unsichtbares) einspaltiges Listview geschrieben. Dadurch gibt es aucun Probleme avec dem Sortieren. après volonté qui Zeilen des Listviews dans un zweites, sichtbares, unsortiertes Listview geschrieben.
Hierbei suis je cependant irgendwie unfähig, qui Zeilen des Listviews auszulesen. je erhalte de qui Message LVM_GETITEMTEXTW irgendwie seulement Leerstrings.
Erkennt irgendjemand quelque chose, le moi pas erkenne?
Salut,
Nico
PS: Anhangs est sich une CSV/TXT-Dossier pour Testzwecke. |
 | | | | | | |
| | | | | | | - page 1 - |
| 
Dieter
Zornow | Tricolore doch encore geschafft so gehts, lag à qui Dimensionierung dans qui Boucle
KompilierenMarqueSéparation
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 | oui c'est ca Dieter, tu étais plus rapide.
je hatte simple un "Dispose b#" dans qui Boucle gesetzt. mais so ist es besser.
KompilierenMarqueSéparation $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 | 
comment durfte je aussi annehmen, dass Windows mir sagt, wohin qui String liegt!
Dank sei euch beiden, Dieter et Thomas, maintenant klappt es. Dietmar wird sich freuen. 
KompilierenMarqueSéparation $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 | devant voulais je eigentlich aus qui sortierten Listview une neue nTest.txt erzeugen. suis gescheitert.
Nico, sommes dans dem Script entsprechende PROCs vorhanden, avec denen une neue UTF-txt erzeugt volonté peux? |
| | | | | | |
| |
Nico
Madysa | Öhhhhm ... pas, dass je wüsste.
Doch prinzipiell müsstest du cela Listview seulement zeilenweise auslesen et cet Zeilen ensuite gewöhnlich dans un Textdatei écrivons. avec "x0Dzz" comme Zeilentrenner. ("
" im Unicodeformat) Rewrite böte sich pour wohl pas à, weil es "
" verwendet, du müsstest daher alles dans une Bereich klatschen ou bien PutChar verwenden. la fois voyons, si je aujourd'hui encore Zeit (et Lust  ) finde, quelque chose hinzupinseln. |
| | | | | | |
| | 
Dietmar
Horn |
Dietmar wird sich freuen.
Stimmt!
alors aussi mon Dank gilt allen à qui Problemlösung Beteiligten!
Thomas F. sei par-dessus hinaus pour cela Zurverfügungstellen qui vorläufigen allemande-Polnische-Vokabelliste gedankt!
cela größte Problem im Zusammenhang avec unserem Polonia-projet pourrait somit seulement la fois gelöst son - weitere volonté bestimmt folgen ...
Zum avoir de la chance wir dans unserem club deux polnische Muttersprachler, qui qui Vokabeln et Textes pour et pour erweitern et korrekturlesen peut.
Sobald cela Polonia-projet quelque chose plus fortgeschritten et vorzeigbar ist, volonté wir cet qui Community présenter.
Salut
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 | je denke du devrait cela -1 beibehalten
whileloop 0,getcount(hsort&) -1
là qui Zählung chez la ligne 0 beginnt et getcount() chez 1 wird sonst zuviel lire, chez deinem neuen Code wird chez mir sans cela -1 qui dernier Beitrag zweimal lire. |
| | | | 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, un peu trop viel ausgeklammert ...
Tricolore korrigiert, merci.
cela écrivons einer TXT-Dossier venez später. c'est doch pas so simple, comment je erwartet habe. |
| | | | | | |
| |
Nico
Madysa | Haha, pouvoir es kurz et nennt mich Genie!
cela Problem ist, dass Profan unglaublich nutzlos wird, sobald es à Unicode allez. qui difficulté ist nämlich folgende:
1. Bevor Je l' Text auslese, kenne je sa Longueur pas, ergo muss je une feste Puffergröße prendre. (Dieter 200 pris.)
2. là dans Unicode pratique presque chaque zweite Byte un Nullbyte ist, peux je String$() pas verwenden à marque aus dem Bereich trop lesen. StringW$() allez ebenso wenig, là es seulement chaque zweite Byte ignoriert et den Text avec cela dans Ansi umwandelt. Folglich bleibt mir seulement, avec Char$() den gesamten Bereich auszulesen.
3. conforme à cela ist chacun ausgelesene String 200 Bytes long, am Ende folgt un Nullbyte dem prochain.
4. qui eigentliche Knackpunkt, qui mir Schwierigkeiten bereitet hat. Um qui überflüssigen Fin-Nullbytes trop tilgen, darf pas Trim$() verwandt volonté! Es tilgt dans den meisten Fällen nämlich aussi cela zweite Byte des letzten Zeichens.
5. qui le détour pour ist Translate$(text$,"zz",»), avec cela sollte ne...aucune Bug plus auftreten.
6. également sollte on herausfinden, dass Unicode-TXT-Fichiers zur Erkennung avec den Bytes 255,254 commencer. (XProfan: "xFFxFE")
7. aussi erkenne je enfin den Nutzen de Claire bereich#. Diesem Dreckspatz de Windows muss on arrêt alles hinterherräumen.
cette Code liest qui Textdatei un et sichert vous sous einem anderen Namen, si on sur ESC drückt.
KompilierenMarqueSéparation $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,
qui Longueur des ausgelesenen Cordes peux du mais erfahren "LVM_GETITEMTEXT" gibt comme Ergebnis qui Longueur des Cordes zurück, so dass du eigentlich aucun feste Taille annehmen musst.
Du könntest simple x& = sendmessgeW(...,~LVM_GETITEMTEXTW,..,..) abfragen et après 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, cela J'ai eu dans qui Zwischenzeit encore entier oublier qc!
ici ist qui translatelose variante. Changements sommes minimal, qui betroffene la ligne lautet maintenant
Faible b#,2 * u_SendMessageW(hList&,$1073,z%,LVI#).
KompilierenMarqueSéparation $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
|
| | | | | | |
| |  | cela klingt pour einer UListView.Inc [...]  - bereitest Du quelque chose comme sur?  |
| | | | | | |
|
répondreOptions du sujet | 2.956 Views |
Themeninformationencet Thema hat 5 participant: |
(448)
Deutsch
English
Français
Español
Italia