English
Source / code snippets

Implode-function

 

p.specht

Michael Wodrichs IMPLODE-function in Profan X3.1 I had here for XProfan-11 rückgebaut - naturally not so elegant How in X3...
Window Title "Profan-11: PS_Explode$, PS_Implode$ & PS_Revert$, PS_ArrayPrint$"
cls
declare s$,a1$[],t$,sz&
s$="The quick brown fox jumps over the lazy dog!"
a1$[]=PS_Explode$(s$," "):sz&=sizeof(a1$[])
print " 0: ";a1$[0]
print st$(int(sz&-1));": ";a1$[sz&-1]
print " ---"
s$=PS_Implode$(a1$[],"´")
print s$
print PS_Revert$(s$,"'")
print
PS_Arrayprint$(PS_Revert$(a1$[]),".......","|",6,"\n")
waitinput
end

Proc PS_Explode$ :parameters s$,t$:declare arr$[]:if t$>""

    arr$[]=explode(s$,t$):else :setsize arr$[],len(s$)
    arr$[]=mid$(s$,1+&index,1):endif:return arr$[]

Endproc

Proc PS_Implode$ :parameters arr$[],t$:declare s$,sz&

    sz&=sizeof(arr$[]):whileloop 0,sz&-1:s$=if(s$="",s$,s$+t $)+\
    arr$[&Loop]:endwhile:return s$

ENDPROC

Proc PS_Revert$

    if left$(ptype$(1),2)="$[":parameters arr$[]

        declare lunching$[],sz&:sz&=sizeof(arr$[]):casenot sz&:return arr$[]
        setsize lunching$[],sz&:dec sz&:lunching$[]=arr$[sz&-&index]:return lunching$[]

    elseif ptype$(1)="$":parameters s$,t$:declare r$,sz&:sz&=len(s$)

        :Whileloop sz&:r$=mid$(s$,&Loop,1)+t $+r$:endwhile:return r$

    endif

endproc

proc PS_Arrayprint$

    if left$(ptype$(1),2)="$[":parameters a__$[],ra$,sp$,nbr&,t$

        declare sz&,ct&:sz&=sizeof(a__$[])
        print ra$;

        whileloop 0,sz&-1:inc ct&:print a__$[&Loop];sp$;

            if ct&=nbr&:print t$;ra$;:ct&=0:endif

            endwhile

            else:print " *type?* ";

        endif

    endproc

 
XProfan 11
Computer: Gerät, daß es in Mikrosekunden erlaubt, 50.000 Fehler zu machen, zB 'daß' statt 'das'...
05/24/21  
 




p.specht

Heinz Brill has moreover then the following beigesteuert:
Window Title "H.Brill-Implode for XProfan-11.2a free"
'Program of Heinz Brill, of p.woodpecker to XProfan 11 portiert
CLS:font 2
Declare A$[],B&[],C![],D%[],tmp$[]
A$[] = explode("Hallo,You,there !",",")
tmp$[]=explode("1, 2, 3, 4, 5",",")
setsize B&[],sizeof(tmp$[]):B&[]=val(tmp$[&index])
clear tmp$[]:tmp$[]=explode("1.5, 2.6, 10.7, 15.0, 20.30",",")
setsize C![],sizeof(tmp$[]):c![]=val(tmp$[&index])
clear tmp$[]:tmp$[]=explode("987,654,321",",")
setsize D%[],sizeof(tmp$[]):D%[]=val(tmp$[&index])
clear tmp$[]
print sizeof(A $[]), sizeof(B&[]), sizeof(C![]), sizeof(D%[])
Print "\n Anfang>";Implode(A $[],"|");"<Ende"
Print "\n Anfang>";Implode(B&[],",");"<Ende"
Print "\n Anfang>";Implode(C![]," *** ");"<Ende"
Print "\n Anfang>";IntImplode(D%[],",");"<Ende"
Waitinput
End
 
Computer: Gerät, daß es in Mikrosekunden erlaubt, 50.000 Fehler zu machen, zB 'daß' statt 'das'...
05/28/21  
 




H.Brill
here another kürzere Version, The in Version 11.2 too goes :
Declare A$[], B&[], C![], D$[]
CLS
A$[0] = "Hallo"
A$[1] = "du"
A$[2] =  "Da !"
B&[0] = 1
B&[1] = 2
B&[2] = 3
B&[3] = 4
B&[4] = 5
C![0] = 1.5
C![1] = 2.6
C![2] = 10.7
C![3] = 15.0
C![4] = 20.30
Print Implode(A $[], "-")
Print Implode(B&[], ",")
Print Implode(D$[], "")
Print Implode(C![], ",")
WaitKey

PROC Implode

    CLEARLIST

    Select pType$(1)

        CaseOf  "$[]"

        Parameters B$[], D$
        RETURN IF(MoveArrToList(B$[]), MoveListToStr$(D$), "")

        CaseOf "&[]"

        Parameters B&[], D$
        RETURN If(MoveArrToList(B&[]), MoveListToStr$(D$), "")

        CaseOf "%[]"

        Parameters B%[], D$
        If(MoveArrToList(B%[]), MoveListToStr$(D$), "")

        CaseOf "![]"

        Parameters B![], D$
        Set("Decimals", 2)
        RETURN If(MoveArrToList(B![]), MoveListToStr$(D$), "")

    EndSelect

ENDPROC

End
 
Benutze XPROFAN X3 + FREEPROFAN
Wir sind die XProfaner.
Sie werden von uns assimiliert.
Widerstand ist zwecklos!
Wir werden alle ihre Funktionen und Algorithmen den unseren hinzufügen.

Was die Borg können, können wir schon lange.
10/21/21  
 



Zum Quelltext


Topictitle, max. 100 characters.
 

Systemprofile:

no Systemprofil laid out. [anlegen]

XProfan:

 Posting  Font  Smilies  ▼ 

Please register circa a Posting To verfassen.
 

Topic-Options

2.038 Views

Untitledvor 0 min.
Gast.081508/24/24
Uwe Starke11/17/23
RudiB.03/08/22
p.specht11/18/21
More...

Themeninformationen

this Topic has 2 subscriber:

p.specht (2x)
H.Brill (1x)


Admins  |  AGB  |  Applications  |  Authors  |  Chat  |  Privacy Policy  |  Download  |  Entrance  |  Help  |  Merchantportal  |  Imprint  |  Mart  |  Interfaces  |  SDK  |  Services  |  Games  |  Search  |  Support

One proposition all XProfan, The there's!


My XProfan
Private Messages
Own Storage Forum
Topics-Remember-List
Own Posts
Own Topics
Clipboard
Log off
 Deutsch English Français Español Italia
Translations

Privacy Policy


we use Cookies only as Session-Cookies because of the technical necessity and with us there no Cookies of Drittanbietern.

If you here on our Website click or navigate, stimmst You ours registration of Information in our Cookies on XProfan.Net To.

further Information To our Cookies and moreover, How You The control above keep, find You in ours nachfolgenden Datenschutzerklärung.


all rightDatenschutzerklärung
i want none Cookie