XProfan

Var Int A=1

Var A%=1

Declare Int A : A=1

Cls

Proc Test

    parameters a%,b%,c%,d%,e%
    Declare z%
    'print a%
    'Print b%
    'Print c%
    Print d%
    Print e%
    z%=100
    Print z%

Endproc

Test(5,10,15,20,25)
waitinput

Window 100,100-400,400
cls
Def SetLayeredWindowAttributes(4) !"USER32","SetLayeredWindowAttributes"' Fenster animiert ausblenden
'-----------------------------------------------------------------------------------------------------------------------
'          Fenster animiert ausblenden
'-----------------------------------------------------------------------------------------------------------------------

Proc ExitAnimated

    Parameters Int Hwnd,Int time
    Var i%=100

    While i%>=2

        i%=i%-4
        External("USER32","SetWindowLongA",Hwnd, -20, External("USER32","GetWindowLongA",Hwnd,-20) | $80000)
        SetLayeredWindowAttributes(Hwnd, 0, (255 * i%) /100, $2)
        Sleep (time/5)

    EndWhile

    showwindow(Hwnd,0)
    destroywindow(Hwnd)

EndProc

'Hauptprogramm
waitinput
ExitAnimated(%Hwnd,100)

{$NOVAREXCLUDE}

declare tc&

PROC TestProc1
  declare i1%,i2%,i3%,i4%,i5%,i6%,i7%,i8%,i9%,i10%,i11%,i12%,i13%,i14%,i15%,i16%,i17%,i18%,i19%,i20%
ENDPROC

PROC TestProc2
ENDPROC

cls
tc&=&gettickcount
whileloop 1,10000
  TestProc1
endwhile
print &gettickcount-tc&
tc&=&gettickcount
whileloop 1,10000
  TestProc2
endwhile
print &gettickcount-tc&
waitinput
end

''''' ACHTUNG nur reines FREEBASIC
DECLARE FUNCTION StrReplace (BYVAL StrEx AS STRING, BYVAL StrMask AS STRING, BYVAL StrRplce AS STRING) AS STRING
'-----------------------------------------------------------------------------'
FUNCTION StrReplace (BYVAL StrEx AS STRING,BYVAL StrMask AS STRING,BYVAL StrRplce AS STRING) AS STRING

IF LEN(StrEx)=0 OR LEN(StrMask)>LEN(StrEx) THEN RETURN StrEx

    DIM Buffer AS STRING=StrEx
    DIM MaskSearch AS UINTEGER
    DIM MFound AS BYTE
    DIM lp AS UINTEGER=1
    DO
    MaskSearch=INSTR(lp,Buffer,StrMask)
    MFound=0

    IF MaskSearch THEN

        MFound=1:lp=MaskSearch+LEN(StrRplce)
        '''
        Buffer=LEFT(Buffer,MaskSearch-1)+ _
        StrRplce+ _
        RIGHT(Buffer,LEN(Buffer)-(MaskSearch+(LEN(StrMask)-1)))
        ''
        END IF
        LOOP WHILE MFound=1
        RETURN Buffer
        END FUNCTION

''''' ACHTUNG nur reines FREEBASIC
fbPROC StrReplace(BYVAL StrEx AS STRING, BYVAL StrMask AS STRING, BYVAL StrRplce AS STRING) AS STRING export
    IF LEN(StrEx)=0 OR LEN(StrMask)>LEN(StrEx)
        RETURN StrEx
    ENDIF

    DIM Buffer AS STRING=StrEx
    DIM MaskSearch AS UINTEGER
    DIM MFound AS BYTE
    DIM lp AS UINTEGER=1
    DO
    MaskSearch=INSTR(lp,Buffer,StrMask)
    MFound=0

    IF MaskSearch THEN

        MFound=1:lp=MaskSearch+LEN(StrRplce)
        '''
        Buffer=LEFT(Buffer,MaskSearch-1)+ _
        StrRplce+ _
        RIGHT(Buffer,LEN(Buffer)-(MaskSearch+(LEN(StrMask)-1)))
        ''
    END IF
    LOOP WHILE MFound=1
    RETURN Buffer
ENDPROC

''''' ACHTUNG nur reines FREEBASIC
fbPROC StrReplace(BYREF StrEx AS ZSTRING, BYREF StrMask AS ZSTRING, BYREF StrRplce AS ZSTRING, BYVAL Ret AS ZSTRING POINTER) AS INTEGER export

    IF LEN(StrEx)=0 OR LEN(StrMask)>LEN(StrEx)
        *Ret=StrEx
        RETURN 0
    ENDIF

    DIM Buffer AS STRING=StrEx
    DIM MaskSearch AS UINTEGER
    DIM MFound AS BYTE
    DIM lp AS UINTEGER=1
    DO
    MaskSearch=INSTR(lp,Buffer,StrMask)
    MFound=0

    IF MaskSearch THEN

        MFound=1:lp=MaskSearch+LEN(StrRplce)
        '''
        Buffer=LEFT(Buffer,MaskSearch-1)+ _
        StrRplce+ _
        RIGHT(Buffer,LEN(Buffer)-(MaskSearch+(LEN(StrMask)-1)))
        ''
        END IF
    LOOP WHILE MFound=1
    *Ret=Buffer
    RETURN 0
ENDPROC

declare s1$,s2$,s3$,erg$

cls
s1$="Teststring"
s2$="e"
s3$="a"
erg$="12345678901234567890" 'grande genug vordefinieren
StrReplace(@addr(s1$),@addr(s2$),@addr(s3$),@addr(erg$))
print erg$
waitinput
end

Struct Test= Hund&,\
Katze&,\
Maus&,\
Wal&