XProfan

Michael
W.

Machbarkeits-Studie, nicht getestet


Proc MakeNumArr
    If Between(%pcount,3,5)
        Parameters AnzX%,AnzY%,Size%,Rand%,Abst%
        Var posx% = Rand%
        Var PosY% = Rand%
        Declare Wert$

        WhileLoop 0,AnzX% * AnzY% - 1
            Wert$ = Wert$ + Str$(posx%) + "|" + Str$(posy%) + "|"
            Inc Posx%, (size% + Abst%)

            IfNot (&Loop + 1) Mod (AnzX%)
                Posx% = Rand%
                Inc posy%,size% + Abst%
                Wert$ = Del$(Wert$,Len(Wert$),1)
                Wert$ = Wert$ + "\n"
            EndIf
        Wend

        Wert$ = Del$(Wert$,Len(Wert$),1)
        Return Wert$

    ElseIf %pcount = 6

        Parameters AnzX%,AnzY%,Size%,Rand%,Abst%
        Declare tmp%,Arr&[]
        Var posx% = Rand%
        Var PosY% = Rand%

        WhileLoop 0,AnzX% * AnzY% - 1
            Arr&[&Loop * 2] = PosX%
            Arr&[(&Loop * 2) + 1] = PosY%
            Inc Posx%, (size% + Abst%)

            IfNot (&Loop + 1) Mod (AnzX%)
                Posx% = Rand%
                Inc posy%,size% + Abst%
            EndIf

        Wend
        Return Arr&[]

    Else
        Return "Fehler!"
    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


Die erste Abfrage lautet auf 3 bis 5 Parameter, dann folgt aber Parameters mit 5 Parametern.
Die zweite Abfrage erwartet 6 Parameter, es ist aber auch hier Parameters mit 5 Parametern angegeben.
Das erschließt sich mir nicht.
Auf den 2. Blick sind das 2 verschiedene Funktionen. Also jede für sich behandeln. String und ASM ist frickelig.

Proc MakeNumArr_alt
        Parameters AnzX%,AnzY%,Size%,Rand%,Abst%
        Declare tmp%,Arr&[]
        Var posx% = Rand%
        Var PosY% = Rand%

        WhileLoop 0,AnzX% * AnzY% - 1
            Arr&[&Loop * 2] = PosX%
            Arr&[(&Loop * 2) + 1] = PosY%
            Inc Posx%, (size% + Abst%)

            IfNot (&Loop + 1) Mod (AnzX%)  'wert mod x; Rest wenn > X; negiert also: nur ausführen, solange unter X
                Posx% = Rand%
                Inc posy%,size% + Abst%
            EndIf

        Wend
        Return Arr&[]
EndProc


Proc MakeNumArr
   Parameters AnzX%,AnzY%,Size%,Rand%,Abst%
   Declare Arr&[]

   Var posx% = Rand%
   Var PosY% = Rand%

   var schleifenende% = AnzX% * AnzY% - 1   '- AnzX, AnzY nur oberhalb der Schleife
   var groesse% = size% + Abst%   '- size + Abst immer

   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   'Rand%
      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    'auf schleifenende prüfen
      JA   Ende

      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 übersehen
      MOV  EBX, [a_x]
      DIV  EBX		'remainder in EDX
      POP  EBX

      CMP  EDX, 0
      JE   schleife   'wenn IF nicht ausgeführt werden soll
                      ' sonst innerhalb des IF
      
      MOV  ESI, [x]
      MOV  EAX, [ra]
      MOV  [ESI], EAX   'Posx% = Rand%
      MOV  ESI, [y]
      MOV  EAX, [gr]
      ADD  [ESI], EAX
      jmp  schleife

Ende:
   ENDASM

   MakeNumArr_intern( schleifenende%, groesse%, Rand%, addr(posx%), addr(PosY%), addr(Arr&[]),  AnzX% )

   Return Arr&[]
EndProc

Wenn der direkte Array-Zugriff nicht funzt, dann einfach selbst Speicher reservieren und anschließend umkopieren.

Hier noch mal die mem.inc - ohne Objekte.
Die Punkt-Schreibweise habe ich beibehalten.


' sollte eigentlich ab XProfan 10 laufen

