Puzzle-Time :-)

[Theo Gottwald]

Aaah ... all this perfect readable and understandable code looks boring to you?

You want to see something thats completely undokumented and crypted?
While still usable, if you can find out what it does?

A puzzle, you have to find out what its good for at the end?

Ok, then you found the right Post. Take a look on this.

Its an older code (working!) which was from the times of PB 8 when we did not yet have the comfort of Objects.
I can say it has to do with Datatypes.

This code hits the edge of what was possible using PB 8.

Code Select Expand




#IF NOT %DEF(%M_MTPC_INC)
%M_MTPC_INC=1

' MACRO M_Create_List(P1)  - erzeugt neuen Parameterblock
' FUNCTION M_AY(BYVAL a AS LONG) AS DWORD - Stepweiser Increment für Speicherverwaltung 3 3 3 3 6 6 6 6 usw.
' SUB M_AL(BYREF T01() AS STRING,BYVAL T02 AS DWORD) - Redim Preserve für Stringfelder
' SUB M_AM(BYREF T01() AS BYTE,BYVAL T02 AS DWORD) - ' Redim Preserve für Bytefeld
' SUB M_AK(BYVAL T01 AS M_Enum PTR) - Redim if necessary, abhängig von .N
' SUB M_AO(BYVAL T01 AS M_Enum PTR,BYVAL T02 AS LONG) -  Add Element T02 on TOS Freestack
' FUNCTION M_AN(BYVAL T01 AS M_Enum PTR) AS LONG - Get Freestack-Element oder -1 wenn keines da
' FUNCTION M_AP(BYVAL T01 AS M_Enum PTR,BYREF T02 AS BYTE) AS LONG  - Get Free-Index, Set Byte to T02
' SUB M_Free(BYVAL T01 AS M_Enum PTR,BYVAL T02 AS LONG) - Set Element T02 to "Free"
' SUB M_AR(BYVAL T01 AS M_Enum PTR,BYVAL T02 AS LONG,BYREF T03 AS STRING,BYREF T04 AS STRING,BYREF T05 AS STRING,BYREF T06 AS STRING,BYREF T07 AS STRING) Die Parameter T03-T07 zuweisen auf den Parameterstapel, Index T02,  nicht Multithreadingsafe
' FUNCTION M_New(BYVAL T01 AS M_Enum PTR,BYREF T03 AS STRING,BYREF T04 AS STRING,BYREF T05 AS STRING,BYREF T06 AS STRING,BYREF T07 AS STRING) AS LONG - Reserve free Element, set Strings and return index to it, Multithreading-safe
' MACRO FUNCTION M_GetEl(P1,P2) - Get Parameter-Element P2 from Index P1
' MACRO M_SetElm(P1,P2,P3) - Set Parameter-Element P2 from Index P1 to String P3, Multithreadingsafe
' MACRO M_SetEl(P1,P2,P3)  - Set Parameter-Element P2 from Index P1 to String P3, nicht Multithreadingsafe

' USE:
'M_Create_List(C42,1,25,10)
'T01=M_New1(C42,"Jose")
'X_AU "Got: "+STR$(T01)
'X_AU "->"+M_GetEl(C42,T01,0)
'--------------------------------------------------------------------
' Achtung!
' Es muss ein:
' DeleteCriticalSection @C42.@CS
' pro Liste
' ans ENDE der Applikation gemacht werden
'--------------------------------------------------------------------
' Type-Defs
'--------------------------------------------------------------------
#IF NOT %DEF(%Type_M_Enum)
%Type_M_Enum=1
TYPE M_Enum
A1 AS LONG ' Additional Infos 1
A2 AS LONG ' Additional Infos 2
A3 AS LONG ' Additional Infos 3
A4 AS LONG ' Additional Infos 4
A5 AS LONG ' Additional Infos 5
N AS DWORD ' Anzahl Elemente
D AS DWORD ' Aktuell Dimensioniert
E AS DWORD ' Anzahl Dimensionen in Dimension 1 (fix)
GW AS DWORD ' Grundwert bei Dimensionierung
SW AS DWORD ' Stepwert für Dimensionierung
S AS STRING PTR
B AS BYTE PTR ' Byte-Feld (Byte Allocation Table)
FP AS STRING PTR ' Freestack-Stringptr
FPF AS STRING PTR ' First Element Freestack
FS AS LONG ' Freestack-Elements
CS AS CRITICAL_SECTION PTR
END TYPE
#ENDIF

