forum.boolean.name - Исходница

forum.boolean.name (http://forum.boolean.name/index.php)

- Полезные функции (http://forum.boolean.name/forumdisplay.php?f=17)

- - Исходница (http://forum.boolean.name/showthread.php?t=7969)

Исходница

В этой теме предлагаю выкладывать полезные функции, куски кода, математические формулы, которые будут полезны каждому и упростят жизнь среднестатистическому прогеру.

Прошу выкладывать только код, т.е. эта тема посвящена только исходному коду и не затрагивает библиотеки

Ответ: Исходница

Эта функция позволяет манипулировать размером изображения в реальном времени без большой нагрузки на систему

Код:

Global scratch%=CreateImage(100,100) ;картинка для DrawSize

Код:

Function DrawSizeImage(image,x%,y%,w%,h%)

        

    Local ih%=ImageHeight(image)

    Local iw%=ImageWidth(image)



    Local sw%=Abs(w)

    Local sh%=Abs(h)

    

    Local xr#=(Float(iw)/Float(sw))

    Local yr#=(Float(ih)/Float(sh))

    

    fromimg=ImageBuffer(image)

    toimg=ImageBuffer(scratch)

    

    Local vf=-1+((h>0)*2)

    

    Local fw=(w<0)*w

    Local fh=(h<0)*h



    If w>=0

          For ix=0 To sw                      

              CopyRect ix*xr,0,1,ih,ix,0,fromimg,toimg

          Next

    Else

          For ix=0 To sw

                      CopyRect ix*xr,0,1,ih,sw-ix,0,fromimg,toimg

          Next

    EndIf

    



    For iy=0 To sh

          CopyRect 0,iy*yr,sw,1,x+fw,y+(iy*vf),toimg

    Next



End Function

Ответ: Исходница

Несколько полезных математических формул

Вычисление расстояния до объекта:

Код:

2D    Sqr((x1-x2)^2+(y1-y2)^2)

3D    Sqr((x1-x2)^2+(y1-y2)^2+(z1-z2)^2)

Движение одного объекта на другой по прямой траектории (градусы)

Код:

coef=1.4

angle = ATan2(x1,y1) //x1 и y1 -коорд. первого объекта 

x2 = Sin(angle)*coef  

y2 = Cos(angle)*coef

Если нужно переключить переменную типа булеан, но не известно в данный момент значение TRUE или FALSE

Код:

boolvar = 1 - boolvar

Как сделать так чтобы часть кода выполнялась с определенной задержкой т.е. не каждый проход цикла

Код:

zaderjka = 5

if (MilliSecs() /  zaderjka) Mod 2 then ...

Ответ: Исходница

Сегодня понадобилась функция разбиения строки:
Например имеем: 1,2,3,4,5,6,7,8,9,10
Нужно разбить по символу запятой и соответственно поместить всё в массив.

PHP код:




Function Split(mystring$, delimiter$) 
    Local StrLen = Len(mystring$)+1 
    Local start = 1 
    Local t 
     
    mystring = Trim(mystring) 
    delimiter = Mid( delimiter, 1, 1) 
     
    For t=1 To StrLen 
        If Mid(mystring$,t,1)=delimiter Or Mid(mystring$,t,1)="" Then 
            SplitResult(SplitCount)=Trim( Mid( mystring$, start, t-start ) ) 
            SplitCount = SplitCount + 1             
            start=t+1 
        EndIf 
    Next 
End Function

SplitResult - массив с результатами
SplitCount - количество результатов

Простенький примерчик:

PHP код:




test$="0,1,2,3,4,5,6,7,8,9,10,11,12,13" 
 
Split(test$,", ") 
 
Print SplitCount  
For i = 0 To SplitCount 
    Print SplitResult(i) 
Next 
WaitKey 
End

Ответ: Исходница

Рекурсивный пробег по чилдам:

PHP код:




Function SeekChilds(ent)  
    Local i, child 
     
    For i=1 To CountChildren(ent)  
        child=GetChild(ent,i)  
        If child<>0  
            If CountChildren(child)>0 Then SeekChilds(child) 
     ;---> Put code here <---;         
        EndIf  
    Next  
End Function

У чилдов тоже есть чилды. Данная ф-ция прбегает по всей иерархии.
Не раз писалось, но думаю пусть будет и тут тоже.

Область применения:
Например у вас вся игровая локация сделана одной сценой в формате B3d.
Вы хотите поставить точку старта в особом месте или расставить NPC прямо в 3dsmax (или другом пакете 3d моделирования)
Имя каждого чилда вполне подходит для хранения такой информации.
Для обработки каждого чилда можно завести вспомогательную ф-цию:
допустим ApplyChild(child)
где child - хендл чилда.
;---> Put code here <---; в ф-ции SeekChilds(ent) заменим на ApplyChild(child)
У нас получился такой код:

PHP код:




Local LevelMesh = LoadAnimMesh("Level.B3D") ; Загружаем уровень 
SeekChilds(LevelMesh) 
 
Function SeekChilds(ent)  
    Local i, child 
     
    For i=1 To CountChildren(ent)  
        child=GetChild(ent,i)  
        If child<>0  
            If CountChildren(child)>0 Then SeekChilds(child) 
     ApplyChild(child)         
        EndIf  
    Next  
End Function 
 
 
Function ApplyChild(child) 
    Local name$=Lower(EntityName(child)) 
     
    If Instr(name$,"start")>0 Then  
        ; Перемещаем игрока в точку старта 
    EndIf 
     
    If Instr(name$,"shield")>0 Then  
        ; ставим броню в месте этого чилда 
    EndIf 
     
     
    If Instr(name$,"enemy")>0 Then  
        ; ставим врага в месте этого чилда 
    EndIf 
End Function

Позволяет секономить время и использовать пакет 3d моделирования как игровой редактор карт.

Ответ: Исходница

Мышь.
Все знают, что в интерфейсе Windows (да и не только) срабатывание щелчка по кнопке срабатывает в момент отпускания клавиши мыши.
Вот скромная реализация подобного на Blitz3D:

PHP код:




Dim IMMouseUP  (3) 
Dim IMMouseDown(3) 
Dim IMMouseHit (3) 
 
Function IMUpdate() 
    Local i 
    For i=1 To 3 
        IMMouseUP( i )   = IMMouseDown( i ) 
        IMMouseHit( i )  = (MouseHit( i ) > 0) 
        IMMouseDown( i ) = MouseDown( i ) 
     
        If(IMMouseUP( i ) = True And IMMouseDown( i ) = False) 
            IMMouseUP( i ) = True 
        Else 
            IMMouseUP( i ) = False 
        EndIf 
    Next 
End Function

В начало игрового цикла вставляем IMUpdate().
Приставка IM - Input manager (Менеджер ввода)
Вместо MouseDown пишем IMMouseDown
Вместо IMMouseHit пишем IMMouseHit
И конечно IMMouseUP, которая возвращаят True при отпускании кнопки.

Это решает сразу 2 беды.
1) Нет MouseUP
2) Как вы наверное заметили, при повторном вызывании ф-ции MouseHit или MouseDown в цикле функция возвращает False, хотя при первом вызове True. Чтобы этого избежать приходилось заводить глобальные переменные. Теперь это в прошлом.

Ответ: Исходница

Функция выводит текст по буквам (написана для проекта "Часовёнок")

Код:



Dim currenttext$(99)

Dim position(99)

Dim oldtexttime(99)



;...



Function writetext(id,txt$,x,y,delayt)

If position(id)=0 position(id)=1

        If position(id)<=Len(txt) And MilliSecs()-oldtexttime(id)>delayt

                currenttext(id)=currenttext(id)+Mid(txt,position(id),1)

                position(id)=position(id)+1

                oldtexttime(id)=MilliSecs()

        EndIf

        Text(x,y,currenttext(id))

        If position(id)>Len(txt) Return 1

End Function

txt - текст, id - id текста, x,y - координаты, delayt - задержка между выводом букв. Функция возвращает 1, если тект выведен полностью

Пример использования:

Код:

Dim currenttext$(99)

Dim position(99)

Dim oldtexttime(99)



Repeat

        writetext(1,"Привет! :)",20,20,100)

        writetext(2,"Этот текст ниже",20,40,100)

        If writetext(3,"После того, как выведется этот текст",20,60,100)

                writetext(4,"Будет выведен этот",250,60,100)

        EndIf

Until KeyHit(1)



Function writetext(id,txt$,x,y,delayt)

If position(id)=0 position(id)=1

        If position(id)<=Len(txt) And MilliSecs()-oldtexttime(id)>delayt

                currenttext(id)=currenttext(id)+Mid(txt,position(id),1)

                position(id)=position(id)+1

                oldtexttime(id)=MilliSecs()

        EndIf

        Text(x,y,currenttext(id))

        If position(id)>Len(txt) Return 1

End Function

P.S. Если кому-то надо, могу выложить вариант с типами вместо массивов

Ответ: Исходница

Понеслась. Тут функции почти все мои, некоторые переделаны с других языков :)