$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 )  // Überlappung erlaubt; langsam
   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 belegen/reservieren
        Reserviert "Elemente" mal "Elementgröße" Bytes als Speicherplatz und liefert den Speicherzeiger als Rückgabewert (oder 0 bei Fehler).
        Der Speicher ist bereits mit Nullen initialisiert.
        Ergebnis: Speicherzeiger oder 0
   Mem.New( Size& )
      - Speicher belegen/reservieren
        Reserviert "Size" Bytes Speicherplatz und liefert den Speicherzeiger als Rückgabewert (oder 0 bei Fehler).
        Der Speicher ist bereits mit Nullen initialisiert.
        Ergebnis: Speicherzeiger oder 0
   Mem.Resize( pMem&, Size& )
      - Speichergröße ändern/redimensionieren
        Ändert die Speichergröße auf die der Speicherzeiger zeigt.
        Die Größe des angegebenen Speicherbereiches wird auf die neue Größe geändert (wenn ungleich).
        Bei einer Vergrößerung des Bereiches bleiben alle Daten erhalten,
        bei einer Verkleinerung nur der vordere Teil. (!!!ohne Gewähr!!!)
        Ergebnis: Liefert den neuen Speicherzeiger zurück.
   Mem.Free( pMem& [,pMem& ...] )
      - Speicher freigeben (auch mehrere Bereiche zugleich)
        Gibt den Speicherbereich auf den der Speicherzeiger zeigt wieder frei.
        Es können mehrere Parameter zum Bearbeiten angegeben werden.
        Ergebnis: Größe der freigegebenen Bereiche
   Mem.Clear( pMem& [,pMem& ...] )
      - Speicher mit Nullen überschreiben
        Der angegebene (gesamte) Speicherbereich wird mit binären Nullen überschrieben.
        Für eine Teilfüllung ist Mem.Fill() zu nutzen.
        Es können mehrere Parameter zum Bearbeiten angegeben werden.
        Ergebnis: Anzahl der bearbeiteten Bereiche
   Mem.Fill( pMem& [,Anzahl& [,FüllChars$]] )
      - Speicher mit einem Zeichen füllen
        Ist Anzahl = 0 dann wird Anzahl auf Mem.Size(pMem) gesetzt.
        Der angegebene Speicherbereich wird mit Füllzeichen aufgefüllt.
        Ohne Füllzeichen wird mit Chr$(0) aufgefüllt.
        Bei einem Zeichen wird Kernel32.FillMemory() genutzt
        Bei mehreren Zeichen wird Kernel32.MoveMemory() genutzt
        Ergebnis: Liefert True, wenn Speicher gefüllt wurde
   Mem.Move( Ziel&, Quelle& [,Anzahl&] )
      - Speicherinhalte kopieren
        Der angegebene Quellbereich wird in den Zielbereich kopiert.
        Ergebnis: Liefert True, wenn Speicher kopiert wurde
   Mem.Size( pMem& )
      - Größe des belegten Speichers ermitteln
        Ermittelt die Speichergröße auf die der Speicherzeiger zeigt.
        Ergebnis: Liefert die Größe des Bereiches zurück.

   Mem.OleNew( Size& )
      - OLE-Speicher belegen/reservieren
        Reserviert "Size" Bytes Speicherplatz und liefert den Speicherzeiger als Rückgabewert.
        Ist "Size" kleiner als 1, dann wird er auf 1 gesetzt.
        Ergebnis: Speicherzeiger
   Mem.OleResize( pMem&, Size& )
      - Speichergröße ändern/redimensionieren
        Ändert die Speichergröße auf die der Speicherzeiger zeigt.
        Die Größe des angegebenen Speicherbereiches wird auf die neue Größe geändert.
        Bei einer Vergrößerung des Bereiches bleiben alle Daten erhalten,
        bei einer Verkleinerung nur der vordere Teil. (!!!ohne Gewähr!!!)
        Ergebnis: Liefert den neuen Speicherzeiger zurück.
   Mem.OleFree( pMem& [,pMem& ...] )
      - Speicher freigeben (auch mehrere Bereiche zugleich)
        Gibt den Speicherbereich auf den der Speicherzeiger zeigt wieder frei.
        Es können mehrere Parameter zum Bearbeiten angegeben werden.
        Ergebnis: Boolean; Freigabe wurde durchgeführt
   Mem.OleClear( pMem&, Size& )
      - Speicher mit Nullen überschreiben
        Der angegebene (gesamte) Speicherbereich wird mit binären Nullen überschrieben.
        Für eine Teilfüllung ist Mem.Fill() zu nutzen.
        Ergebnis: Boolean; Überschreiben mit Nullen durchgeführt
   Mem.OleFill( pMem&, Anzahl& [,FüllChars$]] )
      - Speicher mit einem Zeichen füllen
        Der angegebene Speicherbereich wird mit Füllzeichen aufgefüllt.
        Ohne Füllzeichen wird mit Chr$(0) aufgefüllt.
        Bei einem Zeichen wird Kernel32.FillMemory() genutzt
        Bei mehreren Zeichen wird Kernel32.MoveMemory() genutzt
        Ergebnis: Liefert True, wenn Speicher gefüllt wurde
   Mem.OleMove( Ziel&, Quelle&, Anzahl& )
      - Speicherinhalte kopieren
        Der angegebene Quellbereich wird in den Zielbereich kopiert.
        Ergebnis: Liefert True, wenn Speicher kopiert wurde


 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 belegen/reservieren
        Reserviert "Elemente" mal "Elementgröße" Bytes als Speicherplatz und liefert den Speicherzeiger als Rückgabewert (oder 0 bei Fehler).
        Der Speicher ist bereits mit Nullen initialisiert.
        Ergebnis: Speicherzeiger oder 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& )
      - Speicher belegen/reservieren
        Reserviert "Size" Bytes Speicherplatz und liefert den Speicherzeiger als Rückgabewert (oder 0 bei Fehler).
        Der Speicher ist bereits mit Nullen initialisiert.
        Ergebnis: Speicherzeiger oder 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   (automatisch mit Null initialisieren)
   hMem& = GlobalAlloc( flags&, Size& )

   CaseNot hMem& : Return %NULL   ' nicht genug Speicher

   pMem& = GlobalLock( hMem& )
   CaseNot pMem& : Return %NULL   ' nicht genug Speicher

   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 ändern/redimensionieren
        Ändert die Speichergröße auf die der Speicherzeiger zeigt.
        Die Größe des angegebenen Speicherbereiches wird auf die neue Größe geändert (wenn ungleich).
        Bei einer Vergrößerung des Bereiches bleiben alle Daten erhalten,
        bei einer Verkleinerung nur der vordere Teil. (!!!ohne Gewähr!!!)
        Ergebnis: Liefert den neuen Speicherzeiger zurück.