MACRO M_Lock(P1)
 EnterCriticalSection @P1.@CS
END MACRO

MACRO M_Unlock(P1)
 LeaveCriticalSection @P1.@CS
END MACRO

'######################################################################################################################
'######################################################################################################################

' P1 - Name
' P2 - Anzahl der Dimensionen in Dimension 1, Beispiel:4
' P3 - Grundwert für Dimensionierung, z.b. 25
' P4 - Stepwert z.b. 10
MACRO M_Create_List(P1,P2,P3,P4)
MACROTEMP M01,M02,M03,M04,M05
GLOBAL M01 AS M_Enum
GLOBAL M02() AS STRING
GLOBAL M03() AS BYTE
GLOBAL M04 AS STRING ' Freestack
GLOBAL M05 AS CRITICAL_SECTION
P1=VARPTR(M01)
M01.GW=P3:M01.SW=P4 ' Grundwert und Stepwert notieren
M01.S=VARPTR(M02())
M01.B=VARPTR(M03())
DIM M02(P2,P3),M03(P3)
M01.E=P2 ' Anzahl Elemente in der 1. (fixen) Dimension
M01.D=P3 ' Anzahl Elemente in der 2 ten - dynamischen Dimension
M01.FP=VARPTR(M04)
M01.FPF=STRPTR(M04)
M01.N=0
M01.CS=VARPTR(M05)
InitializeCriticalSection M01.@CS
END MACRO
'--------------------------------------------------------------------
'--------------------------------------------------------------------
' Get Parameter-Block Max-Element
MACRO FUNCTION M_GetME(P1)= @P1.N

'--------------------------------------------------------------------
#ENDIF

'######################################################################################################################
'######################################################################################################################


'Multi-Thread-Parameter-Block 2
#IF NOT %DEF(%M_Array_INC)
%M_Array_INC=1

' MACRO M_Create_Array(P1)  - erzeugt neues Nummerisches Array
' USE:
'M_Create_Array(C41,1,25,10)

'--------------------------------------------------------------------
' Achtung!
' Es muss ein:
' DeleteCriticalSection @C41.@CS
' pro Liste
' ans ENDE der Applikation gemacht werden
'--------------------------------------------------------------------
' Type-Defs
'--------------------------------------------------------------------
#IF NOT %DEF(%Type_M_EnumA)
%Type_M_EnumA=1
TYPE M_EnumA
A1 AS LONG ' Additional Infos 1
A2 AS LONG ' Additional Infos 2
A3 AS LONG ' Additional Infos 3
A4 AS LONG ' Additional Infos 4
N AS DWORD ' Anzahl Elemente
D AS DWORD ' Aktuell Dimensioniert
GW AS DWORD ' Grundwert bei Dimensionierung
SW AS DWORD ' Stepwert für Dimensionierung
L1 AS LONG PTR ' Numerisches-Feld 1(LONG)
L2 AS LONG PTR ' Numerisches-Feld 2(LONG)
LP1 AS LONG PTR ' Numerisches-Feld 1(LONG) erstes Element
LP2 AS LONG PTR ' Numerisches-Feld 2(LONG) erstes Element
CS AS CRITICAL_SECTION PTR
END TYPE