Функции для работы с base64

Код:

Function base64_encode$(msg$)

    Local alph$="ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/="

    Local i=1

    While i<=Len(msg$)

        If i<=Len(msg$)-2

            c1=Asc(Mid$(msg$,i,1))

            c2=Asc(Mid$(msg$,i+1,1))

            c3=Asc(Mid$(msg$,i+2,1))

            e1=c1 Shr 2

            e2=((c1 And 3) Shl 4) Or (c2 Shr 4)

            e3=((c2 And 15) Shl 2) Or (c3 Shr 6)

            e4=c3 And 63

        Else

            If i=Len(i)-1 Then

                e3=64

                e4=63

            Else 

                e4=64

            EndIf 

        EndIf

        i=i+3

        r$=r$+Mid$(alph$,e1+1,1)+Mid$(alph$,e2+1,1)+Mid$(alph$,e3+1,1)+Mid$(alph$,e4+1,1)

    Wend

    Return r$

End Function 



Function base64_decode$(msg$)

    Local alph$="ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/="

    Local i=1

    While i<=Len(msg$)

        e1=Instr(alph$,Mid$(msg$,i,1))-1

        e2=Instr(alph$,Mid$(msg$,i+1,1))-1

        e3=Instr(alph$,Mid$(msg$,i+2,1))-1

        e4=Instr(alph$,Mid$(msg$,i+3,1))-1

        c1=(e1 Shl 2) Or (e2 Shr 4)

        c2=((e2 And 15) Shl 4) Or (e3 Shr 2)

        c3=((e3 And 3) Shl 6) Or e4

        r$=r$+Chr$(c1)

        If e3<>64 Then

            r$=r$+Chr$(c2)

        EndIf

        If e4<>64 Then

            r$=r$+Chr$(c3)

        EndIf 

        i=i+4

    Wend

    Return r$

