XProfan

Michael
W.

Machbarkeits-Studie, pas getestet


Proc MakeNumArr
    Si Between(%pcount,3,5)
        Paramètres AnzX%,AnzY%,Size%,rebord%,Abst%
        Var posx% = rebord%
        Var PosY% = rebord%
        Déclarer Wert$

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

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

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

    ElseIf %pcount = 6

        Paramètres AnzX%,AnzY%,Size%,rebord%,Abst%
        Déclarer tmp%,Arr&[]
        Var posx% = rebord%
        Var PosY% = rebord%

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

            Si non (&Loop + 1) Mod (AnzX%)
                Posx% = rebord%
                Inc posy%,size% + Abst%
            EndIf

        Wend
        Retour Arr&[]

    D'autre
        Retour "faute!"
    EndIf

ENDPROC

Déclarer Test&[]
Imprimer MakeNumArr(4,3,96,4,10)
Test&[] = MakeNumArr(4,3,96,4,10,1)
Imprimer

WhileLoop 0,SizeOf(Test&[])-1
    Imprimer Test&[&Loop],
Wend

WaitInput
Fin


la première Abfrage lautet sur 3 jusqu'à 5 paramètre, ensuite folgt mais Paramètres avec 5 Parametern.
qui zweite Abfrage erwartet 6 paramètre, c'est mais aussi ici Paramètres avec 5 Parametern angegeben.
cela erschließt sich Je ne.
sur den 2. perspective sommes cela 2 verschiedene Funktionen. alors chacun pour sich behandeln. String et ASM ist frickelig.

Proc MakeNumArr_alt
        Paramètres AnzX%,AnzY%,Size%,rebord%,Abst%
        Déclarer tmp%,Arr&[]
        Var posx% = rebord%
        Var PosY% = rebord%

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

            Si non (&Loop + 1) Mod (AnzX%)  'wert mod x; reste si > X; negiert alors: seulement effectuer, solange sous X
                Posx% = rebord%
                Inc posy%,size% + Abst%
            EndIf

        Wend
        Retour Arr&[]
ENDPROC


Proc MakeNumArr
   Paramètres AnzX%,AnzY%,Size%,rebord%,Abst%
   Déclarer Arr&[]

   Var posx% = rebord%
   Var PosY% = rebord%

   var schleifenende% = AnzX% * AnzY% - 1   '- AnzX, AnzY seulement au-dessus de qui Boucle
   var groesse% = size% + Abst%   '- size + Abst toujours

   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   'rebord%
      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    'sur schleifenende vérifier
      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 dans EDX
      POP  EBX

      CMP  EDX, 0
      JE   schleife   'si IF pas fonctionnement volonté soll
                      ' sonst dedans des IF
      
      MOV  ESI, [x]
      MOV  EAX, [ra]
      MOV  [ESI], EAX   'Posx% = rebord%
      MOV  ESI, [y]
      MOV  EAX, [gr]
      ADD  [ESI], EAX
      jmp  schleife

Ende:
   ENDASM

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

   Retour Arr&[]
ENDPROC

si qui directe Array-Zugriff pas funzt, ensuite simple selbst grenier reservieren et anschließend umkopieren.

ici encore fois le mem.inc - sans Objekte.
qui Punkt-Schreibweise habe je beibehalten.


' sollte eigentlich ab XProfan 10 courir

$IFNDEF FALSE
$DEFINE FALSE
DEF  %NULL   0
DEF  %FALSE  0
DEF  %TRUE   1
$ENDIF 'FALSE

$IFNDEF MEM_ALLOC
$DEFINE MEM_ALLOC
Déclarer MEM_ALLOC_HANDLE1&
Déclarer MEM_ALLOC_HANDLE2&
Déclarer 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; lente
   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
   Cas MEM_ALLOC_HANDLE1& : FreeDLL MEM_ALLOC_HANDLE1&
   Cas MEM_ALLOC_HANDLE2& : FreeDLL MEM_ALLOC_HANDLE2&
ENDPROC