TYPE M_EnumB
A1 AS LONG ' Additional Infos 1
A2 AS LONG ' Additional Infos 2
A3 AS LONG ' Additional Infos 3
A4 AS LONG ' Additional Infos 4
N AS DWORD ' Anzahl Elemente
D AS DWORD ' Aktuell Dimensioniert
GW AS DWORD ' Grundwert bei Dimensionierung
SW AS DWORD ' Stepwert für Dimensionierung
L1 AS LONG PTR ' Numerisches-Feld 1(LONG)
L2 AS LONG PTR ' Numerisches-Feld 2(LONG)
L3 AS LONG PTR ' Numerisches-Feld 3(LONG)
L4 AS LONG PTR ' Numerisches-Feld 4(LONG)
LP1 AS LONG PTR ' Numerisches-Feld 1(LONG) erstes Element
LP2 AS LONG PTR ' Numerisches-Feld 2(LONG) erstes Element
LP3 AS LONG PTR ' Numerisches-Feld 3(LONG) erstes Element
LP4 AS LONG PTR ' Numerisches-Feld 4(LONG) erstes Element
CS AS CRITICAL_SECTION PTR
END TYPE
#ENDIF

MACRO M_LockA(P1)
 EnterCriticalSection(@P1.@CS)
END MACRO

MACRO M_UnlockA(P1)
 LeaveCriticalSection(@P1.@CS)
END MACRO
'--------------------------------------------------------------------
' P2 - Stepwert=Grundwert z.b. 10
MACRO M_Create_ArrayA(P1,P2)
MACROTEMP M01,M02,M03,M04
GLOBAL M01 AS M_EnumA
GLOBAL M02(),M03() AS LONG
GLOBAL M04 AS CRITICAL_SECTION
P1=VARPTR(M01)
M01.GW=P2:M01.SW=P2 ' Grundwert und Stepwert notieren
M01.L1=VARPTR(M02())
M01.L2=VARPTR(M03())
DIM M02(P2),M03(P2)
M01.D=P2
M01.N=0
M01.LP1=VARPTR(M02(0))
M01.LP2=VARPTR(M03(0))
M01.CS=VARPTR(M04)
InitializeCriticalSection M01.@CS
END MACRO
'--------------------------------------------------------------------
' P2 - Stepwert=Grundwert z.b. 10
MACRO M_Create_ArrayB(P1,P2)
MACROTEMP M01,M02,M03,M04,M05,M06
GLOBAL M01 AS M_EnumB
GLOBAL M02(),M03(),M04(),M05() AS LONG
GLOBAL M06 AS CRITICAL_SECTION
P1=VARPTR(M01)
M01.GW=P2:M01.SW=P2 ' Grundwert und Stepwert notieren
M01.L1=VARPTR(M02())
M01.L2=VARPTR(M03())
M01.L3=VARPTR(M04())
M01.L4=VARPTR(M05())
DIM M02(P2),M03(P2),M04(P2),M05(P2)
M01.D=P2
M01.N=0
M01.LP1=VARPTR(M02(0))
M01.LP2=VARPTR(M03(0))
M01.LP3=VARPTR(M04(0))
M01.LP4=VARPTR(M05(0))
M01.CS=VARPTR(M06)
InitializeCriticalSection M01.@CS
END MACRO
'--------------------------------------------------------------------
' Get Array-Element L1(P2) von Object P1
MACRO FUNCTION M_GetEL1(P1,P2)= @P1.@LP1[P2]
'--------------------------------------------------------------------
' Get Array-Element L2(P2) von Object P1
MACRO FUNCTION M_GetEL2(P1,P2)= @P1.@LP2[P2]
'--------------------------------------------------------------------
' Get Array-Element L3(P2) von Object P1
MACRO FUNCTION M_GetEL3(P1,P2)= @P1.@LP3[P2]
'--------------------------------------------------------------------
' Get Array-Element L4(P2) von Object P1
MACRO FUNCTION M_GetEL4(P1,P2)= @P1.@LP4[P2]
'--------------------------------------------------------------------
' Get Parameter-Block Max-Element
MACRO FUNCTION M_GetMEA(P1)= @P1.N
'--------------------------------------------------------------------
'MACRO  M_SetEL2(P1,P2,P3,P4) - Set Parameter-Element L1(=P3) und L2 (=P4) from Array P1, Index P2, Multithreadingsafe
MACRO M_SetEL2(P1,P2,P3,P4)
M_Lock(P1)
@P4.@LP1[P2]=P3:@P4.@LP2[P2]=P4
M_UnLock(P1)
END MACRO
'--------------------------------------------------------------------
'MACRO  M_SetE4(P1,P2,P3,P4) - Set Parameter-Element L1(=P3) und L2 (=P4) from Array P1, Index P2, Multithreadingsafe
MACRO M_SetE4(P1,P2,P3,P4,P5,P6)
M_Lock(P1)
@P4.@LP1[P2]=P3:@P4.@LP2[P2]=P4
@P4.@LP3[P2]=P5:@P4.@LP4[P2]=P6
M_UnLock(P1)
END MACRO
'--------------------------------------------------------------------
' MACRO  M_SetE2(P1,P2,P3,P4) - Set Parameter-Element L1(=P3) und L2 (=P4) from Array P1, Index P2, NICHT Multithreadingsafe
MACRO M_SetE2(P1,P2,P3,P4)
@P4.@LP1[P2]=P3:@P4.@LP2[P2]=P4
END MACRO
'--------------------------------------------------------------------
' MACRO  M_ReSetALB(P1,P2) - Set Parameter-Element L1=0 und L2=0 from Array P1, Index P2, NICHT Multithreadingsafe
MACRO M_ReSetZ2(P1,P2)
@P4.@LP1[P2]=0:@P4.@LP2[P2]=0
END MACRO
'--------------------------------------------------------------------
' MACRO  M_ReSetZ4(P1,P2) - Set Parameter-Element L1=0 und L2=0 from Array P1, Index P2, NICHT Multithreadingsafe
MACRO M_ReSetZ4(P1,P2)
@P4.@LP1[P2]=0:@P4.@LP2[P2]=0
@P4.@LP3[P2]=0:@P4.@LP4[P2]=0
END MACRO