End Function

Проверка года на высокосность

Код:

Function isLeapYear(year)

    Local a=year Mod 4

    Local b=year Mod 100

    Local c=year Mod 400

    If (a=0 And b<>0) Or c=0 Then

        Return True

    EndIf 

End Function

Номер дня в году (требует наличия предыдущей функции)

Код:

Function yearDay(day,month,year)

    Local temp#

    If month>2 Then

        temp=month+1

        temp=temp*30.6

        temp=temp-(temp Mod 1)

        temp=temp-(63-isLeapYear(year))

    Else

        temp=month-1

        temp=temp*(63-isLeapYear(year))

        temp=temp/2

        temp=temp-(temp Mod 1)

    EndIf

    temp=temp+day

    Return temp

End Function

Получаем данные максимально поддерживаемого графического режима

Код:

Function maxWidth()

    Return GfxModeWidth(CountGfxModes())

End Function



Function maxHeight()

    Return GfxModeHeight(CountGfxModes())

End Function



Function maxDepth()

    Return GfxModeDepth(CountGfxModes())

End Function

Перевод в юлианские дни

Код:

Function toJulian(day%,month%,year%)

    Local a%,y%,m%

    a=(14-month)/12

    y=year+4800-a

    m=month+12*a-3

    Return day+(153*m+2)/5+365*y+y/4-y/100+y/400-32045