/*     I  N  H  A  L  T
   Mem.CAlloc( Elemente&, ElementSize& )
      - Speicherblöcke belegen/reservieren
        Reserviert "Elemente" la fois "Elementgröße" Bytes comme Speicherplatz et liefert den Speicherzeiger comme Rückgabewert (ou bien 0 chez faute).
        qui grenier ist bereits avec Nullen initialisiert.
        Ergebnis: Speicherzeiger ou bien 0
   Mem.New( Size& )
      - grenier belegen/reservieren
        Reserviert "Size" Bytes Speicherplatz et liefert den Speicherzeiger comme Rückgabewert (ou bien 0 chez faute).
        qui grenier ist bereits avec Nullen initialisiert.
        Ergebnis: Speicherzeiger ou bien 0
   Mem.Resize( pMem&, Size& )
      - Speichergröße changement/redimensionieren
        Ändert qui Speichergröße sur qui qui Speicherzeiger zeigt.
        qui Taille des angegebenen Speicherbereiches wird sur qui neue Taille geändert (si ungleich).
        chez einer Vergrößerung des Bereiches rester alle données conservé,
        chez einer Verkleinerung seulement qui vordere partie. (!!!sans Gewähr!!!)
        Ergebnis: Liefert den neuen Speicherzeiger zurück.
   Mem.Free( pMem& [,pMem& ...] )
      - grenier freigeben (aussi plusieurs Bereiche zugleich)
        Gibt den Speicherbereich sur den qui Speicherzeiger zeigt wieder libre.
        Es peut plusieurs paramètre zum Travailler angegeben volonté.
        Ergebnis: Taille qui freigegebenen Bereiche
   Mem.Claire( pMem& [,pMem& ...] )
      - grenier avec Nullen überschreiben
        qui angegebene (gesamte) Speicherbereich wird avec binären Nullen überschrieben.
        Pour une Teilfüllung ist Mem.Fill() trop nutzen.
        Es peut plusieurs paramètre zum Travailler angegeben volonté.
        Ergebnis: Nombre de bearbeiteten Bereiche
   Mem.Fill( pMem& [,Anzahl& [,FüllChars$]] )
      - grenier avec einem marque füllen
        Ist Anzahl = 0 ensuite wird Anzahl sur Mem.Size(pMem) gesetzt.
        qui angegebene Speicherbereich wird avec Füllzeichen aufgefüllt.
        sans Füllzeichen wird avec Chr$(0) aufgefüllt.
        chez einem marque wird Kernel32.FillMemory() genutzt
        chez mehreren marque wird Kernel32.MoveMemory() genutzt
        Ergebnis: Liefert True, si grenier pleine wurde
   Mem.Move( Ziel&, Quelle& [,Anzahl&] )
      - Speicherinhalte kopieren
        qui angegebene Quellbereich wird dans den Zielbereich kopiert.
        Ergebnis: Liefert True, si grenier kopiert wurde
   Mem.Size( pMem& )
      - Taille des belegten Mémoire ermitteln
        Ermittelt qui Speichergröße sur qui qui Speicherzeiger zeigt.
        Ergebnis: Liefert qui Taille des Bereiches zurück.

   Mem.OleNew( Size& )
      - OLE-grenier belegen/reservieren
        Reserviert "Size" Bytes Speicherplatz et liefert den Speicherzeiger comme Rückgabewert.
        Ist "Size" kleiner comme 1, ensuite wird il sur 1 gesetzt.
        Ergebnis: Speicherzeiger
   Mem.OleResize( pMem&, Size& )
      - Speichergröße changement/redimensionieren
        Ändert qui Speichergröße sur qui qui Speicherzeiger zeigt.
        qui Taille des angegebenen Speicherbereiches wird sur qui neue Taille geändert.
        chez einer Vergrößerung des Bereiches rester alle données conservé,
        chez einer Verkleinerung seulement qui vordere partie. (!!!sans Gewähr!!!)
        Ergebnis: Liefert den neuen Speicherzeiger zurück.
   Mem.OleFree( pMem& [,pMem& ...] )
      - grenier freigeben (aussi plusieurs Bereiche zugleich)
        Gibt den Speicherbereich sur den qui Speicherzeiger zeigt wieder libre.
        Es peut plusieurs paramètre zum Travailler angegeben volonté.
        Ergebnis: Boolean; Freigabe wurde durchgeführt
   Mem.OleClear( pMem&, Size& )
      - grenier avec Nullen überschreiben
        qui angegebene (gesamte) Speicherbereich wird avec binären Nullen überschrieben.
        Pour une Teilfüllung ist Mem.Fill() trop nutzen.
        Ergebnis: Boolean; Überschreiben avec Nullen durchgeführt
   Mem.OleFill( pMem&, Anzahl& [,FüllChars$]] )
      - grenier avec einem marque füllen
        qui angegebene Speicherbereich wird avec Füllzeichen aufgefüllt.
        sans Füllzeichen wird avec Chr$(0) aufgefüllt.
        chez einem marque wird Kernel32.FillMemory() genutzt
        chez mehreren marque wird Kernel32.MoveMemory() genutzt
        Ergebnis: Liefert True, si grenier pleine wurde
   Mem.OleMove( Ziel&, Quelle&, Anzahl& )
      - Speicherinhalte kopieren
        qui angegebene Quellbereich wird dans den Zielbereich kopiert.
        Ergebnis: Liefert True, si grenier kopiert wurde


 Syntax:                    I N H A L T
    Ptr& = Mem.CAlloc( nElem&, elSize& )
    Ptr& = Mem.New( Size& ) 			-- Mem.Faible(), Mem.Malloc()
    Ptr& = Mem.Resize( OldPtr&, NewSize& )	-- Mem.ReDim(), Mem.Realloc()
     sz& = Mem.Free( [[Ptr1&],...] )		-- Mem.Dispose()
    cnt& = Mem.Claire( [[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" la fois "Elementgröße" Bytes comme Speicherplatz et liefert den Speicherzeiger comme Rückgabewert (ou bien 0 chez faute).
        qui grenier ist bereits avec Nullen initialisiert.
        Ergebnis: Speicherzeiger ou bien 0
*/
Proc Mem.CAlloc
   Paramètres nElem&, elSize&
   Déclarer Size&
   Si (nElem& = 0) or (elSize& = 0)
      Size& = 1
   D'autre
      Size& = nElem& * elSize&
   EndIf
   Retour Mem.New( Size& )