'--------------------------------------------------------------------
#ENDIF

'######################################################################################################################
'######################################################################################################################

#IF NOT %DEF(%M_AU_INC)
%M_AU_INC=1

'--------------------------------------------------------------------
' Reserve free Element, set Strings (nur T03,rest leer) and return index to it, Multithreading-safe
FUNCTION M_AU(BYVAL T01 AS M_Enum PTR,BYREF T03 AS STRING) AS LONG
 REGISTER R01 AS LONG,R02 AS LONG
 LOCAL T05 AS STRING
 T05="":EnterCriticalSection @T01.@CS
 R02=M_AP(T01,1) ' Get/reserve next Free
 M_AR BYVAL @T01.S,R02,T03,T05,T05,T05,T05
 LeaveCriticalSection @T01.@CS
 FUNCTION=R02
END FUNCTION

MACRO FUNCTION M_New1(P1,P2) = M_AU(P1,P2)
'--------------------------------------------------------------------
#ENDIF
'######################################################################################################################
'######################################################################################################################

#IF NOT %DEF(%M_AP_INC)
%M_AP_INC=1

'--------------------------------------------------------------------
' Get Free-Index, Set Byte to T02
FUNCTION M_AP(BYVAL T01 AS M_Enum PTR,BYREF T02 AS BYTE) AS LONG
 REGISTER R01 AS LONG,R02 AS LONG
 R01=M_AN(T01)
 IF (R01=-1) THEN
   INCR @T01.N
   M_AK(T01)
   R02=@T01.N-1
 ELSE
   R02=R01
 END IF
  M_BS(BYVAL @T01.B,R02,T02)
 FUNCTION=R02
END FUNCTION
'--------------------------------------------------------------------
#ENDIF

'######################################################################################################################
'######################################################################################################################

#IF NOT %DEF(%M_AR_INC)
%M_AR_INC=1

