Forum | | | | | | - Page 1 - |
| 
Nico
Madysa | a Greeting all daraußen.
these the offizielle successor hiervon: [...]  . this time diving one very seltsamer Error in quasi the same code on. to recollection be it once more (in negligible gekürzter shape) viewed:
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 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
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
subproc Create.GridBoxW
parameters pWnd&,def$,stl%,x%,y%,dx%,dy%
declare s$
var hList& = CreateW("SzyzszLzizsztzVzizezwz3z2zzz","",$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$ = Get("ListDel") + "z"
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
Dispose LVI#
endproc
proc LoadText
parameters d$
declare a$
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
a$ = "Mzeziznz;zVzezrzszuzczhz!z"
a$ = SubStr$(d$,&loop+1,"x0Dzx0Az")
WindowTitle Translate$(a$,"z","|")
InsertStringW(hSortDP&,a$,&loop)
InsertStringW(hSortDP&,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(hSortDP&) -1
LVI#.ITEM& = &loop
u_SendMessageW(hSortDP&,$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 hSortDP&,hList&
cls
var font& = Create("Font","Times New Roman",16,0,0,0,0)
hUser& = ImportDLL("USER32","u_")
hSortDP& = Create("GridBoxW",%hWnd,";0;100",$10,0,0,0,0)
ShowWindow(hSortDP&,0)
hList& = Create("GridBoxW",%hWnd,";0;300;;0;300",$00,0,0,width(%hWnd),height(%hWnd))
SetFont hList&,font&
WindowTitle "Bitte warten, Wortliste wird geladen ..."
Format
LoadText LoadFile$("Testdatei laden","Test.txt")
WindowTitle "Je 100 deutsche und polnische Wörter"
whilenot IsKey(27)
waitinput
wend
FreeDLL hUser&
FreeDLL hGDI&
FreeDLL hKrnl&
DeleteObject font&
end
plenty Text circa little Weird, decide are namely The subesquent Lines:
CompileMarkSeparation
whileloop 0,len(d$,"x0Dzx0Az")-1
a$ = "Mzeziznz;zVzezrzszuzczhz!z"
a$ = SubStr$(d$,&loop+1,"x0Dzx0Az")
Window Title Translate$(a$,"z","|")
InsertStringW(hSortDP&,a$,&loop)
InsertStringW(hSortDP&,SubStr$(d$,&loop+1,"x0Dzx0Az"),&loop)
EndWhile
here crashes the code in the later row
CompileMarkSeparation sang- and klanglos ex. now The really verwunderlichen Beobachtungen:
1. the Compilations operates fehlerfrei.
2. take I do not whom detour over a$, separate füge whom Substring immediate one (row 2 and 4 lane, for row 5), so there none Error.
3. take I no unterschiedlichen Texts, separate a solid Probetext (row 2 lane, for row 1), so there ditto none Error.
4. Item runs everything fehlerfrei, if I The The above-mentioned row with Window Title entkommentiere. on the Prozessorauslastun can it however not lying, because füge I instead of of Window Title Sleep one, so crashes the code ditto ex.
the were now four ways, this Error To bypass. still has someone a Idea, Why it at all appears? Each this four Solutions (except Perhaps number 3) ought to really quite no bearing and have still prevent tappt im dunkeln whom Programmabsturz.
Dietmar what about me are with unserem Latein end, still Perhaps see 46 eyes More as 4. 
it verbleibt ratlos
Nico Madysa |
| | | | | | |
| | | | | | - Page 2 - |
| |  | One XProfan11-String exists from 2 Longs and the bytes. Erstes Long is a Zählerwert (of Delphi manages) and Second The String-Length. The function addr gives but not The Stringadresse back, separate shows on the first Bytes in the string, shows means on The address+8.
CompileMarkSeparation
for Api-Params to lpz reicht The direct address on Bytes+z. 
the example shows too a with the dynamic Stringspeicherverwaltung coherent Problemfall. |
| | | | | | |
| | 
Frank
Abbing |
must one The GlobalAllocs really just as move How Profan-reaches, means to the schema area# = Long&, or need those for a suitable Style?
with whom ? Happen?, The You chosen have, erhälst You fixen memory. for verschiebbaren must You $42 gewenden. to that move can you then GlobalReAlloc use.
I yourself work only with fixen Save. The works something faster, and one erlebt none ungewollten Überraschungen. |
| | | | | | |
| |
Nico
Madysa | iF, Beitrag=53192, Zeitpunkt=12.07.2009
The function addr gives but not The Stringadresse back, separate shows on the first Bytes in the string, shows means on The address+8.
naturally does tappt im dunkeln the. The APIs -- and this special entrapment The List view-Messages -- interested itself namely none for these Verwaltungslongints, separate for Puffer. where exists now konkret the Difference, whether I this with Addr(Text$) and len(Text$) or with area# and SizeOf(area#) bereitstelle?
EDIT:
@Frank: of it have I already red, but I was I do not sure, how far M$ this "moveable" edge. them can means too new Adressen allocate? The Win32.hlp schweigt itself above from and means only, with GlobalReAlloc can properties and Size changed go. |
| | | | | | |
| |
Frank
Abbing |
them can means too new Adressen allocate? The Win32.hlp schweigt itself above from and means only, with GlobalReAlloc can properties and Size changed go.
The address will Change must, if the new Size not any more into ursprünglichen Puffer fit. whether the too so durchgezogen becomes or a Error Message outputted becomes, must You yourself testing, because I - How said - GlobalAlloc only with festem memory use. |
| | | | | | |
| | 
Dieter
Zornow | So I have it time probiert, the example in the Aaahen coming have I abgeändert and It's all right by me correct. hope the depends not the Betriebsystem together.
CompileMarkSeparation |
| | | | Er ist ein Mann wie ein Baum. Sie nennen ihn Bonsai., Win 7 32 bit und Win 7 64 bit, mit XProfan X2 | 07/13/09 ▲ |
| | |
| |
Dieter
Zornow | | functions not at me only with GlobalAlloc separate too with the undokumentierten DIM function, The Roland now preisgegeben has. as Exe and as PRF |
| | | | Er ist ein Mann wie ein Baum. Sie nennen ihn Bonsai., Win 7 32 bit und Win 7 64 bit, mit XProfan X2 | 07/13/09 ▲ |
| | |
| | 
RGH | iF, Beitrag=53192, Zeitpunkt=12.07.2009
the example shows too a with the dynamic Stringspeicherverwaltung coherent Problemfall.
the lying but not on the Speicherverwaltung XProfans, separate on it, How Delphi with Strings bypassing: One Leerstring occupied none memory and no memory has too no Aderesse.
the can to that Stumbling block go, if one a Leerstring with Addr(s$) on a API-function gives, without it before for a Nullbyte ("z") To strain.
Greeting Roland |
| | | | Intel Duo E8400 3,0 GHz / 4 GB RAM / 1000 GB HDD - ATI Radeon HD 4770 512 MB - Windows 7 Home Premium 32Bit - XProfan X4 | 07/13/09 ▲ |
| | |
| |
RGH | Nico Madysa, Beitrag=53176, Zeitpunkt=10.07.2009
the were now four ways, this Error To bypass. still has someone a Idea, Why it at all appears? Each this four Solutions (except Perhaps number 3) ought to really quite no bearing and have still prevent tappt im dunkeln whom Programmabsturz.
Hello Nico,
a derartige observation, that one Programmabsturz because of really right unsinniger Changes time results and times not, or it in the Interpreter goes and compiliert not or inverse, deutet oftmals hereon there, that it somewhere in the code a smaller ones injury of Speichergrenzen gives, The even sometimes to that Crash lead and sometimes random not, depending on what on the Speicherort, on whom fälchlicherweise written becomes, present is.
Dass it sometimes functions, deutet hereon there, that it a sooner smaller ones Grenzüberschreitung is and manchen Make hold even solely memory überschrieben becomes, the not used becomes or not protected is.
Greeting
Roland |
| | | | Intel Duo E8400 3,0 GHz / 4 GB RAM / 1000 GB HDD - ATI Radeon HD 4770 512 MB - Windows 7 Home Premium 32Bit - XProfan X4 | 07/13/09 ▲ |
| | |
| |
RGH | what about me have your Error found, Nico:
CompileMarkSeparationLVI#.IMASK&= $1
LVI#.ITEXT&= LVI#+36
LVI#.ITEXTMAX& = 200
LVI#.ISUBITEM& = 0pre>
here give You The address for To lesenden Text with LVI# + 36 on. The structure LVITEM is only 36 Bytes big, that is means, The address points the first byte to the structure. The Programmzeile, The whom Text ausliest, writes it naturally exakt there there. stupid only, that this one not geDIMter Speicherbereich is.
You could now naturally the structure LVITEM circa these 200 Bytes larger make (one Text#(200) append), or but yet plainer: You DIMensionierst B# to the produce the Strukturvariable LVI# and give B# directly as address for Text on. then sees the end the procedure LoadText so from:
CompileMarkSeparation<...>
Die Substrings jeder Zeile sind mit einem Semikolon getrennt
Set("ListDel",";")
Das Sortier-Listview wird ins Anzeigelistview übertragen
Aus einer Spalte werden zwei
Dim b#,200
var LVI# = New(LVITEM)
LVI#.IMASK&= $1
LVI#.ITEXT&= B#
LVI#.ITEXTMAX& = 200
LVI#.ISUBITEM& = 0
whileloop 0, Getcount(hSortDP&) -1
LVI#.ITEM& = &loop
u_SendMessageW(hSortDP&,$1073,&loop,LVI#)Text auslesen
d$ = Char$(b#,0,sizeof(b#))In Stringvariable schreiben
InsertStringW(hList&,d$,&loop)übertragen
EndWhile
Dispose LVI#
Dispose B#
... and everything runs round!
Greeting
Roland |
| | | | Intel Duo E8400 3,0 GHz / 4 GB RAM / 1000 GB HDD - ATI Radeon HD 4770 512 MB - Windows 7 Home Premium 32Bit - XProfan X4 | 07/13/09 ▲ |
| | |
| |
Dieter
Zornow | | Oh Yes correctly., I had the Nico said and thereby forget, that my Structur circa blanket 512 for Text extended is, therefore write and read I always directly behind the eigentliche Structur |
| | | | Er ist ein Mann wie ein Baum. Sie nennen ihn Bonsai., Win 7 32 bit und Win 7 64 bit, mit XProfan X2 | 07/13/09 ▲ |
| | |
| |
Nico
Madysa |  its over ands over again amazing, take off simple Solutions The seltsamsten Events having.
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&
Def GlobalAlloc(2) !"KERNEL32","GlobalAlloc"
Def GlobalFree(1) !"KERNEL32","GlobalFree"
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
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$,palloc&
var LVI# = New(LVITEM)
var d$ = UTF(Get("ListDel"))
With LVI#
.IMASK&=$1
.ITEM& = index%
whileloop len(s$,d$)
ss$ = SubStr$(s$,&loop,d$) + "zz"
palloc& = GlobalAlloc($40,len(ss$))
Char palloc&,0 = ss$
.iText& = palloc&
.ITEXTMAX& = len(ss$)
.ISUBITEM& = &loop - 1
ifnot &loop - 1
u_SendMessageW(pList&,$104D,index%,LVI#)
else
u_SendMessageW(pList&,$104C,index%,LVI#)
endif
GlobalFree(palloc&)
EndWhile
EndWith
endproc
proc LoadText
parameters d$
case d$ = "" : return
declare b#,t$,tt$ , a$
Die CSV-Datei wird eingelesen
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
a$ = SubStr$(d$,&loop+1,"x0Dzx0Az") DIES IST DIE BETROFFENE ZEILE
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
Dim b#,100
var LVI# = New(LVITEM)
LVI#.IMASK&= $1
LVI#.ITEXT&= b#
LVI#.ITEXTMAX& = 200
LVI#.ISUBITEM& = 0
Bereich freimachen
whileloop 0, Getcount(hSort&) -1
LVI#.ITEM& = &loop
clear b#
u_SendMessageW(hSort&,$1073,&loop,LVI#) Text auslesen
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,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
FreeDLL hUser&
FreeDLL hGDI&
FreeDLL hKrnl&
DeleteObject font&
end
thanks you all for eure patience and Help. |
| | | | | | |
| | 
Dietmar
Horn | thanks all aide for Hilfestellung(en)!
The to that Breakthrough führende Info coming of Roland.
The Rest is now presumably solely yet stupide and zeitaufwändige Fleißarbeit.
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/15/09 ▲ |
| | |
|
AnswerThemeninformationenthis Topic has 7 subscriber: |
(449)
Deutsch
English
Français
Español
Italia