ENDPROC


/* *************************************
   Mem.New( Size& )
      - grenier belegen/reservieren
        Reserviert "Size" Bytes Speicherplatz et liefert den Speicherzeiger comme Rückgabewert (ou bien 0 chez faute).
        qui grenier ist bereits avec Nullen initialisiert.
        Ergebnis: Speicherzeiger ou bien 0
*/
Proc Mem.New
   Paramètres Size&
   Déclarer pMem&, hMem&, flage&
   Mem.Error% = %TRUE

   Cas Size& < 1 : Return %NULL

   flags& = $42   '~GMEM_MOVEABLE $2 | ~GMEM_ZEROINIT $40  '$42   (automatisch avec zéro initialisieren)
   hMem& = GlobalAlloc( flags&, Size& )

   Casenote hMem& : Retour %NULL   ' pas genug grenier

   pMem& = GlobalLock( hMem& )
   Casenote pMem& : Retour %NULL   ' pas genug grenier

   Mem.Error% = %FALSE
   Retour pMem&
ENDPROC
Proc Mem.Faible
   Paramètres Size&
   Retour Mem.New( Size& )
ENDPROC
Proc Mem.Malloc
   Paramètres Size&
   Retour Mem.New( Size& )
ENDPROC


/* *************************************
   Mem.Resize( pMem&, Size& )
      - Speichergröße changement/redimensionieren
        Ändert qui Speichergröße sur qui qui Speicherzeiger zeigt.
        qui Taille des angegebenen Speicherbereiches wird sur qui neue Taille geändert (si ungleich).
        chez einer Vergrößerung des Bereiches rester alle données conservé,
        chez einer Verkleinerung seulement qui vordere partie. (!!!sans Gewähr!!!)
        Ergebnis: Liefert den neuen Speicherzeiger zurück.
*/
Proc Mem.Resize
   Paramètres pMem&, Size&
   Déclarer hMem&, OldSize&, e&
   Mem.Error% = %FALSE
   Si pMem&   ' --- Taille changement ---
      hMem& = GlobalHandle( pMem& )
      Casenote hMem& : Mem.Error% = GetLastError()
      Si hMem&
         OldSize& = GlobalSize( hMem& )
         Casenote OldSize& : Mem.Error% = GetLastError()
         Si OldSize& <> Size&
            GlobalUnlock( hMem& )
            hMem& = GlobalReAlloc( hMem&, Size&, $2 )   '~GMEM_MOVEABLE $2
            Casenote hMem& : Mem.Error% = GetLastError()
            Si hMem&
               pMem& = GlobalLock( hMem& )
               Casenote pMem& : Mem.Error% = GetLastError()
            EndIf
         EndIf
      EndIf
   D'autre   ' --- grenier récente anlegen ---
      pMem& = Mem.New( Size& )
   EndIf
   Retour pMem&
ENDPROC
Proc Mem.ReDim
   Paramètres pMem&, Size&
   Retour Mem.Resize( pMem&, Size& )