End Function

Функции, возвращающие соответственно день, месяц и год из юлианских дней

Код:

Function julianDay(jd%)

    l=jd+68569

    n=(4*l)/146097

    l=l-(146097*n+3)/4

    i=(4000*(l+1))/1461001

    l=l-(1461*i)/4+31

    j=(80*l)/2447

    d=l-(2447*j)/80

    Return d

End Function



Function julianMonth(jd%)

    l=jd+68569

    n=(4*l)/146097

    l=l-(146097*n+3)/4

    i=(4000*(l+1))/1461001

    l=l-(1461*i)/4+31

    j=(80*l)/2447

    l=j/11

    m=j+2-(12*l)

    Return m

End Function



Function julianYear(jd%)

    l=jd+68569

    n=(4*l)/146097

    l=l-(146097*n+3)/4

    i=(4000*(l+1))/1461001

    l=l-(1461*i)/4+31

    j=(80*l)/2447

    d=l-(2447*j)/80

    l=j/11

    y=100*(n-49)+i+l

    Return y

End Function

RYB -> RGB. Правда, задаёт цвет, а не меняет его. Пригодится, если вы делаете программу, где необходимо смешение цветов как в красках.

Код:

Function setRYB(iR#,iY#,iB#)

    Local x0#,x1#,x2#,x3#,y0#,y1#



    x0=cubicInt(iB,1.0,0.163)

    x1=cubicInt(iB,1.0,0.0)

    x2=cubicInt(iB,1.0,0.5)

    x3=cubicInt(iB,1.0,0.2)

    y0=cubicInt(iY,x0,x1)

    y1=cubicInt(iR,x2,x3)

    red=cubicInt(iR,y0,y1)*255



    x0=cubicInt(iB,1.0,0.373)

    x1=cubicInt(iB,1.0,0.66)

    x2=cubicInt(iB,0.0,0.0)

    x3=cubicInt(iB,0.5,0.094)

    y0=cubicInt(iY,x0,x1)

    y1=cubicInt(iY,x2,x3)

    green=cubicInt(iR,y0,y1)*255



    x0=cubicInt(iB,1.0,0.6)

    x1=cubicInt(iB,0.0,0.2)

    x2=cubicInt(iB,0.0,0.5)

    x3=cubicInt(iB,0.0,0.0)

    y0=cubicInt(iY,x0,x1)

    y1=cubicInt(iY,x2,x3)

    blue=cubicInt(iR,y0,y1)*255



    Color red,green,blue

End Function



Function cubicInt#(t#,a#,b#)

    weight#=t#*t#*(3-2*t#)

    Return a#+weight#*(b#-a#)

End Function

Читаем ID3-теги (первой версии) из MP3

Код:

Function ID3_GetInfo(file$)

    FMusic=ReadFile(file$)

    BInfo=CreateBank(127)

    If Not FMusic Then

        FreeBank BInfo

        Return 0

    EndIf

    If Left$(ReadLine$(FMusic),3)<>"ID3" Then

        CloseFile FMusic

        FreeBank BInfo

        Return 0

    EndIf

    SeekFile FMusic,FileSize(file$)-128

    For i=0 To 126

        PokeByte BInfo,i,ReadByte(FMusic)

    Next

    For i=0 To 2

        STag$=STag$+Chr$(PeekByte(BInfo,i))

    Next

    If STag$<>"TAG" Then

        CloseFile FMusic

        FreeBank BInfo

        Return 0

    EndIf

    CloseFile FMusic

    Return BInfo

End Function



Function ID3_GetTitle$(BInfo)

    For i=3 To 30

        IByte=PeekByte(BInfo,i)

        If IByte<>0 Then

            STitle$=STitle$+Chr$(IByte)

        Else

            If Len(STitle$)>0 Then

                Return STitle$

            Else

                Return 0

            EndIf 

        EndIf 

    Next 

End Function



Function ID3_GetInterpreter$(BInfo)

    For i=33 To 63

        IByte=PeekByte(BInfo,i)

        If IByte<>0 Then

            SInterpreter$=SInterpreter$+Chr$(IByte)

        Else

            If Len(SInterpreter$)>0 Then

                Return SInterpreter$

            Else

                Return 0

            EndIf 

        EndIf 

    Next 

End Function



Function ID3_GetAlbum$(BInfo)

    For i=63 To 93

        IByte=PeekByte(BInfo,i)

        If IByte<>0 Then

            SAlbum$=SAlbum$+Chr$(IByte)

        Else

            If Len(SAlbum$)>0 Then

                Return SAlbum$

            Else

                Return 0

            EndIf 

        EndIf 

    Next 

End Function



Function ID3_GetYear$(BInfo)

    For i=93 To 96

        IByte=PeekByte(BInfo,i)

        If IByte>=48 And IByte<=57 Then 

            SYear$=SYear$+Chr$(IByte)

        Else

            Return 0

        EndIf 

    Next

    Return SYear$

End Function



Function ID3_GetComment$(BInfo)

    For i=97 To 127

        IByte=PeekByte(BInfo,i)

        If IByte<>0 Then

            SComment$=SComment$+Chr$(IByte)

        Else

            If Len(SComment$)>0 Then

                Return SComment$

            Else

                Return 0

            EndIf 

        EndIf 

    Next 

End Function

HTTP-запрос. Поддерживает перенаправления :)