*/
Proc Mem.Resize
   Parameters pMem&, Size&
   Declare hMem&, OldSize&, e&
   Mem.Error% = %FALSE
   If pMem&   ' --- Größe ändern ---
      hMem& = GlobalHandle( pMem& )
      CaseNot hMem& : Mem.Error% = GetLastError()
      If hMem&
         OldSize& = GlobalSize( hMem& )
         CaseNot OldSize& : Mem.Error% = GetLastError()
         If OldSize& <> Size&
            GlobalUnlock( hMem& )
            hMem& = GlobalReAlloc( hMem&, Size&, $2 )   '~GMEM_MOVEABLE $2
            CaseNot hMem& : Mem.Error% = GetLastError()
            If hMem&
               pMem& = GlobalLock( hMem& )
               CaseNot pMem& : Mem.Error% = GetLastError()
            EndIf
         EndIf
      EndIf
   Else   ' --- Speicher neu anlegen ---
      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& ...] )
      - Speicher freigeben (auch mehrere Bereiche zugleich)
        Gibt den Speicherbereich auf den der Speicherzeiger zeigt wieder frei.
        Es können mehrere Parameter zum Bearbeiten angegeben werden.
        Ergebnis: Größe der freigegebenen Bereiche
*/
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& )
         CaseNot hMem& : Mem.Error% = GetLastError()
         If hMem&
            e& = GlobalUnlock( hMem& )
            CaseNot e& : Mem.Error% = GetLastError()
            If e&
               e& = GlobalFree( hMem& )
               CaseNot e& : Mem.Error% = GetLastError()
               If e&
                  Inc cnt&, size&
               EndIf
            EndIf
         EndIf
      EndIf
   EndWhile
   Return cnt&