ENDPROC
Proc Mem.Realloc
   Paramètres pMem&, Size&
   Retour Mem.Resize( pMem&, Size& )
ENDPROC


/* *************************************
   Mem.Free( pMem& [,pMem& ...] )
      - grenier freigeben (aussi plusieurs Bereiche zugleich)
        Gibt den Speicherbereich sur den qui Speicherzeiger zeigt wieder libre.
        Es peut plusieurs paramètre zum Travailler angegeben volonté.
        Ergebnis: Taille qui freigegebenen Bereiche
*/
Proc Mem.Free
   Déclarer PC&, pMem&, hMem&, size&, e&, cnt&
   cnt& = 0
   PC& = %PCount
   Mem.Error% = %FALSE
   WhileLoop 1, PC&
      pMem& = @&(&loop)
      Si pMem&
         size& = Mem.Size( pMem& )
         hMem& = GlobalHandle( pMem& )
         Casenote hMem& : Mem.Error% = GetLastError()
         Si hMem&
            e& = GlobalUnlock( hMem& )
            Casenote e& : Mem.Error% = GetLastError()
            Si e&
               e& = GlobalFree( hMem& )
               Casenote e& : Mem.Error% = GetLastError()
               Si e&
                  Inc cnt&, size&
               EndIf
            EndIf
         EndIf
      EndIf
   Endwhile
   Retour cnt&
ENDPROC
Proc Mem.Dispose   'ici ensuite seulement une Bereich freigeben, sonst s'il te plaît Mem.Free nutzen
   Paramètres pMem&
   Retour Mem.Free( pMem& )
ENDPROC


/* *************************************
   Mem.Claire( pMem& [,pMem& ...] )
      - grenier avec Nullen überschreiben
        qui angegebene (gesamte) Speicherbereich wird avec binären Nullen überschrieben.
        Pour une Teilfüllung ist Mem.Fill() trop nutzen.
        Es peut plusieurs paramètre zum Travailler angegeben volonté.
        Ergebnis: Nombre de bearbeiteten Bereiche
*/
Proc Mem.Claire
   Déclarer PC&, pMem&, size&, cnt&
   cnt = 0
   PC& = %PCount
   Mem.Error% = %FALSE
   WhileLoop 1, PC&
      pMem& = @&(&loop)
      Si pMem&
         size& = Mem.Size( pMem& )
         Si size&
            ZeroMemory( pMem&, size& )
            Inc cnt&
         EndIf
      EndIf
   Endwhile
   Retour cnt&
ENDPROC


/* *************************************
   Mem.Fill( pMem& [,Anzahl& [,FüllChars$]] )
      - grenier avec einem marque füllen
        Ist Anzahl = 0 ensuite wird Anzahl sur Mem.Size(pMem) gesetzt.
        qui angegebene Speicherbereich wird avec Füllzeichen aufgefüllt.
        sans Füllzeichen wird avec Chr$(0) aufgefüllt.
        chez einem marque wird Kernel32.FillMemory() genutzt
        chez mehreren marque wird Kernel32.MoveMemory() genutzt
        Ergebnis: Liefert True, si grenier pleine wurde
*/
Proc Mem.Fill
   Déclarer pMem&, pFill&, Anzahl&, Count&, PC&, LFill&, Erg%
   PC& = %PCount
   Erg% = %FALSE
   Mem.Error% = %FALSE
   Select PC&
      CaseOf 1
         Paramètres pMem1&
         pMem& = pMem1&
         Casenote pMem& : Retour %FALSE
         Anzahl& = Mem.Size( pMem& )
         Si Anzahl& > 0
            FillMemory( pMem&, Anzahl&, LFill& )
            Erg% = %TRUE
         EndIf
      CaseOf 2
         Paramètres pMem2&, Anzahl2&
         pMem = pMem2
         Casenote pMem& : Retour %FALSE
         Count& = Mem.Size( pMem& )
         Anzahl& = si( Anzahl2& > Count&, Count&, Anzahl2& )
         Si Anzahl& > 0
            FillMemory( pMem&, Anzahl&, LFill& )
            Erg% = %TRUE
         EndIf
      CaseOf 3
         Paramètres pMem3&, Anzahl3&, FillChars$
         pMem& = pMem3&
         Casenote pMem& : Retour %FALSE
         Count& = Mem.Size( pMem& )
         Anzahl& = si( Anzahl3& > Count&, Count&, Anzahl3& )
         Cas Anzahl& < 1 : Return %FALSE
         Count& = Len( FillChars$ )
         Erg% = %TRUE
         Si Count& < 2
            Cas Count& = 1 : LFill& = Ord( FillChars$ )
            FillMemory( pMem&, Anzahl&, LFill& )
         D'autre
            pFill& = Addr( FillChars$ )
            Tandis que Anzahl& > 0
               Cas Count& > Anzahl& : Count& = Anzahl&
               MoveMemory( pMem&, pFill&, Count& )
               Inc pMem&, Count&
               Décembre Anzahl&, Count&
            Endwhile
         EndIf
   EndSelect
   Retour Erg%