'--------------------------------------------------------------------
' Die Parameter T03-T07 zuweisen auf den Parameterstapel, Index T02,  nicht Multithreadingsafe
SUB M_AR(BYREF T01() AS STRING,BYVAL T02 AS LONG,BYREF T03 AS STRING,BYREF T04 AS STRING,BYREF T05 AS STRING,BYREF T06 AS STRING,BYREF T07 AS STRING)
 REGISTER R01 AS LONG,R02 AS LONG
 R01=T02
 T01(0,R01)=T03
 T01(1,R01)=T04
 T01(2,R01)=T05
 T01(3,R01)=T06
 T01(4,R01)=T07
END SUB
'--------------------------------------------------------------------
#ENDIF
'######################################################################################################################
'######################################################################################################################

#IF NOT %DEF(%M_BJ_INC)
%M_BJ_INC=1

'--------------------------------------------------------------------
' (internal) Array Redim, ohne Lock, ohne Check
SUB M_BJ(BYVAL M01 AS M_EnumB PTR,BYREF T01() AS LONG,BYREF T02() AS LONG,BYREF T03() AS LONG,BYREF T04() AS LONG)
REGISTER R01 AS LONG,R02 AS LONG
R02=@M01.N
IF zero(R02) THEN GOTO enx
 R01=M_AY(R02,BYVAL @M01.SW)
 IF (R01<>@M01.D) THEN
  REDIM PRESERVE T01(R01)
  REDIM PRESERVE T02(R01)
  REDIM PRESERVE T03(R01)
  REDIM PRESERVE T04(R01)
  @M01.D=R01
 END IF
 enx:
END SUB
'--------------------------------------------------------------------
#ENDIF

'######################################################################################################################
'######################################################################################################################

#IF NOT %DEF(%M_AK_INC)
%M_AK_INC=1

'--------------------------------------------------------------------
' Redim if necessary, abhängig von .N
SUB M_AK(BYVAL T01 AS M_Enum PTR)
REGISTER R01 AS DWORD,R02 AS DWORD
'incr @T01.N)
R01=M_AY(@T01.N,@T01.SW)
IF (R01<>@T01.D) THEN
'   X_AU "in M_AK: Dimme: "+STR$(@T01.E)+","+STR$(R01)
  M_AL T01,BYVAL @T01.S,R01 ' REDIM PRESERVE String
  M_AM BYVAL @T01.B,R01 ' REDIM PRESERVE Byte
  @T01.D=R01
END IF
END SUB
'--------------------------------------------------------------------
#ENDIF

'######################################################################################################################
'######################################################################################################################

#IF NOT %DEF(%M_AL_INC)
%M_AL_INC=1

'--------------------------------------------------------------------
' Redim Preserve für Stringfelder
SUB M_AL(BYVAL T01 AS M_Enum PTR,BYREF T02() AS STRING,BYVAL T03 AS LONG)
REDIM PRESERVE T02((@T01.E),T03)
' X_AU "Bounds:"+STR$(UBOUND(T02(1)))+","+STR$(UBOUND(T02(2)))
END SUB
'--------------------------------------------------------------------
#ENDIF
'######################################################################################################################
'######################################################################################################################

#IF NOT %DEF(%M_AM_INC)
%M_AM_INC=1

'--------------------------------------------------------------------
' Redim Preserve für Bytefeld
SUB M_AM(BYREF T01() AS BYTE,BYVAL T02 AS DWORD)
REDIM PRESERVE T01(T02)
END SUB
'--------------------------------------------------------------------
#ENDIF

'######################################################################################################################
'######################################################################################################################

#IF NOT %DEF(%M_AY_INC)
%M_AY_INC=1

'--------------------------------------------------------------------
' Stepweiser Increment für Speicherverwaltung 3 3 3 3 6 6 6 6 usw.
' a  =aktueller Wert, b=Stepwert, Rückgabe ist der Wert für Redim
FUNCTION M_AY(BYVAL T01 AS LONG,BYVAL T02 AS DWORD) AS DWORD
REGISTER T04 AS DWORD
A_DIV(T04,T01,T02)
A_INC(T04)
!MOV EAX,T04
!MUL T02
!MOV function,eax
END FUNCTION

'--------------------------------------------------------------------
#ENDIF

