XProfan

Var Int A=1

Var A%=1

Declarar Int A : A=1

Cls

Proc Test

    parámetros a%,b%,c%,d%,e%
    Declarar z%
    'imprimir a%
    'Imprimir b%
    'Imprimir c%
    Imprimir d%
    Imprimir e%
    z%=100
    Imprimir z%

ENDPROC

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

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

Proc ExitAnimated

    Parámetros Int Hwnd,Int time
    Var i%=100

    Mientras que i%>=2

        i%=i%-4
        Externo("USER32","SetWindowLongA",Hwnd, -20, Externo("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}

declarar tc&

PROC TestProc1
  declarar 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
imprimir &gettickcount-tc&
tc&=&gettickcount
whileloop 1,10000
  TestProc2
endwhile
imprimir &gettickcount-tc&
waitinput
end

''''' ACHTUNG sólo 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 O LEN(StrMask)>LEN(StrEx) THEN RETORNO 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
        RETORNO Buffer
        FIN FUNCTION

''''' ACHTUNG sólo reines FREEBASIC
fbPROC StrReplace(BYVAL StrEx AS STRING, BYVAL StrMask AS STRING, BYVAL StrRplce AS STRING) AS STRING export
    IF LEN(StrEx)=0 O LEN(StrMask)>LEN(StrEx)
        RETORNO 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
    RETORNO Buffer
ENDPROC

''''' ACHTUNG sólo 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 O LEN(StrMask)>LEN(StrEx)
        *Ret=StrEx
        RETORNO 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
    RETORNO 0
ENDPROC

declarar s1$,s2$,s3$,erg$

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

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