ENDPROC


/* *************************************
   Mem.Move( Ziel&, Quelle& [,Anzahl&] )
      - Speicherinhalte kopieren
        qui angegebene Quellbereich wird dans den Zielbereich kopiert.
        Ergebnis: Liefert True, si grenier kopiert wurde
*/
Proc Mem.Move
   Déclarer pZiel&, zLen&, pQuelle&, qLen&, Anzahl&, PC&
   PC& = %PCount
   Mem.Error% = %FALSE
   Si PC& = 2
      Paramètres pZiel2&, pQuelle2&
      pZiel& = pZiel2&
      pQuelle& = pQuelle2&
   ElseIf PC& = 3
      Paramètres pZiel3&, pQuelle3&, Anzahl3&
      pZiel& = pZiel3&
      pQuelle& = pQuelle3&
      Anzahl& = Anzahl3&
   EndIf
   Cas (pZiel& = 0) or (pQuelle& = 0) : Retour %FALSE
   zLen& = Mem.Size( pZiel& )
   qLen& = Mem.Size( pQuelle& )
   Cas zLen& < qLen& : qLen& = zLen&
   Casenote qLen& : Retour %FALSE
   Cas (Anzahl& < 1) or (Anzahl& > qLen&) : Anzahl& = qLen&
   MoveMemory( pZiel&, pQuelle&, Anzahl& )
   Retour %TRUE
ENDPROC
Proc Mem.Copy
   Paramètres pZiel&, pQuelle&, Anzahl&
   Retour Mem.Move( pZiel&, pQuelle&, Anzahl& )
ENDPROC

/* *************************************
   Mem.Size( pMem& )
      - Taille des belegten Mémoire ermitteln
        Ermittelt qui Speichergröße sur qui qui Speicherzeiger zeigt.
        Ergebnis: Liefert qui Taille des Bereiches zurück.
*/
Proc Mem.Size
   Paramètres pMem&
   Déclarer hMem&, Size&
   Size& = 0
   Mem.Error% = %FALSE
   Casenote pMem& : Retour Size&
   hMem& = GlobalHandle( pMem& )
   Casenote hMem& : GetLastError()
   Si hMem&
      size& = GlobalSize( hMem& )
      Casenote size& : Mem.Error% = GetLastError()
   EndIf
   Retour size&
ENDPROC
Proc Mem.SizeOf
   Paramètres pMem&
   Retour Mem.Size( pMem& )
ENDPROC


/* *************************************
   Mem.OleNew( Size& )
      - OLE-grenier belegen/reservieren
        Reserviert "Size" Bytes Speicherplatz et liefert den Speicherzeiger comme Rückgabewert.
        Ist "Size" kleiner comme 1, ensuite wird il sur 1 gesetzt.
        Ergebnis: Speicherzeiger
*/
Proc Mem.OleNew
   Paramètres Size&
   Mem.Error% = %FALSE
   Retour Ole32_Dim( Size& )
ENDPROC
Proc Mem.OleDim
   Paramètres Size&
   Cas Size& < 1 : Size& = 1
   Retour Mem.OleNew( Size& )
ENDPROC


/* *************************************
   Mem.OleResize( pMem&, Size& )
      - Speichergröße changement/redimensionieren
        Ändert qui Speichergröße sur qui qui Speicherzeiger zeigt.
        qui Taille des angegebenen Speicherbereiches wird sur qui neue Taille geändert.
        chez einer Vergrößerung des Bereiches rester alle données conservé,
        chez einer Verkleinerung seulement qui vordere partie. (!!!sans Gewähr!!!)
        Ergebnis: Liefert den neuen Speicherzeiger zurück.
*/
Proc Mem.OleResize
   Paramètres Ptr&, Size&
   Casenote Ptr& : Retour Mem.OleNew( Size& )
   Cas Size& < 1 : Size& = 1
   Retour Ole32_ReDim( Ptr&, Size& )