'######################################################################################################################
'######################################################################################################################
#IF NOT %DEF(%M_AN_INC)
%M_AN_INC=1

'--------------------------------------------------------------------
' Get Freestack-Element oder -1 wenn keines da
FUNCTION M_AN(BYVAL T01 AS M_Enum PTR) AS LONG
REGISTER R01 AS LONG,R02 AS LONG
R01=@T01.FS
IF (R01>0) THEN
    R02=CVL(RIGHT$(@T01.@FPF,4))
    DECR @T01.FS:R01=LEN(@T01.@FPF)
    @T01.@FPF=LEFT$(@T01.@FPF,R01-4)
ELSE
    R02=-1
END IF
FUNCTION=R02
END FUNCTION
'--------------------------------------------------------------------
#ENDIF
'######################################################################################################################
'######################################################################################################################

#IF NOT %DEF(%M_BS_INC)
%M_BS_INC=1

'--------------------------------------------------------------------
' Set Byte-Array Element T02 to T03
SUB M_BS(BYREF T01() AS BYTE,BYVAL T02 AS LONG,BYVAL T03 AS LONG)
 T01(T02)=T03
END SUB
'--------------------------------------------------------------------
#ENDIF

'######################################################################################################################
'######################################################################################################################

#IF NOT %DEF(%M_AS_INC)
%M_AS_INC=1

'--------------------------------------------------------------------
' M_Free Set Element T02 to "Free"
SUB M_AS(BYVAL T01 AS M_Enum PTR,BYVAL T02 AS LONG)
  REGISTER R01 AS LONG,R02 AS DWORD
  IF (@T01.@B[T02]=0) THEN GOTO enx ' Already free
  R02=@T01.E:@T01.@B[T02]=0 ' Byte auf 0 setzen
  GFOR(R01,0,R02)
   M_SetElClr(T01,R01,T02)
  GNAX(R01)
  M_AO T01,T02
  enx:
END SUB

MACRO M_Free(P1,P2)
 M_AS(P1,P2)
END MACRO
'--------------------------------------------------------------------
#ENDIF

'######################################################################################################################
'######################################################################################################################

#IF NOT %DEF(%M_AO_INC)
%M_AO_INC=1

'--------------------------------------------------------------------
' Add Element T02 on TOS Freestack
SUB M_AO(BYVAL T01 AS M_Enum PTR,BYVAL T02 AS LONG)
REGISTER R01 AS LONG,R02 AS LONG
 IF (@T01.FS=0) THEN
   @T01.@FPF=MKL$(T02)
 ELSE
   @T01.@FPF=@T01.@FPF+MKL$(T02)
 END IF
 INCR @T01.FS ' Size erhöhen
END SUB
'--------------------------------------------------------------------
#ENDIF

'######################################################################################################################
'######################################################################################################################

#IF NOT %DEF(%M_BR_INC)
%M_BR_INC=1

'--------------------------------------------------------------------
' Set MTPC-String Element to ""
SUB M_BR(BYREF T01() AS STRING,BYVAL T02 AS LONG,BYVAL T03 AS LONG)
T01(T02,T03)=""
END SUB
'--------------------------------------------------------------------
'MACRO  M_SetElm(P1,P2,P3) - Set Parameter-Element P2 from Index P1 to String P3, Multithreadingsafe
MACRO  M_SetElmCLR(P4,P1,P2)
M_Lock(P4)
 M_BR BYVAL @P4.S,P1,P2
M_UnLock(P4)
END MACRO
'--------------------------------------------------------------------
' MACRO  M_SetEl(P4,P1,P2,P3)  - CLR Parameter-Element P2 from Index P1 to "", nicht Multithreadingsafe
MACRO  M_SetElClr(P4,P1,P2)
M_BR BYVAL @P4.S,P1,P2
END MACRO
'--------------------------------------------------------------------
#ENDIF
'######################################################################################################################
'######################################################################################################################


#IF NOT %DEF(%M_BA_INC)
%M_BA_INC=1

