Forum | | | | | 
Jörg
Sellmeyer | who can me these procedure to ASM paraphrase?
Proc MakeNumArr
If Between(%pcount,3,5)
Parameters AnzX%,AnzY%,Size%,edge%,Abst%
Var posx% = edge%
Var PosY% = edge%
Declare worth$
WhileLoop 0,AnzX% * AnzY% - 1
worth$ = worth$ + Str $(posx%) + "|" + Str $(posy%) + "|"
Inc Posx%, (size% + Abst%)
Ifnot (&Loop + 1) Mod (AnzX%)
Posx% = edge%
Inc posy%,size% + Abst%
worth$ = Del$(worth$,Len(worth$),1)
worth$ = worth$ + "\n"
EndIf
Wend
worth$ = Del$(worth$,Len(worth$),1)
Return worth$
ElseIf %pcount = 6
Parameters AnzX%,AnzY%,Size%,edge%,Abst%
Declare tmp%,Arr&[]
Var posx% = edge%
Var PosY% = edge%
WhileLoop 0,AnzX% * AnzY% - 1
Arr&[&Loop * 2] = PosX%
Arr&[(&Loop * 2) + 1] = PosY%
Inc Posx%, (size% + Abst%)
Ifnot (&Loop + 1) Mod (AnzX%)
Posx% = edge%
Inc posy%,size% + Abst%
EndIf
Wend
Return Arr&[]
Else
Return "Error!"
EndIf
ENDPROC
Declare Test&[]
Print MakeNumArr(4,3,96,4,10)
Test&[] = MakeNumArr(4,3,96,4,10,1)
Print
WhileLoop 0,SizeOf(Test&[])-1
Print Test&[&Loop],
Wend
WaitInput
End
|
| | | | Windows XP SP2 XProfan X4... und hier mal was ganz anderes als Profan ...  | 05/22/18 ▲ |
| | |
| | 
Michael
W. | Machbarkeits-investigation, not tested
Proc MakeNumArr
If Between(%pcount,3,5)
Parameters AnzX%,AnzY%,Size%,edge%,Abst%
Var posx% = edge%
Var PosY% = edge%
Declare worth$
WhileLoop 0,AnzX% * AnzY% - 1
worth$ = worth$ + Str$(posx%) + "|" + Str$(posy%) + "|"
Inc Posx%, (size% + Abst%)
Ifnot (&Loop + 1) Mod (AnzX%)
Posx% = edge%
Inc posy%,size% + Abst%
worth$ = Del$(worth$,Len(worth$),1)
worth$ = worth$ + "\n"
EndIf
Wend
worth$ = Del$(worth$,Len(worth$),1)
Return worth$
ElseIf %pcount = 6
Parameters AnzX%,AnzY%,Size%,edge%,Abst%
Declare tmp%,Arr&[]
Var posx% = edge%
Var PosY% = edge%
WhileLoop 0,AnzX% * AnzY% - 1
Arr&[&Loop * 2] = PosX%
Arr&[(&Loop * 2) + 1] = PosY%
Inc Posx%, (size% + Abst%)
Ifnot (&Loop + 1) Mod (AnzX%)
Posx% = edge%
Inc posy%,size% + Abst%
EndIf
Wend
Return Arr&[]
Else
Return "Error!"
EndIf
ENDPROC
Declare Test&[]
Print MakeNumArr(4,3,96,4,10)
Test&[] = MakeNumArr(4,3,96,4,10,1)
Print
WhileLoop 0,SizeOf(Test&[])-1
Print Test&[&Loop],
Wend
WaitInput
End
The first request sounds on 3 To 5 Parameter, then follows but Parameters with 5 Parameters.
The second request expects 6 Parameter, its but here Parameters with 5 Parameters indicated.
the erschließt itself I do not.
on the 2. look are the 2 different functions. means each for itself treat. String and ASM is frickelig.
Proc MakeNumArr_alt
Parameters AnzX%,AnzY%,Size%,edge%,Abst%
Declare tmp%,Arr&[]
Var posx% = edge%
Var PosY% = edge%
WhileLoop 0,AnzX% * AnzY% - 1
Arr&[&Loop * 2] = PosX%
Arr&[(&Loop * 2) + 1] = PosY%
Inc Posx%, (size% + Abst%)
Ifnot (&Loop + 1) Mod (AnzX%) 'worth mod x; remainder if > X; negiert means: only perform, as long as under X
Posx% = edge%
Inc posy%,size% + Abst%
EndIf
Wend
Return Arr&[]
ENDPROC
Proc MakeNumArr
Parameters AnzX%,AnzY%,Size%,edge%,Abst%
Declare Arr&[]
Var posx% = edge%
Var PosY% = edge%
var schleifenende% = AnzX% * AnzY% - 1 '- AnzX, AnzY only oberhalb the Loop
var groesse% = size% + Abst% '- size + Abst always
var ArrSize = schleifenende% * 2 + 1
SetSize Arr&[], ArrSize
ASM,"MakeNumArr_intern",7
JMP Start
gr:
DD 0
ra:
DD 0
a_x:
DD 0
x:
DD 0
y:
DD 0
Start:
MOV EBX, PAR1 'schleifenende% -- EBX
MOV EAX, PAR2 'groesse%
MOV [gr], EAX
MOV EAX, PAR3 'edge%
MOV [ra], EAX
MOV EAX, PAR7 'AnzX%
MOV [a_x], EAX
MOV EAX, PAR4 'adr x
MOV [x], EAX
MOV EAX, PAR5 'adr y
MOV [y], EAX
MOV EDI, PAR6 'adr Arr -- EDI
XOR ECX, ECX '&loop
DEC ECX
schleife:
INC ECX
CMP ECX, EBX 'on schleifenende Verify
JA end
MOV EDX, ECX
SHL EDX, 1 'Loop * 2
MOV ESI, [y]
MOV EAX, [ESI]
MOV [EDI + EDX + 4], EAX 'Arr&[(&Loop * 2) + 1] = PosY%
MOV ESI, [x]
MOV EAX, [ESI]
MOV [EDI + EDX], EAX 'Arr&[&Loop * 2] = PosX%
MOV EDX, [gr]
ADD EAX, EDX
MOV [ESI], EAX ' x + groesse
XOR EDX, EDX
MOV EAX, ECX
INC EAX
PUSH EBX
;-- Mist, AnzX overlooking
MOV EBX, [a_x]
DIV EBX 'remainder in EDX
POP EBX
CMP EDX, 0
JE schleife 'if IF not carryed out go should
' otherwise inside the IF
MOV ESI, [x]
MOV EAX, [ra]
MOV [ESI], EAX 'Posx% = edge%
MOV ESI, [y]
MOV EAX, [gr]
ADD [ESI], EAX
jmp schleife
end:
ENDASM
MakeNumArr_intern( schleifenende%, groesse%, edge%, addr(posx%), addr(PosY%), addr(Arr&[]), AnzX% )
Return Arr&[]
ENDPROC
If the direct aray-grabbed not working, then simply self memory reservieren and subsequently umkopieren.
here once more The mem.inc - without Objects.
The point-spelling have I to maintain.
' ought to really ex XProfan 10 walk
$IFNDEF FALSE
$DEFINE FALSE
DEF %NULL 0
DEF %FALSE 0
DEF %TRUE 1
$ENDIF 'FALSE
$IFNDEF MEM_ALLOC
$DEFINE MEM_ALLOC
Declare MEM_ALLOC_HANDLE1&
Declare MEM_ALLOC_HANDLE2&
Declare Mem.Error%
Proc MEM_ALLOC_START
MEM_ALLOC_HANDLE1& = UseDLL("KERNEL32.DLL")
MEM_ALLOC_HANDLE2& = UseDLL("ole32.dll")
ImportFunc( MEM_ALLOC_HANDLE1&, "GetLastError", "GetLastError" ) // GetLastError( )
ImportFunc( MEM_ALLOC_HANDLE1&, "GlobalAlloc", "GlobalAlloc" ) // GlobalAlloc( flags, Size )
ImportFunc( MEM_ALLOC_HANDLE1&, "GlobalFree", "GlobalFree" ) // GlobalFree( hMem )
ImportFunc( MEM_ALLOC_HANDLE1&, "GlobalHandle", "GlobalHandle" ) // GlobalHandle( pMem )
ImportFunc( MEM_ALLOC_HANDLE1&, "GlobalLock", "GlobalLock" ) // GlobalLock( hMem )
ImportFunc( MEM_ALLOC_HANDLE1&, "GlobalReAlloc", "GlobalReAlloc" ) // GlobalReAlloc( hMem, Size, flags )
ImportFunc( MEM_ALLOC_HANDLE1&, "GlobalSize", "GlobalSize" ) // GlobalSize( hMem )
ImportFunc( MEM_ALLOC_HANDLE1&, "GlobalUnlock", "GlobalUnlock" ) // GlobalUnlock( hMem )
ImportFunc( MEM_ALLOC_HANDLE1&, "RtlFillMemory", "FillMemory" ) // FillMemory( pDest, Len, Char )
ImportFunc( MEM_ALLOC_HANDLE1&, "RtlMoveMemory", "MoveMemory" ) // MoveMemory( pDest, pSrc, Len ) // Overlap erlaubt; slow
ImportFunc( MEM_ALLOC_HANDLE1&, "RtlZeroMemory", "ZeroMemory" ) // ZeroMemory( pDest, Len )
ImportFunc( MEM_ALLOC_HANDLE2&, "CoTaskMemAlloc", "Ole32_Dim" ) // Ole32_Dim(1)
ImportFunc( MEM_ALLOC_HANDLE2&, "CoTaskMemRealloc", "Ole32_ReDim" ) // Ole32_ReDim(2)
ImportFunc( MEM_ALLOC_HANDLE2&, "CoTaskMemFree", "Ole32_Dispose" ) // Ole32_Dispose(1)
ENDPROC
Proc MEM_ALLOC_END
Case MEM_ALLOC_HANDLE1& : FreeDLL MEM_ALLOC_HANDLE1&
Case MEM_ALLOC_HANDLE2& : FreeDLL MEM_ALLOC_HANDLE2&
ENDPROC
/* I n H A L T
Mem.CAlloc( Elemente&, ElementSize& )
- Speicherblöcke occupy/reservieren
reserved "items" time "Elementgröße" Bytes as Speicherplatz and supply whom Speicherzeiger as Return Value (or 0 with Error).
The memory is already with nobodies initialized.
Result: Speicherzeiger or 0
Mem.New( Size& )
- memory occupy/reservieren
reserved "Size" Bytes Speicherplatz and supply whom Speicherzeiger as Return Value (or 0 with Error).
The memory is already with nobodies initialized.
Result: Speicherzeiger or 0
Mem.Resize( pMem&, Size& )
- Speichergröße Change/redimensionieren
Ändert The Speichergröße on The the Speicherzeiger shows.
The Size the angegebenen Speicherbereiches becomes on the new Size changed (if mismatched).
with of/ one enhancement the Bereiches stay any data receive,
with of/ one Verkleinerung only the vordere part. (!!!without Gewähr!!!)
Result: supply whom new Speicherzeiger back.
Mem.Free( pMem& [,pMem& ...] )
- memory enable (too several reaches zugleich)
gives whom Speicherbereich on the the Speicherzeiger shows again spare.
it can several Parameter to that Edit indicated go.
Result: Size the freigegebenen reaches
Mem.Clear( pMem& [,pMem& ...] )
- memory with nobodies überschreiben
The angegebene (entire) Speicherbereich is with binären nobodies überschrieben.
for a Teilfüllung is Mem.Fill() To benefit.
it can several Parameter to that Edit indicated go.
Result: Number of bearbeiteten reaches
Mem.Fill( pMem& [,Anzahl& [,FüllChars$]] )
- memory with a characters fill
is amount = 0 then becomes amount on Mem.Size(pMem) staid.
The angegebene Speicherbereich is with Füllzeichen aufgefüllt.
without Füllzeichen is with Chr$(0) aufgefüllt.
with one characters becomes Kernel32.FillMemory() used
with several characters becomes Kernel32.MoveMemory() used
Result: supply True, if memory filled watts
Mem.Move( Ziel&, Quelle& [,Anzahl&] )
- Speicherinhalte copy
The angegebene Quellbereich becomes into Zielbereich copies.
Result: supply True, if memory copies watts
Mem.Size( pMem& )
- Size the belegten Speichers detect
determined The Speichergröße on The the Speicherzeiger shows.
Result: supply The Size the Bereiches back.
Mem.OleNew( Size& )
- OLE-memory occupy/reservieren
reserved "Size" Bytes Speicherplatz and supply whom Speicherzeiger as Return Value.
is "Size" small as 1, then becomes it on 1 staid.
Result: Speicherzeiger
Mem.OleResize( pMem&, Size& )
- Speichergröße Change/redimensionieren
Ändert The Speichergröße on The the Speicherzeiger shows.
The Size the angegebenen Speicherbereiches becomes on the new Size changed.
with of/ one enhancement the Bereiches stay any data receive,
with of/ one Verkleinerung only the vordere part. (!!!without Gewähr!!!)
Result: supply whom new Speicherzeiger back.
Mem.OleFree( pMem& [,pMem& ...] )
- memory enable (too several reaches zugleich)
gives whom Speicherbereich on the the Speicherzeiger shows again spare.
it can several Parameter to that Edit indicated go.
Result: Boolean; release watts implemented
Mem.OleClear( pMem&, Size& )
- memory with nobodies überschreiben
The angegebene (entire) Speicherbereich is with binären nobodies überschrieben.
for a Teilfüllung is Mem.Fill() To benefit.
Result: Boolean; Überschreiben with nobodies implemented
Mem.OleFill( pMem&, Anzahl& [,FüllChars$]] )
- memory with a characters fill
The angegebene Speicherbereich is with Füllzeichen aufgefüllt.
without Füllzeichen is with Chr$(0) aufgefüllt.
with one characters becomes Kernel32.FillMemory() used
with several characters becomes Kernel32.MoveMemory() used
Result: supply True, if memory filled watts
Mem.OleMove( Ziel&, Quelle&, Anzahl& )
- Speicherinhalte copy
The angegebene Quellbereich becomes into Zielbereich copies.
Result: supply True, if memory copies watts
Syntax: I n H A L T
Ptr& = Mem.CAlloc( nElem&, elSize& )
Ptr& = Mem.New( Size& ) -- Mem.Dim(), Mem.Malloc()
Ptr& = Mem.Resize( OldPtr&, NewSize& ) -- Mem.ReDim(), Mem.Realloc()
sz& = Mem.Free( [[Ptr1&],...] ) -- Mem.Dispose()
cnt& = Mem.Clear( [[Ptr1&],...] )
OK% = Mem.Fill( pMem& [,Anzahl& [,FüllChars$]] )
OK% = Mem.Move( Ziel&, Quelle& [,Anzahl&] ) - Mem.copy()
Siz& = Mem.Size( Ptr& ) -- Mem.SizeOf()
Ptr& = Mem.OleNew( Size& ) -- Mem.OleDim()
Ptr& = Mem.OleResize( OldPtr&, NewSize& ) -- Mem.OleReDim()
OK% = Mem.OleFree( [[Ptr1&],...] ) -- Mem.OleDispose()
OK% = Mem.OleClear( Ptr&, Size& )
OK% = Mem.OleFill( pMem&, Anzahl& [,FüllChars$]] )
OK% = Mem.OleMove( Ziel&, Quelle&, Size& ) -- Mem.OleCopy()
*/
/* *************************************
Mem.CAlloc( Elemente&, ElementSize& )
- Speicherblöcke occupy/reservieren
reserved "items" time "Elementgröße" Bytes as Speicherplatz and supply whom Speicherzeiger as Return Value (or 0 with Error).
The memory is already with nobodies initialized.
Result: Speicherzeiger or 0
*/
Proc Mem.CAlloc
Parameters nElem&, elSize&
Declare Size&
If (nElem& = 0) or (elSize& = 0)
Size& = 1
Else
Size& = nElem& * elSize&
EndIf
Return Mem.New( Size& )
ENDPROC
/* *************************************
Mem.New( Size& )
- memory occupy/reservieren
reserved "Size" Bytes Speicherplatz and supply whom Speicherzeiger as Return Value (or 0 with Error).
The memory is already with nobodies initialized.
Result: Speicherzeiger or 0
*/
Proc Mem.New
Parameters Size&
Declare pMem&, hMem&, flage&
Mem.Error% = %TRUE
Case Size& < 1 : Return %NULL
flags& = $42 '~GMEM_MOVEABLE $2 | ~GMEM_ZEROINIT $40 '$42 (automatically with zero initialisieren)
hMem& = GlobalAlloc( flags&, Size& )
Casenote hMem& : Return %NULL ' not enough memory
pMem& = GlobalLock( hMem& )
Casenote pMem& : Return %NULL ' not enough memory
Mem.Error% = %FALSE
Return pMem&
ENDPROC
Proc Mem.Dim
Parameters Size&
Return Mem.New( Size& )
ENDPROC
Proc Mem.Malloc
Parameters Size&
Return Mem.New( Size& )
ENDPROC
/* *************************************
Mem.Resize( pMem&, Size& )
- Speichergröße Change/redimensionieren
Ändert The Speichergröße on The the Speicherzeiger shows.
The Size the angegebenen Speicherbereiches becomes on the new Size changed (if mismatched).
with of/ one enhancement the Bereiches stay any data receive,
with of/ one Verkleinerung only the vordere part. (!!!without Gewähr!!!)
Result: supply whom new Speicherzeiger back.
*/
Proc Mem.Resize
Parameters pMem&, Size&
Declare hMem&, OldSize&, e&
Mem.Error% = %FALSE
If pMem& ' --- Size Change ---
hMem& = GlobalHandle( pMem& )
Casenote hMem& : Mem.Error% = GetLastError()
If hMem&
OldSize& = GlobalSize( hMem& )
Casenote OldSize& : Mem.Error% = GetLastError()
If OldSize& <> Size&
GlobalUnlock( hMem& )
hMem& = GlobalReAlloc( hMem&, Size&, $2 ) '~GMEM_MOVEABLE $2
Casenote hMem& : Mem.Error% = GetLastError()
If hMem&
pMem& = GlobalLock( hMem& )
Casenote pMem& : Mem.Error% = GetLastError()
EndIf
EndIf
EndIf
Else ' --- memory new lay out ---
pMem& = Mem.New( Size& )
EndIf
Return pMem&
ENDPROC
Proc Mem.ReDim
Parameters pMem&, Size&
Return Mem.Resize( pMem&, Size& )
ENDPROC
Proc Mem.Realloc
Parameters pMem&, Size&
Return Mem.Resize( pMem&, Size& )
ENDPROC
/* *************************************
Mem.Free( pMem& [,pMem& ...] )
- memory enable (too several reaches zugleich)
gives whom Speicherbereich on the the Speicherzeiger shows again spare.
it can several Parameter to that Edit indicated go.
Result: Size the freigegebenen reaches
*/
Proc Mem.Free
Declare PC&, pMem&, hMem&, size&, e&, cnt&
cnt& = 0
PC& = %PCount
Mem.Error% = %FALSE
WhileLoop 1, PC&
pMem& = @&(&loop)
If pMem&
size& = Mem.Size( pMem& )
hMem& = GlobalHandle( pMem& )
Casenote hMem& : Mem.Error% = GetLastError()
If hMem&
e& = GlobalUnlock( hMem& )
Casenote e& : Mem.Error% = GetLastError()
If e&
e& = GlobalFree( hMem& )
Casenote e& : Mem.Error% = GetLastError()
If e&
Inc cnt&, size&
EndIf
EndIf
EndIf
EndIf
EndWhile
Return cnt&
ENDPROC
Proc Mem.Dispose 'here then only a area enable, otherwise Please Mem.Free benefit
Parameters pMem&
Return Mem.Free( pMem& )
ENDPROC
/* *************************************
Mem.Clear( pMem& [,pMem& ...] )
- memory with nobodies überschreiben
The angegebene (entire) Speicherbereich is with binären nobodies überschrieben.
for a Teilfüllung is Mem.Fill() To benefit.
it can several Parameter to that Edit indicated go.
Result: Number of bearbeiteten reaches
*/
Proc Mem.Clear
Declare PC&, pMem&, size&, cnt&
cnt = 0
PC& = %PCount
Mem.Error% = %FALSE
WhileLoop 1, PC&
pMem& = @&(&loop)
If pMem&
size& = Mem.Size( pMem& )
If size&
ZeroMemory( pMem&, size& )
Inc cnt&
EndIf
EndIf
EndWhile
Return cnt&
ENDPROC
/* *************************************
Mem.Fill( pMem& [,Anzahl& [,FüllChars$]] )
- memory with a characters fill
is amount = 0 then becomes amount on Mem.Size(pMem) staid.
The angegebene Speicherbereich is with Füllzeichen aufgefüllt.
without Füllzeichen is with Chr$(0) aufgefüllt.
with one characters becomes Kernel32.FillMemory() used
with several characters becomes Kernel32.MoveMemory() used
Result: supply True, if memory filled watts
*/
Proc Mem.Fill
Declare pMem&, pFill&, Anzahl&, Count&, PC&, LFill&, Erg%
PC& = %PCount
Erg% = %FALSE
Mem.Error% = %FALSE
Select PC&
CaseOf 1
Parameters pMem1&
pMem& = pMem1&
Casenote pMem& : Return %FALSE
Anzahl& = Mem.Size( pMem& )
If Anzahl& > 0
FillMemory( pMem&, Anzahl&, LFill& )
Erg% = %TRUE
EndIf
CaseOf 2
Parameters pMem2&, amount2&
pMem = pMem2
Casenote pMem& : Return %FALSE
Count& = Mem.Size( pMem& )
Anzahl& = if( amount2& > Count&, Count&, amount2& )
If Anzahl& > 0
FillMemory( pMem&, Anzahl&, LFill& )
Erg% = %TRUE
EndIf
CaseOf 3
Parameters pMem3&, amount3&, FillChars$
pMem& = pMem3&
Casenote pMem& : Return %FALSE
Count& = Mem.Size( pMem& )
Anzahl& = if( amount3& > Count&, Count&, amount3& )
Case Anzahl& < 1 : Return %FALSE
Count& = Len( FillChars$ )
Erg% = %TRUE
If Count& < 2
Case Count& = 1 : LFill& = Ord( FillChars$ )
FillMemory( pMem&, Anzahl&, LFill& )
Else
pFill& = Addr( FillChars$ )
While Anzahl& > 0
Case Count& > Anzahl& : Count& = Anzahl&
MoveMemory( pMem&, pFill&, Count& )
Inc pMem&, Count&
Dec Anzahl&, Count&
EndWhile
EndIf
EndSelect
Return Erg%
ENDPROC
/* *************************************
Mem.Move( Ziel&, Quelle& [,Anzahl&] )
- Speicherinhalte copy
The angegebene Quellbereich becomes into Zielbereich copies.
Result: supply True, if memory copies watts
*/
Proc Mem.Move
Declare pZiel&, zLen&, pQuelle&, qLen&, Anzahl&, PC&
PC& = %PCount
Mem.Error% = %FALSE
If PC& = 2
Parameters pZiel2&, pQuelle2&
pZiel& = pZiel2&
pQuelle& = pQuelle2&
ElseIf PC& = 3
Parameters pZiel3&, pQuelle3&, amount3&
pZiel& = pZiel3&
pQuelle& = pQuelle3&
Anzahl& = amount3&
EndIf
Case (pZiel& = 0) or (pQuelle& = 0) : Return %FALSE
zLen& = Mem.Size( pZiel& )
qLen& = Mem.Size( pQuelle& )
Case zLen& < qLen& : qLen& = zLen&
Casenote qLen& : Return %FALSE
Case (Anzahl& < 1) or (Anzahl& > qLen&) : Anzahl& = qLen&
MoveMemory( pZiel&, pQuelle&, Anzahl& )
Return %TRUE
ENDPROC
Proc Mem.copy
Parameters pZiel&, pQuelle&, Anzahl&
Return Mem.Move( pZiel&, pQuelle&, Anzahl& )
ENDPROC
/* *************************************
Mem.Size( pMem& )
- Size the belegten Speichers detect
determined The Speichergröße on The the Speicherzeiger shows.
Result: supply The Size the Bereiches back.
*/
Proc Mem.Size
Parameters pMem&
Declare hMem&, Size&
Size& = 0
Mem.Error% = %FALSE
Casenote pMem& : Return Size&
hMem& = GlobalHandle( pMem& )
Casenote hMem& : GetLastError()
If hMem&
size& = GlobalSize( hMem& )
Casenote size& : Mem.Error% = GetLastError()
EndIf
Return size&
ENDPROC
Proc Mem.SizeOf
Parameters pMem&
Return Mem.Size( pMem& )
ENDPROC
/* *************************************
Mem.OleNew( Size& )
- OLE-memory occupy/reservieren
reserved "Size" Bytes Speicherplatz and supply whom Speicherzeiger as Return Value.
is "Size" small as 1, then becomes it on 1 staid.
Result: Speicherzeiger
*/
Proc Mem.OleNew
Parameters Size&
Mem.Error% = %FALSE
Return Ole32_Dim( Size& )
ENDPROC
Proc Mem.OleDim
Parameters Size&
Case Size& < 1 : Size& = 1
Return Mem.OleNew( Size& )
ENDPROC
/* *************************************
Mem.OleResize( pMem&, Size& )
- Speichergröße Change/redimensionieren
Ändert The Speichergröße on The the Speicherzeiger shows.
The Size the angegebenen Speicherbereiches becomes on the new Size changed.
with of/ one enhancement the Bereiches stay any data receive,
with of/ one Verkleinerung only the vordere part. (!!!without Gewähr!!!)
Result: supply whom new Speicherzeiger back.
*/
Proc Mem.OleResize
Parameters Ptr&, Size&
Casenote Ptr& : Return Mem.OleNew( Size& )
Case Size& < 1 : Size& = 1
Return Ole32_ReDim( Ptr&, Size& )
ENDPROC
Proc Mem.OleReDim
Parameters Ptr&, Size&
Return Mem.OleResize( Ptr&, Size& )
ENDPROC
/* *************************************
Mem.OleFree( pMem& [,pMem& ...] )
- memory enable (too several reaches zugleich)
gives whom Speicherbereich on the the Speicherzeiger shows again spare.
it can several Parameter to that Edit indicated go.
Result: Boolean; release watts implemented
*/
Proc Mem.OleFree
Declare PC%, pMem&
PC% = %PCount
Case PC% < 1 : Return %FALSE
WhileLoop PC%
pMem& = @&(&loop)
Case pMem& : Ole32_Dispose(pMem&)
EndWhile
Return %TRUE
ENDPROC
Proc Mem.OleDispose
Declare PC%, pMem&
PC% = %PCount
Case PC% < 1 : Return %FALSE
WhileLoop PC%
pMem& = @&(&loop)
Case pMem& : Ole32_Dispose(pMem&)
EndWhile
Return %TRUE
ENDPROC
/* *************************************
Mem.OleClear( pMem&, Size& )
- memory with nobodies überschreiben
The angegebene (entire) Speicherbereich is with binären nobodies überschrieben.
for a Teilfüllung is Mem.Fill() To benefit.
Result: Boolean; Überschreiben with nobodies implemented
*/
Proc Mem.OleClear
Parameters Ptr&, Size&
Mem.Error% = %TRUE
Case (Ptr& = 0) or (Size& < 1) : Return %FALSE
Mem.Error% = %FALSE
ZeroMemory( Ptr&, Size& )
Return %TRUE
ENDPROC
/* *************************************
Mem.OleFill( pMem&, Anzahl& [,FüllChars$]] )
- memory with a characters fill
The angegebene Speicherbereich is with Füllzeichen aufgefüllt.
without Füllzeichen is with Chr$(0) aufgefüllt.
with one characters becomes Kernel32.FillMemory() used
with several characters becomes Kernel32.MoveMemory() used
Result: supply True, if memory filled watts
*/
Proc Mem.OleFill
Declare pMem&, pFill&, Anzahl&, Count&, PC&, LFill&, Erg%
PC& = %PCount
Erg% = %FALSE
Mem.Error% = %FALSE
Select PC&
CaseOf 2
Parameters pMem2&, amount2&
pMem = pMem2
Casenote pMem& : Return %FALSE
Anzahl& = amount2&
If Anzahl& > 0
FillMemory( pMem&, Anzahl&, LFill& )
Erg% = %TRUE
EndIf
CaseOf 3
Parameters pMem3&, amount3&, FillChars$
pMem& = pMem3&
Casenote pMem& : Return %FALSE
Anzahl& = amount3&
Case Anzahl& < 1 : Return %FALSE
Count& = Len( FillChars$ )
Erg% = %TRUE
If Count& < 2
Case Count& = 1 : LFill& = Ord( FillChars$ )
FillMemory( pMem&, Anzahl&, LFill& )
Else
pFill& = Addr( FillChars$ )
While Anzahl& > 0
Case Count& > Anzahl& : Count& = Anzahl&
MoveMemory( pMem&, pFill&, Count& )
Inc pMem&, Count&
Dec Anzahl&, Count&
EndWhile
EndIf
Otherwise
Mem.Error% = %FRUE
EndSelect
Return Erg%
ENDPROC
/* *************************************
Mem.OleMove( Ziel&, Quelle&, Anzahl& )
- Speicherinhalte copy
The angegebene Quellbereich becomes into Zielbereich copies.
Result: supply True, if memory copies watts
*/
Proc Mem.OleMove
Parameters pZiel&, pQuelle&, Anzahl&
Case (pZiel& = 0) or (pQuelle& = 0) or (Anzahl& < 1) : Return %FALSE
MoveMemory( pZiel&, pQuelle&, Anzahl& )
Return %TRUE
ENDPROC
Proc Mem.OleCopy
Parameters pZiel&, pQuelle&, Anzahl&
Return Mem.OleMove( pZiel&, pQuelle&, Anzahl& )
ENDPROC
$ENDIF 'MEM_ALLOC
|
| | | | | | |
| |
Jörg
Sellmeyer | Hello Michael,
thanks, that You you time so befasst have. in the Grunde need I in the whole Wust only The eigentliche Loop as ASM.
the sähe then so from:
'only these procedure as ASM
Proc MakeNumArray
Parameters AnzX%,AnzY%,Size%,edge%,Abst%,FunkAdd&
Declare tmp%,B#,BSize&
BSize& = AnzX% * AnzY% * 4
Dim B#,BSize&
Var posx% = edge%
Var PosY% = edge%
WhileLoop 0,(BSize& - 8),8
Long B#,&Loop,PosX%
Long B#,(&Loop + 4), PosY%
'idealerweise yet with nem optionalen Funktionsaufruf
'though I there yet none white, How I then on whom
'Return Value the function come should
If FunkAdd& > 0
'here then a address of/ one Profanfunktion, if the goes
'Call(FunkAdd&,posx%,posy%,size%,size%)
MakeButton(posx%,posy%,size%,size%)
EndIf
Inc Posx%, (size% + Abst%)
Ifnot (tmp% + 1) Mod (AnzX%)
Posx% = edge%
Inc posy%,size% + Abst%
EndIf
Inc tmp%
Wend
Return B#
ENDPROC
Proc MakeButton
Parameters x%,y%,b%,h%
Var Text$ = "Positionen" + Str $(x%) + "," + Str $(y%)
Var hdl& = Create("Button",%hwnd,Text$,x%,y%,b%,h%)
SetStyle hdl&,GetStyle(hdl&) | $2000'~BS_MULTILINE
Return hdl&
ENDPROC
Randomize
Var h& = Create("Font","Western",14,0,0,0,0)
SetDialogFont h&
Declare area#,AnzX%,AnzY%,gr%,edge%,abst%
gr% = 56
rand% = 40
abst% = 10
Window Style 24
'Window 10,10 - (((Rnd(16) + 10) * (gr% + Abst%)) + (edge% * 2)+4),(((Rnd(5) + 10) * (gr% + Abst%)) + (edge% * 2)+4)
Window 700,500
Var func& = ProcAddr("MakeButton",4)
Anzx% = (gr% + Abst%)
AnzX% = (Width(%hwnd) - (edge% * 2) + Abst%) \ Anzx%
Anzy% = (gr% + Abst%)
Anzy% = (Height(%hwnd) - (edge% * 2) + Abst%) \ Anzy%
AnzY% = AnzY% * 2'n1 * 2 because it pairs of Values are what about me only The Number of Objects indicate wants
Dim area#,AnzX%*AnzY%*4
Var Tick& = &GetTickcount
Bereich# = MakeNumArray(AnzX%,AnzY%,gr%,edge%,abst%,func&)
Print &GettickCount - Tick&
'WhileLoop 0,SizeOf(area#)-8,8
' Print Long(area#,& Loop),
' Print Long(area#,& Loop+4),
'Wend
Locate 1,1
While 1
WaitInput
If Upper $(ClassOf(%getfocus)) = "BUTTON"
Case %mousepressed:Print ItemID(%getfocus),
EndIf
Wend
to the Funktionsparametern supra:
The first part becomes carryed out, if The Parameterzahl 3-5 is. with 3 are edge% and stood off% then 0. with 4 is only stood off 0.
with 6 Parameters, becomes the second part called. The 6. Parameter is then quasi only the Flag and can discretionary his. |
| | | | Windows XP SP2 XProfan X4... und hier mal was ganz anderes als Profan ... | 05/28/18 ▲ |
| | |
| |
Michael
W. | 'Call(FunkAdd&,posx%,posy%,size%,size%)
PUSH size%
PUSH size%
PUSH posy%
PUSH posx%
MOV EBX, FunkAdd&
CALL [EBX]
POP EAX ;Funktionsergebnis
naturally everything on Umwegen. Roland having moreover too one Posting staid. find it now The speedy not.
there was a direct Profan-routine angesprungen been. but over ProcAddr get You The address. there can then too a solid Parameteranzahl chosen go. double can incidentally intern. |
| | | | System: Windows 8/10, XProfan X4
Programmieren, das spannendste Detektivspiel der Welt. | 05/29/18 ▲ |
| | |
| |  | [offtopic]must me absolutely News XProfan (X4?) in silence standing! ASM without Additional tools is super. there would too time again XPSE-Update cool for "natives Profan" (nProfan) by XProfan-Inline-ASM.[/offtopic] |
| | | | | | |
| |
Michael
W. | [OFFTOPIC]@iF:  [/OFFTOPIC]
'only these procedure as ASM
appeal:
MakeNumArray( AnzX%, AnzY%, Size%, edge%, Abst%, ProcAddr("MakeButton",4) )
Proc MakeNumArray
Parameters AnzX%,AnzY%,Size%,edge%,Abst%,FunkAdr&
Declare B#,BSize&
BSize& = AnzX% * AnzY% * 4
Dim B#,BSize&
Var posx% = edge%
Var PosY% = edge%
'intern definiert erspare I me whom construction the Speichers
ASM "MakeNumArr_a",?
// Par1 = Addr(B#) - address the Speicherstarts
// Par2 = Addr(PosX%) - worth should changed go, means as address
// Par3 = Addr(PosY%) - worth should changed go, means as address
// Par4 = Schleifenende - reiner worth, the remaining here in EBX for speedy comparison
// Par5 = AnzX - direct worth Save
// Par6 = AnzY - direct worth Save
// Par7 = Size - direct worth Save
// Par8 = edge - direct worth Save
// Par9 = Abst - direct worth Save
// Par10 = FunkAdd& - ProcAddr("MakeButton",4)
JMP Start
pPosX: DD 0
pPosY: DD 0
vAnzX: DD 0
vAnzY: DD 0
vSize: DD 0
vRand: DD 0
vAbst: DD 0
vSuA: DD 0
vTMP: DD 0
Start:
MOV EDI, Par1 // aray - EDI
MOV EAX, PAR2 // Addr(PosX%)
MOV [pPosX], EAX
MOV EAX, PAR3 // Addr(PosY%)
MOV [pPosY], EAX
MOV EBX, Par4 'Schleifenende -- EBX
MOV EAX, Par5 // AnzX%
MOV [vAnzX], EAX
MOV EAX, Par6 // AnzY%
MOV [vAnzY], EAX
MOV EAX, Par7 // Size%
MOV [vSize], EAX
MOV EDX, EAX // Size + ...
MOV EAX, Par8 // edge%
MOV [vRand], EAX
MOV EAX, Par9 // Abst%
MOV [vAbst], EAX
ADD EDX, EAX // ... + Abst
MOV [vSuA], EDX // The amount to the Loop form
MOV EDX, Par10 // Funktionsadresse or zero
// at last example watts supra counted,
// the happens now at Indexzugriff.
// here becomes same the Schleifenende examined
XOR ECX, ECX
MOV [vTMP], ECX // as a precaution too TMP on zero settle
schleife: // WhileLoop 0,(BSize& - 8),8
CMP ECX, EBX // on schleifenende Verify
JA end // if larger, then out (with same means another Durchlauf)
MOV ESI, [pPosX] // Zeiger fetch
MOV EAX, [ESI] // Variableninhalt PosX to EAX
MOV [EDI + ECX], EAX // Long B#,&Loop = PosX%
ADD ECX, 4
MOV ESI, [pPosY] // Zeiger fetch
MOV EAX, [ESI] // Variableninhalt PosY to EAX
MOV [EDI + ECX], EAX // Long B#,(&Loop + 4), PosY%
ADD ECX, 4
// --- If FunkAdr& > 0
XOR EAX, EAX // there something with Funktionsergebnis employed becomes, here Vorgabewert
CMP EDX, 0
JZ No_Func
// Parameter backward on the pile
MOV EAX, [vSize] // Value
PUSH EAX
PUSH EAX
MOV ESI, [pPosY] // Zeiger
MOV EAX, [ESI] // Content
PUSH EAX
MOV ESI, [pPosX] // Zeiger
MOV EAX, [ESI] // Content
PUSH EAX
CALL [EDX]
No_Func:
// here can EAX ausgewertet go
// --- EndIf
PUSH EDX // whom Funktionszeiger secure
MOV ESI, [pPosX] // Zeiger fetch
MOV EAX, [ESI] // Variableninhalt PosX to EAX
MOV EDX, [vSuA] // The amount of (Size+Abst)
ADD EAX, EDX // PosX + (Size+Abst)
MOV [ESI], EAX // worth write back
XOR EDX, EDX
MOV EAX, [vTMP]
INC EAX
PUSH EBX // Schleifenende secure
MOV EBX, [vAnzX]
DIV EBX // is: EDX:EAX / EBX = worth in EAX, remainder standing in EDX
POP EBX // Schleifenende restaurieren
CMP EDX, 0
JE over_IF
// --- If-Part
MOV ESI, [pPosX] // Zeiger fetch // Posx% = edge%
MOV EAX, [vRand]
MOV [ESI], EAX // worth write back
MOV ESI, [pPosY] // Zeiger fetch // Inc posy%,size% + Abst%
MOV EAX, [ESI] // Variableninhalt PosY to EAX
MOV EDX, [vSuA] // The amount of (Size+Abst)
ADD EAX, EDX // PosY + (Size+Abst)
MOV [ESI], EAX // worth write back
// --- EndIf
over_IF:
MOV EAX, [vTMP]
INC EAX
MOV [vTMP], EAX
// or INC [vTMP] ??? (rather on number sure)
POP EDX // whom Funktionszeiger restaurieren
JMP schleife
end:
EndASM
MakeNumArr_a( Addr(B#), Addr(PosX%), Addr(PosY%), (BSize& - 8), AnzX%, AnzY%, Size%, edge%, Abst%, FunkAdr& )
Return B#
ENDPROC
my god, when have I the lastly so in detail comments. might me saponaceous again on it gewöhnen.  |
| | | | System: Windows 8/10, XProfan X4
Programmieren, das spannendste Detektivspiel der Welt. | 05/29/18 ▲ |
| | |
| |
Jörg
Sellmeyer | | Uff - there must I first durchackern. ASM is for me still so How chinesisch. but now Have I time quasi ne Translation of my own Codes. there can I what with begin. Vielen Thanks! |
| | | | | | |
|
AnswerThemeninformationenthis Topic has 3 subscriber: |
(506)
Deutsch
English
Français
Español
Italia