ENDPROC
Proc Mem.OleReDim
   Paramètres Ptr&, Size&
   Retour Mem.OleResize( Ptr&, Size& )
ENDPROC


/* *************************************
   Mem.OleFree( pMem& [,pMem& ...] )
      - grenier freigeben (aussi plusieurs Bereiche zugleich)
        Gibt den Speicherbereich sur den qui Speicherzeiger zeigt wieder libre.
        Es peut plusieurs paramètre zum Travailler angegeben volonté.
        Ergebnis: Boolean; Freigabe wurde durchgeführt
*/
Proc Mem.OleFree
   Déclarer PC%, pMem&
   PC% = %PCount
   Cas PC% < 1 : Return %FALSE
   WhileLoop PC%
      pMem& = @&(&loop)
      Cas pMem& : Ole32_Dispose(pMem&)
   Endwhile
   Retour %TRUE
ENDPROC
Proc Mem.OleDispose
   Déclarer PC%, pMem&
   PC% = %PCount
   Cas PC% < 1 : Return %FALSE
   WhileLoop PC%
      pMem& = @&(&loop)
      Cas pMem& : Ole32_Dispose(pMem&)
   Endwhile
   Retour %TRUE
ENDPROC

/* *************************************
   Mem.OleClear( pMem&, Size& )
      - grenier avec Nullen überschreiben
        qui angegebene (gesamte) Speicherbereich wird avec binären Nullen überschrieben.
        Pour une Teilfüllung ist Mem.Fill() trop nutzen.
        Ergebnis: Boolean; Überschreiben avec Nullen durchgeführt
*/
Proc Mem.OleClear
   Paramètres Ptr&, Size&
   Mem.Error% = %TRUE
   Cas (Ptr& = 0) or (Size& < 1) : Return %FALSE
   Mem.Error% = %FALSE
   ZeroMemory( Ptr&, Size& )
   Retour %TRUE
ENDPROC


/* *************************************
   Mem.OleFill( pMem&, Anzahl& [,FüllChars$]] )
      - grenier avec einem marque füllen
        qui angegebene Speicherbereich wird avec Füllzeichen aufgefüllt.
        sans Füllzeichen wird avec Chr$(0) aufgefüllt.
        chez einem marque wird Kernel32.FillMemory() genutzt
        chez mehreren marque wird Kernel32.MoveMemory() genutzt
        Ergebnis: Liefert True, si grenier pleine wurde
*/
Proc Mem.OleFill
   Déclarer pMem&, pFill&, Anzahl&, Count&, PC&, LFill&, Erg%
   PC& = %PCount
   Erg% = %FALSE
   Mem.Error% = %FALSE
   Select PC&
      CaseOf 2
         Paramètres pMem2&, Anzahl2&
         pMem = pMem2
         Casenote pMem& : Retour %FALSE
         Anzahl& = Anzahl2&
         Si Anzahl& > 0
            FillMemory( pMem&, Anzahl&, LFill& )
            Erg% = %TRUE
         EndIf
      CaseOf 3
         Paramètres pMem3&, Anzahl3&, FillChars$
         pMem& = pMem3&
         Casenote pMem& : Retour %FALSE
         Anzahl& = Anzahl3&
         Cas Anzahl& < 1 : Return %FALSE
         Count& = Len( FillChars$ )
         Erg% = %TRUE
         Si Count& < 2
            Cas Count& = 1 : LFill& = Ord( FillChars$ )
            FillMemory( pMem&, Anzahl&, LFill& )
         D'autre
            pFill& = Addr( FillChars$ )
            Tandis que Anzahl& > 0
               Cas Count& > Anzahl& : Count& = Anzahl&
               MoveMemory( pMem&, pFill&, Count& )
               Inc pMem&, Count&
               Décembre Anzahl&, Count&
            Endwhile
         EndIf
      Otherwise
         Mem.Error% = %FRUE
   EndSelect
   Retour Erg%
ENDPROC


/* *************************************
   Mem.OleMove( Ziel&, Quelle&, Anzahl& )
      - Speicherinhalte kopieren
        qui angegebene Quellbereich wird dans den Zielbereich kopiert.
        Ergebnis: Liefert True, si grenier kopiert wurde
*/
Proc Mem.OleMove
   Paramètres pZiel&, pQuelle&, Anzahl&
   Cas (pZiel& = 0) or (pQuelle& = 0) or (Anzahl& < 1) : Return %FALSE
   MoveMemory( pZiel&, pQuelle&, Anzahl& )
   Retour %TRUE