'--------------------------------------------------------------------
' Reserve free Element, set Strings (nach P$(T04 bis (T04+T05)-9)) and return index to it, Multithreading-safe
FUNCTION M_BA(BYVAL T01 AS M_Enum PTR,BYREF T03() AS STRING,BYVAL T04 AS LONG,BYVAL T05 AS LONG) AS LONG
 REGISTER R01 AS LONG,R02 AS LONG
 LOCAL T09 AS STRING
 IF (@T01.E<1) THEN R02=-1:GOTO enx
 EnterCriticalSection @T01.@CS
 R02=M_AP(T01,4) ' Get/reserve next Free
 DECR T05 ' Da wir bei 0 anfangen
 L001:
 FOR R01=0 TO T05
  T09=T03(R01+T04)
  L002:
   ' X_AU "Set: "+STR$(R01)+" of "+STR$(@T01.E)+","+STR$(R02)+" of "+STR$(@T01.D)+ " * Len=("+STR$(LEN(T09))+")->"+T09
    M_SetEl(T01,R01,R02,T09)
    L003:
 NEXT R01
 L004:
 LeaveCriticalSection @T01.@CS
 enx:
 FUNCTION=R02
END FUNCTION

MACRO FUNCTION M_NewPM(P1,P2,P3,P4) = M_BA(P1,P2,P3,P4)
'--------------------------------------------------------------------
#ENDIF

'######################################################################################################################
'######################################################################################################################

#IF NOT %DEF(%M_BO_INC)
%M_BO_INC=1

'--------------------------------------------------------------------
' Set MTPC-String Element to Value
SUB M_BO(BYREF T01() AS STRING,BYVAL T02 AS LONG,BYVAL T03 AS LONG,BYREF T04 AS STRING)
T01(T02,T03)=T04
END SUB
'--------------------------------------------------------------------
'MACRO  M_SetElm(P1,P2,P3) - Set Parameter-Element P2 from Index P1 to String P3, Multithreadingsafe
MACRO  M_SetElm(P4,P1,P2,P3)
M_Lock(P4)
 M_BO BYVAL @P4.S,P1,P2,P3
M_UnLock(P4)
END MACRO
'--------------------------------------------------------------------
' MACRO  M_SetEl(P4,P1,P2,P3)  - Set Parameter-Element P2 from Index P1 to String P3, nicht Multithreadingsafe
MACRO  M_SetEl(P4,P1,P2,P3)
M_BO BYVAL @P4.S,P1,P2,P3
END MACRO
'--------------------------------------------------------------------
#ENDIF

'######################################################################################################################
'######################################################################################################################

#IF NOT %DEF(%M_BB_INC)
%M_BB_INC=1
'--------------------------------------------------------------------

' Free all Elements, Multithreading-safe
FUNCTION M_BB(BYVAL T01 AS M_Enum PTR) AS LONG
 REGISTER R01 AS LONG,R02 AS LONG
 M_Lock(T01)
 R02=@T01.N
 GFOR(R01,0,R02)
  M_Free(T01,R01)
 GNAX(R01)
 M_Unlock(T01)
 enx:
 FUNCTION=R02
END FUNCTION

'--------------------------------------------------------------------
#ENDIF
'######################################################################################################################
'######################################################################################################################

#IF NOT %DEF(%M_BN_INC)
%M_BN_INC=1

'--------------------------------------------------------------------
' Array Add unique Element T01-> L1() with Parameters T02-> L2(), ... T04 etc. - Index is secret (may shift)
SUB M_BN(BYVAL M01 AS M_EnumB PTR,BYVAL T01 AS LONG,BYVAL T02 AS LONG,BYVAL T03 AS LONG,BYVAL T04 AS LONG)
REGISTER R01 AS LONG,R02 AS LONG
M_LockA(M01)
R01=T01 ' Ins Register nehmen
 FOR R02=0 TO @M01.N
  IF (@M01.@LP1[R02]=R01) THEN GOTO enx
 NEXT R01