Код:

Function httpGetRequest$(http_url$)

    If Left$(http_url$,7)="http://" Then

        http_url$=Mid$(http_url$,8)

    EndIf

    If Instr(http_url$,"/") Then

        http_host$=Left$(http_url$,Instr(http_url$,"/")-1)

        http_file$=Mid$(http_url$,Instr(http_url$,"/"))

    Else

        http_host$=http_url$

        http_file$="/"

    EndIf

    http_stream=OpenTCPStream(http_host$,80)

    If Not http_stream Then Return 0

    WriteLine http_stream,"GET "+http_file$+" HTTP/1.1"

    WriteLine http_stream,"Host: "+http_host$

    WriteLine http_stream,"Connection: close"

    WriteLine http_stream,""

    Repeat

        Delay 1

    Until ReadAvail(http_stream)<>0

    

    Repeat

        http_header$=ReadLine(http_stream)

        If Left(http_header$,9)="Location:"

            If Mid(http_header$,11,4)="http" Then

                Return httpGetRequest(Mid$(http_header$,11))

            Else

                Return httpGetRequest("http://"+http_host$+Mid$(http_header$,11))

            EndIf 

        EndIf 

    Until http_header$=""

    While Not Eof(http_stream)

        http_res$=http_res$+Chr$(ReadByte(http_stream))

    Wend

    

    res$=http_res$

    Return res$

End Function

Скачивание файла по HTTP. Также поддерживает перенаправление

Код:

Function httpGetFile(http_url$,savename$)

    If Left$(http_url$,7)="http://" Then

        http_url$=Mid$(http_url$,8)

    EndIf

    If Instr(http_url$,"/") Then

        http_host$=Left$(http_url$,Instr(http_url$,"/")-1)

        http_file$=Mid$(http_url$,Instr(http_url$,"/"))

    Else

        http_host$=http_url$

        http_file$="/"

    EndIf

    http_stream=OpenTCPStream(http_host$,80)

    If Not http_stream Then Return 0

    WriteLine http_stream,"GET "+http_file$+" HTTP/1.1"

    WriteLine http_stream,"Host: "+http_host$

    WriteLine http_stream,"Connection: close"

    WriteLine http_stream,""

    Repeat

        Delay 1

    Until ReadAvail(http_stream)<>0

    

    Repeat

        http_header$=ReadLine(http_stream)

        If Left(http_header$,9)="Location:"

            If Mid(http_header$,11,4)="http" Then

                Return httpGetFile(Mid$(http_header$,11),savename$)

            Else

                Return httpGetFile("http://"+http_host$+Mid$(http_header$,11),savename$)

            EndIf 

        EndIf 

    Until http_header$=""

    

    http_result=WriteFile(savename$)

    

    While Not Eof(http_stream)

        WriteByte http_result,ReadByte(http_stream)

    Wend



    CloseFile http_result