EndProc
Proc Mem.Dispose   'hier dann nur einen Bereich freigeben, sonst bitte Mem.Free nutzen
   Parameters pMem&
   Return Mem.Free( pMem& )
EndProc


/* *************************************
   Mem.Clear( pMem& [,pMem& ...] )
      - Speicher mit Nullen überschreiben
        Der angegebene (gesamte) Speicherbereich wird mit binären Nullen überschrieben.
        Für eine Teilfüllung ist Mem.Fill() zu nutzen.
        Es können mehrere Parameter zum Bearbeiten angegeben werden.
        Ergebnis: Anzahl der bearbeiteten Bereiche
*/
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$]] )
      - Speicher mit einem Zeichen füllen
        Ist Anzahl = 0 dann wird Anzahl auf Mem.Size(pMem) gesetzt.
        Der angegebene Speicherbereich wird mit Füllzeichen aufgefüllt.
        Ohne Füllzeichen wird mit Chr$(0) aufgefüllt.
        Bei einem Zeichen wird Kernel32.FillMemory() genutzt
        Bei mehreren Zeichen wird Kernel32.MoveMemory() genutzt
        Ergebnis: Liefert True, wenn Speicher gefüllt wurde
*/
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&
         CaseNot pMem& : Return %FALSE
         Anzahl& = Mem.Size( pMem& )
         If Anzahl& > 0
            FillMemory( pMem&, Anzahl&, LFill& )
            Erg% = %TRUE
         EndIf
      CaseOf 2
         Parameters pMem2&, Anzahl2&
         pMem = pMem2
         CaseNot pMem& : Return %FALSE
         Count& = Mem.Size( pMem& )
         Anzahl& = if( Anzahl2& > Count&, Count&, Anzahl2& )
         If Anzahl& > 0
            FillMemory( pMem&, Anzahl&, LFill& )
            Erg% = %TRUE
         EndIf
      CaseOf 3
         Parameters pMem3&, Anzahl3&, FillChars$
         pMem& = pMem3&
         CaseNot pMem& : Return %FALSE
         Count& = Mem.Size( pMem& )
         Anzahl& = if( Anzahl3& > Count&, Count&, Anzahl3& )
         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 kopieren
        Der angegebene Quellbereich wird in den Zielbereich kopiert.
        Ergebnis: Liefert True, wenn Speicher kopiert wurde
*/
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&, Anzahl3&
      pZiel& = pZiel3&
      pQuelle& = pQuelle3&
      Anzahl& = Anzahl3&
   EndIf
   Case (pZiel& = 0) or (pQuelle& = 0) : Return %FALSE
   zLen& = Mem.Size( pZiel& )
   qLen& = Mem.Size( pQuelle& )
   Case zLen& < qLen& : qLen& = zLen&
   CaseNot 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& )
      - Größe des belegten Speichers ermitteln
        Ermittelt die Speichergröße auf die der Speicherzeiger zeigt.
        Ergebnis: Liefert die Größe des Bereiches zurück.
*/
Proc Mem.Size
   Parameters pMem&
   Declare hMem&, Size&
   Size& = 0
   Mem.Error% = %FALSE
   CaseNot pMem& : Return Size&
   hMem& = GlobalHandle( pMem& )
   CaseNot hMem& : GetLastError()
   If hMem&
      size& = GlobalSize( hMem& )
      CaseNot size& : Mem.Error% = GetLastError()
   EndIf
   Return size&
EndProc
Proc Mem.SizeOf
   Parameters pMem&
   Return Mem.Size( pMem& )
EndProc


/* *************************************
   Mem.OleNew( Size& )
      - OLE-Speicher belegen/reservieren
        Reserviert "Size" Bytes Speicherplatz und liefert den Speicherzeiger als Rückgabewert.
        Ist "Size" kleiner als 1, dann wird er auf 1 gesetzt.
        Ergebnis: 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 ändern/redimensionieren
        Ändert die Speichergröße auf die der Speicherzeiger zeigt.
        Die Größe des angegebenen Speicherbereiches wird auf die neue Größe geändert.
        Bei einer Vergrößerung des Bereiches bleiben alle Daten erhalten,
        bei einer Verkleinerung nur der vordere Teil. (!!!ohne Gewähr!!!)
        Ergebnis: Liefert den neuen Speicherzeiger zurück.
*/
Proc Mem.OleResize
   Parameters Ptr&, Size&
   CaseNot 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& ...] )
      - Speicher freigeben (auch mehrere Bereiche zugleich)
        Gibt den Speicherbereich auf den der Speicherzeiger zeigt wieder frei.
        Es können mehrere Parameter zum Bearbeiten angegeben werden.
        Ergebnis: Boolean; Freigabe wurde durchgeführt
