Forum | | | | | | - Page 1 - |
| 
Nico
Madysa | Hallöchen together!
the Unicode-List view self To basteln works in the meantime right well, only stand we now to the problem, it sensible To sort.
CompileMarkSeparation $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
The problem: in the first slot go The Entries alphabetical sortiert, in the second against not. the has to follow, the some boxes empty stay, others against it überschrieben go.
my Ansatz: Each row becomes first of all into (really unsichtbares) einspaltiges List view written. therefore there no Problems with the sort. thereafter go The Lines of Listviews into second, sichtbares, unsortiertes List view written.
Hierbei be I however somehow unable, The Lines of Listviews auszulesen. I sustain from the Message LVM_GETITEMTEXTW somehow only Leerstrings.
Erkennt someone something, that I not erkenne?
Sincerely,
Nico
PS: Anhangs is a CSV/TXT-File for Testzwecke. |
 | | | | | | |
| | | | | | | - Page 1 - |
| 
Dieter
Zornow | Habs still geschafft so GEHTS, lying on the Dimensionierung in the Loop
CompileMarkSeparation
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 | 07/04/09 ▲ |
| | |
| | 
Thomas
Freier | very Dieter, you were faster.
I had simply one "Dispose b#" into Loop staid. but so is it rather.
CompileMarkSeparation $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&
../../Function-References/XProfan/freedll/'>FreeDLL hKrnl&
DeleteObject font&
end
|
| | | | Gruß Thomas
Windows XP SP2, XProfan X2 | 07/04/09 ▲ |
| | |
| |
Nico
Madysa | 
How durfte so did i suppose, that windows me says, where the String lying!
Thanks be you both, Dieter and Thomas, now works it. Dietmar will forward. 
CompileMarkSeparation $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 | before it wished I really from the sortierten List view a new nTest.txt produce. be failed.
Nico, are the Script suitable PROCs present, with them a new UTF-txt created go can? |
| | | | Gruß Thomas
Windows XP SP2, XProfan X2 | 07/04/09 ▲ |
| | |
| |
Nico
Madysa | Öhhhhm ... not, I know.
still in principle müsstest You the List view only line by line read and these Lines then usually in a Textdatei write. with "x0Dzz" as Zeilentrenner. ("
" in the Unicodeformat) Rewrite böte itself for well not on, because it "
" uses, You müsstest therefore everything in a area clapping or PutChar use. time see, whether I today yet Time (and pleasure  ) find, something hinzupinseln. |
| | | | | | |
| | 
Dietmar
Horn |
Dietmar will forward.
is correct!
means my Thanks counts all on the Problemlösung Beteiligten!
Thomas F. be moreover for the Zurverfügungstellen the temporary german-Polish-Vokabelliste gedankt!
the most trouble in the Context with unserem Polonia-proposition might accordingly first time resolved his - further go certainly follow ...
to that prosper we in unserem association two polnische Muttersprachler, The The Vokabeln and Texts by degrees strain and korrekturlesen can.
once the Polonia-proposition something moreover advanced and vorzeigbar is, go we this the Community present.
Greeting
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: [...] | 07/05/09 ▲ |
| | |
| |
Dieter
Zornow | i think you should the -1 to maintain
whileloop 0,getcount(hsort&) -1
there The count with row 0 begins and getcount() with 1 becomes otherwise too much read, with your new code becomes by me without the -1 the last Posting twice read. |
| | | | Er ist ein Mann wie ein Baum. Sie nennen ihn Bonsai., Win 7 32 bit und Win 7 64 bit, mit XProfan X2 | 07/05/09 ▲ |
| | |
| |
Nico
Madysa | damn, a little bit To plenty ausgeklammert ...
Habs korrigiert, thanks.
the write of/ one TXT-File comes later. its still not so simply, How I expects have. |
| | | | | | |
| |
Nico
Madysa | Haha, power it short and name me genius!
The problem is, that Profan unbelievable useless becomes, once it on Unicode goes. The problem is namely following:
1. before I the Text choose, know I its length not, ergo must I a solid Puffergröße take. (Dieter 200 taken.)
2. there in Unicode useful almost each second byte one Nullbyte is, can I String$() not use around the characters from the area To reading. StringW$() goes likewise little, there it only each second byte ignoring and the Text so in Ansi umwandelt. accordingly remaining me only, with Char$() whom whole area auszulesen.
3. accordingly is eachone ausgelesene String 200 Bytes long, end follows one Nullbyte the next.
4. The eigentliche Knackpunkt, the me difficulty bereitet has. around the überflüssigen End-Nullbytes To delete, must not Trim$() akin go! it tilgt into most Make namely too the second byte the last Zeichens.
5. The detour for is Translate$(Text$,"zz",""), so ought to no bow More appear.
6. ditto ought to one find out, that Unicode-TXT-Files to recognition with the Bytes 255,254 begin. (XProfan: "xFFxFE")
7. too erkenne I finally whom benefit of Clear area#. this Dreckspatz Windows must one hold everything hinterherräumen.
this code reads The Textdatei one and saves tappt im dunkeln under another names, if one on ESC pressing.
CompileMarkSeparation $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 made,
The length the ausgelesenen Strings can you but experienced "LVM_GETITEMTEXT" gives as Result The length the Strings back, so that You really no solid Size suppose must.
You could simply x& = sendmessgeW(...,~LVM_GETITEMTEXTW,..,..) inquire and thereafter whom area dimensionieren. |
| | | | Er ist ein Mann wie ein Baum. Sie nennen ihn Bonsai., Win 7 32 bit und Win 7 64 bit, mit XProfan X2 | 07/06/09 ▲ |
| | |
| |
Nico
Madysa | ... 
damn, had I in the interim again integrally forget!
here's The translatelose Variante. Changes are minimal, The betroffene row sounds now
Dim b#,2 * u_SendMessageW(hList&,$1073,z%,LVI#).
CompileMarkSeparation $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
|
| | | | | | |
| |  | the sound after a UListView.Inc [...]  - bereitest You something like on?  |
| | | | | | |
|
AnswerThemeninformationenthis Topic has 5 subscriber: |
(454)
Deutsch
English
Français
Español
Italia