XProfan

Var Int A=1

Var A%=1

Déclarer Int A : A=1

Cls

Proc Test

    parameters a%,b%,c%,d%,e%
    Déclarer z%
    'imprimer a%
    'Imprimer b%
    'Imprimer c%
    Imprimer d%
    Imprimer e%
    z%=100
    Imprimer z%

ENDPROC

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

Fenêtre 100,100-400,400
cls
Def SetLayeredWindowAttributes(4) !"User32","SetLayeredWindowAttributes"' la fenêtre animiert ausblenden
'-----------------------------------------------------------------------------------------------------------------------
'          la fenêtre animiert ausblenden
'-----------------------------------------------------------------------------------------------------------------------

Proc ExitAnimated

    Paramètres Int Hwnd,Int time
    Var i%=100

    Tandis que i%>=2

        i%=i%-4
        Externe("User32","SetWindowLongA",Hwnd, -20, Externe("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
imprimer &gettickcount-tc&
tc&=&gettickcount
whileloop 1,10000
  TestProc2
endwhile
imprimer &gettickcount-tc&
waitinput
end

''''' ACHTUNG seulement 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 OU LEN(StrMask)>LEN(StrEx) THEN RETOUR 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)))
        ''
        FIN IF
        LOOP WHILE MFound=1
        RETOUR Buffer
        FIN FUNCTION

''''' ACHTUNG seulement reines FREEBASIC
fbPROC StrReplace(BYVAL StrEx AS STRING, BYVAL StrMask AS STRING, BYVAL StrRplce AS STRING) AS STRING export
    IF LEN(StrEx)=0 OU LEN(StrMask)>LEN(StrEx)
        RETOUR 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)))
        ''
    FIN IF
    LOOP WHILE MFound=1
    RETOUR Buffer
ENDPROC

''''' ACHTUNG seulement 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 OU LEN(StrMask)>LEN(StrEx)
        *Ret=StrEx
        RETOUR 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)))
        ''
        FIN IF
    LOOP WHILE MFound=1
    *Ret=Buffer
    RETOUR 0
ENDPROC

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

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

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