*/
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& )
      - Speicher mit Nullen überschreiben
        Der angegebene (gesamte) Speicherbereich wird mit binären Nullen überschrieben.
        Für eine Teilfüllung ist Mem.Fill() zu nutzen.
        Ergebnis: Boolean; Überschreiben mit Nullen durchgeführt
*/
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$]] )
      - Speicher mit einem Zeichen füllen
        Der angegebene Speicherbereich wird mit Füllzeichen aufgefüllt.
        Ohne Füllzeichen wird mit Chr$(0) aufgefüllt.
        Bei einem Zeichen wird Kernel32.FillMemory() genutzt
        Bei mehreren Zeichen wird Kernel32.MoveMemory() genutzt
        Ergebnis: Liefert True, wenn Speicher gefüllt wurde
*/
Proc Mem.OleFill
   Declare pMem&, pFill&, Anzahl&, Count&, PC&, LFill&, Erg%
   PC& = %PCount
   Erg% = %FALSE
   Mem.Error% = %FALSE
   Select PC&
      CaseOf 2
         Parameters pMem2&, Anzahl2&
         pMem = pMem2
         CaseNot pMem& : Return %FALSE
         Anzahl& = Anzahl2&
         If Anzahl& > 0
            FillMemory( pMem&, Anzahl&, LFill& )
            Erg% = %TRUE
         EndIf
      CaseOf 3
         Parameters pMem3&, Anzahl3&, FillChars$
         pMem& = pMem3&
         CaseNot pMem& : Return %FALSE
         Anzahl& = Anzahl3&
         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 kopieren
        Der angegebene Quellbereich wird in den Zielbereich kopiert.
        Ergebnis: Liefert True, wenn Speicher kopiert wurde
*/
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

Alle Sprachen
System: Windows 8/10, XProfan X4
Programmieren, das spannendste Detektivspiel der Welt.

27.05.2018 ▲

Jörg
Sellmeyer

Hallo Michael,

danke, dass du dich mal damit befasst hast. Im Grunde brauche ich in dem ganzen Wust nur die eigentliche Schleife als ASM.

Das sähe dann so aus:

'nur diese Prozedur als ASM

Proc MakeNumArray

    Parameters AnzX%,AnzY%,Size%,Rand%,Abst%,FunkAdd&
    Declare tmp%,B#,BSize&
    BSize& = AnzX% * AnzY% * 4
    Dim B#,BSize&
    Var posx% = Rand%
    Var PosY% = Rand%

    WhileLoop 0,(BSize& - 8),8

        Long B#,&Loop,PosX%
        Long B#,(&Loop + 4), PosY%
        'idealerweise noch mit nem optionalen Funktionsaufruf
        'obwohl ich da noch gar nicht weiß, wie ich dann an den
        'Rückgabewert der Funktion kommen soll

        If FunkAdd& > 0

            'Hier dann eine Adresse einer Profanfunktion, wenn das geht
            'Call(FunkAdd&,posx%,posy%,size%,size%)
            MakeButton(posx%,posy%,size%,size%)

        EndIf

        Inc Posx%, (size% + Abst%)

        IfNot (tmp% + 1) Mod (AnzX%)

            Posx% = Rand%
            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 Bereich#,AnzX%,AnzY%,gr%,rand%,abst%
gr% = 56
rand% = 40
abst% = 10
WindowStyle 24
'Window 10,10 - (((Rnd(16) + 10) * (gr% + Abst%)) + (rand% * 2)+4),(((Rnd(5) + 10) * (gr% + Abst%)) + (rand% * 2)+4)
Window 700,500
Var func& = ProcAddr("MakeButton",4)
Anzx% = (gr% + Abst%)
AnzX% =  (Width(%hwnd) - (rand% * 2) + Abst%) \ Anzx%
Anzy% = (gr% + Abst%)
Anzy% =  (Height(%hwnd) - (rand% * 2) + Abst%) \ Anzy%
AnzY% = AnzY% *  2'n1 * 2 weil es Paare von Werten sind und ich nur die Anzahl der Objekte angeben will
Dim Bereich#,AnzX%*AnzY%*4
Var Tick& = &GetTickcount
Bereich# = MakeNumArray(AnzX%,AnzY%,gr%,rand%,abst%,func&)
Print &GettickCount - Tick&
'WhileLoop 0,SizeOf(Bereich#)-8,8
'  Print Long(Bereich#,&Loop),
'  Print Long(Bereich#,&Loop+4),
'Wend
Locate 1,1