End Function

Получение unixtime из текущего и заданого времени:

Код:

Function unixtime()

    day=Int(CurrentDate$())

    year=Int(Right$(CurrentDate$(),4))

    Select Mid$(CurrentDate$(),4,3)

        Case "Jan"

            month=1

        Case "Feb"

            month=2

        Case "Mar"

            month=3

        Case "Apr"

            month=4

        Case "May"

            month=5

        Case "Jun"

            month=6

        Case "Jul"

            month=7

        Case "Aug"

            month=8

        Case "Sep"

            month=9

        Case "Oct"

            month=10

        Case "Nov"

            month=11

        Case "Dec"

            month=12

    End Select

    hour=Int(CurrentTime$())

    minute=Int(Mid(CurrentTime$(),4,2))

    second=Int(Right(CurrentTime$(),2))

    a=(14-month)/12

    y=year+4800-a

    m=month+12*a-3

    temp=day+(153*m+2)/5+365*y+y/4-y/100+y/400-32045

    temp=(temp-2440588)*24*60*60

    temp=temp+60*60*hour+60*minute+second

    Return temp

End Function



Function time(day,month,year,hour=0,minute=0,second=0)

    a=(14-month)/12

    y=year+4800-a

    m=month+12*a-3

    temp=day+(153*m+2)/5+365*y+y/4-y/100+y/400-32045

    temp=(temp-2440588)*24*60*60

    temp=temp+60*60*hour+60*minute+second

    Return temp

End Function

Создаёт квадратное поле размера w на h с шириной квадратной ячейки в sz

Код:

Function createField(w%,h%,sz#=1.0)

    m=CreateMesh()

    s=CreateSurface(m)

    For i=-h/2 To h/2

        For j=-h/2 To w/2

            sv#=(1/Float(w))*Float(i)

            su#=(1/Float(h))*Float(j)

            v=AddVertex(s,i*sz#,0,j*sz#,su#,sv#)

        Next 

    Next

    For i=0 To h-1

        For j=0 To w-1

            v1=i*(w+1)+j

            v2=i*(w+1)+j+1

            v3=i*(w+1)+j+w+1

            v4=i*(w+1)+j+w+2

            t1=AddTriangle(s,v1,v2,v3)

            t2=AddTriangle(s,v3,v2,v4)

        Next 

    Next

    UpdateNormals m

    Return m

End Function

Вот вроде бы и всё, если откопаю среди своего го.. добра еще что-нибудь - выложу :)

Ответ: Исходница

Преобразование short (2байта), засейвенного в 4-байтовом блитцевском int-е, в адекватный 4-байтовый блитцевский же инт.

Код:

Function Short2Int%(a%)

        Local M1%=%00000000000000001000000000000000

        Local M2%=%11111111111111110000000000000000

        Local D%=a And M1

        If D

                a = a Xor M2

        EndIf

        Return a

End Function

Например вы получили от DLL банку с шортами, и делаете что-то типа:

Цитата:

PeekShort...

в инт. И на выходе - дурь, а надо делать особую магию:

Цитата:

Short2Int(PeekShort...

И тогда, наверняка, вдруг запашет прога та

Ответ: Исходница

Ну чочо, продолжим:

Чётность:

PHP код:




Function IsOdd( value ) 
    If value =0 Then Return 0 
     
    If Float( value Mod 2 ) <>0 Then Return 1 Else Return 0 
End Function

HEX в INT:

PHP код:




Function Hex2Int%(h$) 
    Local z,i 
     
    Local t2$= Upper$(Trim$(h$)) 
    Local d% = 0 
     
    For z = 1 To Len(t2$) 
        i = Instr("0123456789ABCDEF",Mid$(t2$,z,1)) 
        If (i > 0) Then d = d * 16 + i - 1 
    Next 
    Return d 
End Function

Узнать размер куба, в который вписан меш.
Когда пользовался PhysX`ом функция была дико полезна.

PHP код:




Global EntityBoxX#, EntityBoxY#, EntityBoxZ# 
Function GetEntityBox(ent, recursive = True, root = 0) 
If root = 0 Then 
    EntityBoxX# = 0 
    EntityBoxY# = 0 
    EntityBoxZ# = 0 
Else 
    ox# = EntityX(ent, True) - EntityX(root, True) 
    oy# = EntityY(ent, True) - EntityY(root, True) 
    oz# = EntityZ(ent, True) - EntityZ(root, True) 
EndIf 
cnt_surf = CountSurfaces(ent) 
For s = 1 To cnt_surf 
    surf = GetSurface(ent, s) 
    cnt_verts = CountVertices(surf) - 1 
    For v = 0 To cnt_verts 
        vx# = Abs(VertexX(surf, v) + ox#) 
        vy# = Abs(VertexY(surf, v) + oy#) 
        vz# = Abs(VertexZ(surf, v) + oz#) 
        If (vx# > EntityBoxX#) Then EntityBoxX# = vx# 
        If (vy# > EntityBoxY#) Then EntityBoxY# = vy# 
        If (vz# > EntityBoxZ#) Then EntityBoxZ# = vz# 
    Next 
Next 
If recursive Then 
    If root = 0 Then root = ent 
    cnt_children = CountChildren(ent) 
    For i = 1 To cnt_children 
        GetEntityBox(GetChild(ent, i), True, root) 
    Next 
EndIf 
End Function

Ответ: Исходница

Позвольте не согласиться с первой реализацией: чётность проверяется сравнением последнего бита с 0.
Нужно битово домножить число на маску 00000000 00000000 00000000 00000001 а затем результат сравнить с 0. Если =0, то число чётное (т.е. можно сразу return (value and mask) ).
В этой реализации нет долгих арифметических операций (тем паче деления!) и не надо реализовывать отдельную проверку для 0.
(б3д под рукой нет)

А так - занятные фунЕции

Ответ: Исходница

Порт (реализация средствами б3д) функции из темы http://forum.boolean.name/showthread.php?t=9230 ( www.boolean.name > Программирование игр для компьютеров > C++ : Проверка: является ли строка числом?)
Проверка: является ли текст в строке числом.

Код:

Function CheckIsNum%(S$)

        Local sDIGIT%=1

        Local sEXP%=2

        Local sSEP%=3

        Local sSIGN%=4

        Local sETC%=5

        Local Key%

        Local i%

        Local b%

        Local Epos%=-1

        Local Spos%=-1

        Local ExitFlag%=True

        Local cLEN%=Len(S)

        For i=1 To cLEN

                If Not ExitFlag

                        Exit

                EndIf

                b=Asc(Mid(S,i,1))

                If b>=Asc("0") And b<=Asc("9")

                        Key=sDIGIT

                ElseIf b=Asc("E") Or b=Asc("e")

                        Key=sEXP

                ElseIf b=Asc(".") Or b=Asc(",")

                        Key=sSEP

                ElseIf b=Asc("+") Or b=Asc("-")

                        Key=sSIGN

                Else

                        Key=sETC

                EndIf

                Select Key

                        Case sDIGIT

                                ;

                        Case sEXP

                                If Epos<>-1

                                        ExitFlag=False

                                Else

                                        Epos=i

                                EndIf

                        Case sSEP

                                If Spos<>-1

                                        ExitFlag=False

                                Else

                                        Spos=i

                                EndIf

                        Case sSIGN

                                If i<>1 And Epos<>i-1

                                        ExitFlag=False

                                EndIf

                        Case sETC

                                ExitFlag=False

                End Select

        Next

        Return ExitFlag

End Function



Q$="ололо"

DebugLog Q+" "+CheckIsNum(Q)

Q$="15445.1"

DebugLog Q+" "+CheckIsNum(Q)

Q$="12БЛДЖАД!"

DebugLog Q+" "+CheckIsNum(Q)

Q$="123.345E-12"

DebugLog Q+" "+CheckIsNum(Q)

Q$="23.2gh465E-1"

DebugLog Q+" "+CheckIsNum(Q)

Q$="23.2465E-1"

DebugLog Q+" "+CheckIsNum(Q)

Q$="sdgf23.2465E-1"

DebugLog Q+" "+CheckIsNum(Q)

Q$="1+1"

DebugLog Q+" "+CheckIsNum(Q)

Q$="+.12E-008"

DebugLog Q+" "+CheckIsNum(Q)

Q$="+.12E-008.1"

DebugLog Q+" "+CheckIsNum(Q)

Ответ: Исходница

UPD функции, согласно посту №28 из темы
http://forum.boolean.name/showthread.php?t=9230 ( www.boolean.name > Программирование игр для компьютеров > C++ : Проверка: является ли строка числом?)
Проверка: является ли текст в строке числом.
http://forum.boolean.name/showpost.p...2&postcount=28

Код:

Function CheckIsNum%(S$)

        Local sDIGIT%=1

        Local sEXP%=2

        Local sSEP%=3

        Local sSIGN%=4

        Local sETC%=5

        Local Key%

        Local i%

        Local b%

        Local Epos%=-1

        Local Spos%=-1

        Local ExitFlag%=True

        Local IsClose%=False

        Local cLEN%=Len(S)

        For i=1 To cLEN

                If Not ExitFlag

                        Exit

                EndIf

                b=Asc(Mid(S,i,1))

                If b>=Asc("0") And b<=Asc("9")

                        Key=sDIGIT

                ElseIf b=Asc("E") Or b=Asc("e")

                        Key=sEXP

                ElseIf b=Asc(".") Or b=Asc(",")

                        Key=sSEP

                ElseIf b=Asc("+") Or b=Asc("-")

                        Key=sSIGN

                Else

                        Key=sETC

                EndIf

                IsClose=False

                Select Key

                        Case sDIGIT

                                IsClose=True

                        Case sEXP

                                If Epos<>-1

                                        ExitFlag=False

                                Else

                                        Epos=i

                                EndIf

                        Case sSEP

                                If Spos<>-1

                                        ExitFlag=False

                                Else

                                        Spos=i

                                EndIf

                        Case sSIGN

                                If i<>1 And Epos<>i-1

                                        ExitFlag=False

                                EndIf

                        Case sETC

                                ExitFlag=False

                End Select

        Next

        If Not IsClose

                ExitFlag=False

        EndIf

        Return ExitFlag

End Function



Q$="ололо"

DebugLog Q+" "+CheckIsNum(Q)

Q$="15445.1"

DebugLog Q+" "+CheckIsNum(Q)

Q$="12БЛДЖАД!"

DebugLog Q+" "+CheckIsNum(Q)

Q$="123.345E-12"

DebugLog Q+" "+CheckIsNum(Q)

Q$="23.2gh465E-1"

DebugLog Q+" "+CheckIsNum(Q)

Q$="23.2465E-1"

DebugLog Q+" "+CheckIsNum(Q)

Q$="sdgf23.2465E-1"

DebugLog Q+" "+CheckIsNum(Q)

Q$="1+1"

DebugLog Q+" "+CheckIsNum(Q)

Q$="+.12E-008"

DebugLog Q+" "+CheckIsNum(Q)

Q$="+.12E-008.1"

DebugLog Q+" "+CheckIsNum(Q)

Q$="E"

DebugLog Q+" "+CheckIsNum(Q)

Q$=""

DebugLog Q+" "+CheckIsNum(Q)

Q$="+"

DebugLog Q+" "+CheckIsNum(Q)

Q$="-"

DebugLog Q+" "+CheckIsNum(Q)

Q$="."

DebugLog Q+" "+CheckIsNum(Q)

Ответ: Исходница