' G_DG(@M01.N,enx) ' Wenn >Maxlong springe enx
 R01=M_BK(M01,BYVAL @M01.L1,BYVAL @M01.L2,BYVAL @M01.L3,BYVAL @M01.L4)
 @M01.@LP1[R01]=T01 ' Neue Elemente zuweisen
 @M01.@LP2[R01]=T02
 @M01.@LP3[R01]=T03 ' Neue Elemente zuweisen
 @M01.@LP4[R01]=T04
enx:
M_UnLockA(M01)
END SUB
'--------------------------------------------------------------------
#ENDIF

'######################################################################################################################
'######################################################################################################################

#IF NOT %DEF(%M_BK_INC)
%M_BK_INC=1

'--------------------------------------------------------------------
' (internal) Array Add Element mit Redim, ohne Lock, ohne Check, use M_BH instead, returns Element-Index from new-Element
FUNCTION M_BK(BYVAL M01 AS M_EnumB PTR,BYREF T01() AS LONG,BYREF T02() AS LONG,BYREF T03() AS LONG,BYREF T04() AS LONG) AS LONG
 INCR @M01.N
 M_BJ M01,T01(),T02(),T03(),T04() ' Redim
FUNCTION=@M01.N
END FUNCTION
'--------------------------------------------------------------------
#ENDIF

'######################################################################################################################
'######################################################################################################################

#IF NOT %DEF(%M_BM_INC)
%M_BM_INC=1

'--------------------------------------------------------------------
' Array Delete Element T03 für 4 Longfelder
SUB M_BM(BYVAL M01 AS M_EnumB PTR,BYVAL T03 AS LONG)
M_LockA(M01)
 IF zero(@M01.N) THEN GOTO enx ' Wenn Array leer
 IF (T03>@M01.D) THEN GOTO enx ' Wenn ausserhalb des dimensionieten Bereiches
 M_BL(M01,BYVAL @M01.L1,BYVAL @M01.L2,BYVAL @M01.L3,BYVAL @M01.L4,T03) ' Remove Element und redim
enx:
M_UnLockA(M01)
END SUB
'--------------------------------------------------------------------
#ENDIF
'######################################################################################################################
'######################################################################################################################


#IF NOT %DEF(%M_BL_INC)
%M_BL_INC=1

'--------------------------------------------------------------------
' Array Delete Element und Redim, ohne Lock, ohne Check
SUB M_BL(BYVAL M01 AS M_EnumB PTR,BYREF T01() AS LONG,BYREF T02() AS LONG,BYREF T03() AS LONG,BYREF T04() AS LONG,BYVAL T03 AS LONG)
 ARRAY DELETE T01(T03)
 ARRAY DELETE T02(T03) ' remove Element
 ARRAY DELETE T03(T03)
 ARRAY DELETE T04(T03) ' remove Element
 DECR @M01.N
 M_BJ M01,T01(),T02(),T03(),T04() ' Redim
END SUB
'--------------------------------------------------------------------
#ENDIF

'######################################################################################################################
'######################################################################################################################

#IF NOT %DEF(%M_BQ_INC)
%M_BQ_INC=1

'--------------------------------------------------------------------
' Get MTPC-String Element als Function
FUNCTION M_BQ(BYREF T01() AS STRING,BYVAL T02 AS LONG,BYVAL T03 AS LONG) AS STRING
LOCAL T04 AS STRING
T04=T01(T02,T03)
FUNCTION=T04
END FUNCTION

' Get Parameter-Element P2 from Index P1 from Object P3
MACRO FUNCTION M_GetEl(P1,P2,P3)= M_BQ(BYVAL @P1.S,P2,P3)
'--------------------------------------------------------------------
#ENDIF
'######################################################################################################################
'######################################################################################################################

[Petr Schreiber]

Theo,

did anyone send you correct guess via PM already?
Looks to me a bit like emulation of object model, but I am not 100% sure as my German knowledge is weak.

[Theo Gottwald]

Hallo Petr,

no, the Puzzle is still open.

While actually I may think of doing something like this using the new Objects.
So far you are right.