While 1

    WaitInput

    If Upper$(ClassOf(%getfocus)) = "BUTTON"

        Case %mousepressed:Print ItemID(%getfocus),

    EndIf

Wend

Zu den Funktionsparametern oben:
Der erste Teil wird ausgeführt, wenn die Parameterzahl 3-5 ist. Bei 3 sind Rand% und Abstand% dann 0. Bei 4 ist nur Abstand 0.
Bei 6 Parametern, wird der zweite Teil aufgerufen. Der 6. Parameter ist dann quasi nur das Flag und kann beliebig sein.

Windows XP SP2 XProfan X4
... und hier mal was ganz anderes als Profan ...

28.05.2018 ▲

Michael
W.

'Call(FunkAdd&,posx%,posy%,size%,size%)

PUSH size%
PUSH size%
PUSH posy%
PUSH posx%
MOV EBX, FunkAdd&
CALL [EBX]
POP EAX ;Funktionsergebnis

Natürlich alles auf Umwegen. Roland hatte dazu auch ein Posting gesetzt. Finde es jetzt auf die Schnelle nicht.
Dort war eine direkte Profan-Routine angesprungen worden. Aber über ProcAddr bekommst Du die Adresse. Dort kann dann auch eine feste Parameteranzahl gewählt werden. Verdoppeln kann man übrigens intern.

System: Windows 8/10, XProfan X4
Programmieren, das spannendste Detektivspiel der Welt.

29.05.2018 ▲

Infinity-Profan
WinXP, SP3, Core(TM) i7-3770 @ 3.40GHz

[offtopic]Muss mir unbedingt aktuelles XProfan (X4?) in Ruhe ansehen! ASM ohne Zusatztools ist super. Da wäre auch mal wieder ein XPSE-Update toll für "natives Profan" (nProfan) per XProfan-Inline-ASM.[/offtopic]

29.05.2018 ▲

Michael
W.

[OFFTOPIC]@iF:

[/OFFTOPIC]

'nur diese Prozedur als ASM

Aufruf:
MakeNumArray( AnzX%, AnzY%, Size%, Rand%, Abst%, ProcAddr("MakeButton",4) )

Proc MakeNumArray
    Parameters AnzX%,AnzY%,Size%,Rand%,Abst%,FunkAdr&
    Declare B#,BSize&
    BSize& = AnzX% * AnzY% * 4
    Dim B#,BSize&
    Var posx% = Rand%
    Var PosY% = Rand%

    'intern definiert erspare ich mir den Aufbau des Speichers
    ASM "MakeNumArr_a",?
       // Par1  = Addr(B#)      - Adresse des Speicherstarts
       // Par2  = Addr(PosX%)   - Wert soll geändert werden, also als Adresse
       // Par3  = Addr(PosY%)   - Wert soll geändert werden, also als Adresse
       // Par4  = Schleifenende - reiner Wert, der bleibt hier in EBX für schnellen Vergleich
       // Par5  = AnzX          - direkten Wert speichern
       // Par6  = AnzY          - direkten Wert speichern
       // Par7  = Size          - direkten Wert speichern
       // Par8  = Rand          - direkten Wert speichern
       // Par9  = Abst          - direkten Wert speichern
       // 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  // Array - 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  // Rand%
       MOV  [vRand], EAX
       MOV  EAX, Par9  // Abst%
       MOV  [vAbst], EAX
       ADD  EDX, EAX   // ... + Abst
       MOV  [vSuA], EDX  // die Summe vor der Schleife bilden
       MOV  EDX, Par10  // Funktionsadresse oder Null

       // beim letzten Beispiel wurde oben gezählt, 
       // das geschieht jetzt beim Indexzugriff.
       // Hier wird gleich das Schleifenende geprüft
       XOR  ECX, ECX
       MOV  [vTMP], ECX  // sicherheitshalber auch TMP auf Null setzen