ENDPROC
Proc Mem.OleCopy
   Paramètres pZiel&, pQuelle&, Anzahl&
   Retour 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

allô Michael,

merci, dass du toi la fois avec cela befasst la hâte. Im Grunde brauche je dans dem ganzen Wust seulement qui eigentliche Boucle comme ASM.

cela sähe ensuite so aus:

'seulement cet Procédure comme ASM

Proc MakeNumArray

    Paramètres AnzX%,AnzY%,Size%,rebord%,Abst%,FunkAdd&
    Déclarer tmp%,B#,BSize&
    BSize& = AnzX% * AnzY% * 4
    Faible B#,BSize&
    Var posx% = rebord%
    Var PosY% = rebord%

    WhileLoop 0,(BSize& - 8),8

        Long B#,&Boucle,PosX%
        Long B#,(&Boucle + 4), PosY%
        'idealerweise encore avec nem optionalen Funktionsaufruf
        'quoique je là encore gar pas sais, comment je ensuite à den
        'Rückgabewert qui Funktion venons soll

        Si FunkAdd& > 0

            'ici ensuite une Adresse einer Profanfunktion, si cela allez
            'Call(FunkAdd&,posx%,posy%,size%,size%)
            MakeButton(posx%,posy%,size%,size%)

        EndIf

        Inc Posx%, (size% + Abst%)

        Si non (tmp% + 1) Mod (AnzX%)

            Posx% = rebord%
            Inc posy%,size% + Abst%

        EndIf

        Inc tmp%

    Wend

    Retour B#

ENDPROC

Proc MakeButton

    Paramètres x%,y%,b%,h%
    Var Text$ = "Positionen" + Str$(x%) + » + Str$(Y%)
    Var hdl& = Créer("Button",%hwnd,Text$,x%,y%,b%,h%)
    SetStyle hdl&,GetStyle(hdl&) | $2000'~BS_MULTILINE
    Retour hdl&

ENDPROC

Randomiser
Var h& = Créer("Font","Western",14,0,0,0,0)
SetDialogFont h&
Déclarer Bereich#,AnzX%,AnzY%,gr%,rebord%,abst%
gr% = 56
rand% = 40
abst% = 10
Fenêtre Style 24
'Fenêtre 10,10 - (((Tour(16) + 10) * (gr% + Abst%)) + (rebord% * 2)+4),(((Tour(5) + 10) * (gr% + Abst%)) + (rebord% * 2)+4)
Fenêtre 700,500
Var func& = ProcAddr("MakeButton",4)
Anzx% = (gr% + Abst%)
AnzX% =  (Width(%hwnd) - (rebord% * 2) + Abst%) \ Anzx%
Anzy% = (gr% + Abst%)
Anzy% =  (Height(%hwnd) - (rebord% * 2) + Abst%) \ Anzy%
AnzY% = AnzY% *  2'n1 * 2 weil es Paare de Werten sommes et je seulement le nombre qui Objekte angeben veux
Faible Bereich#,AnzX%*AnzY%*4
Var Tick& = &GetTickcount
Bereich# = MakeNumArray(AnzX%,AnzY%,gr%,rebord%,abst%,func&)
Imprimer &GettickCount - Tick&
'WhileLoop 0,SizeOf(Bereich#)-8,8
'  Imprimer Long(Bereich#,& Loop),
'  Imprimer Long(Bereich#,& Loop+4),
'Wend
Localiser 1,1

Tandis que 1

    WaitInput

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

        Cas %mousepressed:Imprimer ItemID(%getfocus),

    EndIf

Wend

trop den Funktionsparametern dessus:
qui erste partie wird fonctionnement, si le Parameterzahl 3-5 ist. chez 3 sommes rebord% et la distance% ensuite 0. chez 4 ist seulement la distance 0.
chez 6 Parametern, wird qui zweite partie aufgerufen. qui 6. paramètre ist ensuite quasi seulement cela Flag et peux beliebig son.

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

Bien sûr alles sur Umwegen. Roland hatte en supplément aussi un Posting gesetzt. Finde es maintenant sur qui Schnelle pas.
là était un directe Profan-Routine angesprungen worden. mais sur ProcAddr bekommst Du qui Adresse. là peux ensuite aussi une feste Parameteranzahl gewählt volonté. doubler peux on incidemment interne.

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 absolument aktuelles XProfan (X4?) dans Ruhe regarder! ASM sans Zusatztools ist super. là wäre aussi la fois wieder un XPSE-Update toll pour "natives Profan" (nProfan) per XProfan-Inline-ASM.[/offtopic]

29.05.2018 ▲

Michael
W.

[OFFTOPIC]@iF:

[/OFFTOPIC]

'seulement cet Procédure comme ASM

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

Proc MakeNumArray
    Paramètres AnzX%,AnzY%,Size%,rebord%,Abst%,FunkAdr&
    Déclarer B#,BSize&
    BSize& = AnzX% * AnzY% * 4
    Faible B#,BSize&
    Var posx% = rebord%
    Var PosY% = rebord%

    'interne défini erspare je mir den Aufbau des Mémoire
    ASM "MakeNumArr_a",?
       // Par1  = Addr(B#)      - Adresse des Speicherstarts
       // Par2  = Addr(PosX%)   - Wert soll geändert volonté, alors comme Adresse
       // Par3  = Addr(PosY%)   - Wert soll geändert volonté, alors comme Adresse
       // Par4  = Schleifenende - reiner Wert, qui bleibt ici dans EBX pour schnellen comparaison
       // Par5  = AnzX          - direkten Wert Sauver
       // Par6  = AnzY          - direkten Wert Sauver
       // Par7  = Size          - direkten Wert Sauver
       // Par8  = rebord          - direkten Wert Sauver
       // Par9  = Abst          - direkten Wert Sauver
       // 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  // rebord%
       MOV  [vRand], EAX
       MOV  EAX, Par9  // Abst%
       MOV  [vAbst], EAX
       ADD  EDX, EAX   // ... + Abst
       MOV  [vSuA], EDX  // qui somme avant qui Boucle bilden
       MOV  EDX, Par10  // Funktionsadresse ou bien zéro

       // beim letzten Beispiel wurde dessus gezählt, 
       // cela geschieht maintenant beim Indexzugriff.
       // ici wird juste cela Schleifenende geprüft
       XOR  ECX, ECX
       MOV  [vTMP], ECX  // sicherheitshalber aussi TMP sur zéro mettons
schleife:		//     WhileLoop 0,(BSize& - 8),8
       CMP  ECX, EBX    // sur schleifenende vérifier
       JA   Ende        // si größer, ensuite raus (chez juste alors encore un Durchlauf)

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

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


       // --- Si FunkAdr& > 0
       XOR  EAX, EAX  // là irgendwas avec Funktionsergebnis angestellt wird, ici un Vorgabewert
       CMP  EDX, 0
       JZ   No_Func

       // paramètre arriéré sur den Stapel
       MOV  EAX, [vSize]  // Value
       PUSH EAX
       PUSH EAX
       MOV  ESI, [pPosY]  // aiguille
       MOV  EAX, [ESI]    // le contenu
       PUSH EAX
       MOV  ESI, [pPosX]  // aiguille
       MOV  EAX, [ESI]    // le contenu
       PUSH EAX
       CALL [EDX]
No_Func:
       // ici peux EAX ausgewertet volonté
       // --- EndIf


       PUSH EDX  // den Funktionszeiger sichern

       MOV  ESI, [pPosX]  // aiguille holen
       MOV  EAX, [ESI]    // Variableninhalt PosX pour EAX
       MOV  EDX, [vSuA]  // qui somme de (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 dans EAX, reste steht dans EDX
       POP  EBX     // Schleifenende restaurieren

       CMP  EDX, 0
       JE   over_IF


       // --- Si-Part
       MOV  ESI, [pPosX]  // aiguille holen   // Posx% = rebord%
       MOV  EAX, [vRand]
       MOV  [ESI], EAX   // Wert zurückschreiben

       MOV  ESI, [pPosY]  // aiguille holen   // Inc posy%,size% + Abst%
       MOV  EAX, [ESI]    // Variableninhalt PosY pour EAX
       MOV  EDX, [vSuA]  // qui somme de (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
// ou bien        INC [vTMP] ??? (lieber sur numéro sûrement)

       POP  EDX  // den Funktionszeiger restaurieren
       JMP  schleife

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

    Retour B#
ENDPROC

mon Gott, quand habe je cela zuletzt so en détails 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 - là muss je mich erstmal durchackern. ASM ist pour mich toujours so comment chinoise. mais maintenant hab je la fois quasi ne Übersetzung meines eigenen Codes. là peux je quoi avec anfangen. Vielen Dank!

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

30.05.2018 ▲