schleife:		//     WhileLoop 0,(BSize& - 8),8
       CMP  ECX, EBX    // auf schleifenende prüfen
       JA   Ende        // wenn größer, dann raus (bei gleich also noch ein Durchlauf)

       MOV  ESI, [pPosX]  // Zeiger holen
       MOV  EAX, [ESI]    // Variableninhalt PosX nach EAX
       MOV  [EDI + ECX], EAX   // Long B#,&Loop = PosX%
       ADD  ECX, 4

       MOV  ESI, [pPosY]  // Zeiger holen
       MOV  EAX, [ESI]    // Variableninhalt PosY nach EAX
       MOV  [EDI + ECX], EAX   // Long B#,(&Loop + 4), PosY%
       ADD  ECX, 4


       // --- If FunkAdr& > 0
       XOR  EAX, EAX  // da irgendwas mit Funktionsergebnis angestellt wird, hier ein Vorgabewert
       CMP  EDX, 0
       JZ   No_Func

       // Parameter rückwärts auf den Stapel
       MOV  EAX, [vSize]  // Value
       PUSH EAX
       PUSH EAX
       MOV  ESI, [pPosY]  // Zeiger
       MOV  EAX, [ESI]    // Inhalt
       PUSH EAX
       MOV  ESI, [pPosX]  // Zeiger
       MOV  EAX, [ESI]    // Inhalt
       PUSH EAX
       CALL [EDX]
No_Func:
       // hier kann EAX ausgewertet werden
       // --- EndIf


       PUSH EDX  // den Funktionszeiger sichern

       MOV  ESI, [pPosX]  // Zeiger holen
       MOV  EAX, [ESI]    // Variableninhalt PosX nach EAX
       MOV  EDX, [vSuA]  // die Summe von (Size+Abst)
       ADD  EAX, EDX     // PosX + (Size+Abst)
       MOV  [ESI], EAX   // Wert zurückschreiben


       XOR  EDX, EDX
       MOV  EAX, [vTMP]
       INC  EAX
       PUSH EBX     // Schleifenende sichern
       MOV  EBX, [vAnzX]
       DIV  EBX     // ist: EDX:EAX / EBX = wert in EAX, Rest steht in EDX
       POP  EBX     // Schleifenende restaurieren

       CMP  EDX, 0
       JE   over_IF


       // --- If-Part
       MOV  ESI, [pPosX]  // Zeiger holen   // Posx% = Rand%
       MOV  EAX, [vRand]
       MOV  [ESI], EAX   // Wert zurückschreiben

       MOV  ESI, [pPosY]  // Zeiger holen   // Inc posy%,size% + Abst%
       MOV  EAX, [ESI]    // Variableninhalt PosY nach EAX
       MOV  EDX, [vSuA]  // die Summe von (Size+Abst)
       ADD  EAX, EDX     // PosY + (Size+Abst)
       MOV  [ESI], EAX   // Wert zurückschreiben
       // --- EndIf


over_IF:
       MOV  EAX, [vTMP]
       INC  EAX
       MOV  [vTMP], EAX
// oder        INC [vTMP] ??? (lieber auf Nummer sicher)

       POP  EDX  // den Funktionszeiger restaurieren
       JMP  schleife

Ende:
    EndASM
    MakeNumArr_a( Addr(B#), Addr(PosX%), Addr(PosY%), (BSize& - 8), AnzX%, AnzY%, Size%, Rand%, Abst%, FunkAdr& )

    Return B#
EndProc

Mein Gott, wann habe ich das zuletzt so ausführlich kommentiert. Könnte mich glatt wieder daran gewöhnen.

System: Windows 8/10, XProfan X4
Programmieren, das spannendste Detektivspiel der Welt.

29.05.2018 ▲

Jörg
Sellmeyer

Uff - da muss ich mich erstmal durchackern. ASM ist für mich immer noch so wie chinesisch. Aber jetzt hab ich mal quasi ne Übersetzung meines eigenen Codes. Da kann ich was mit anfangen. Vielen Dank!

XProfan X3
Windows XP SP2 XProfan X4
... und hier mal was ganz anderes als Profan ...

30.05.2018 ▲