forum.boolean.name - ButtonSystem

Вот сделал кнопки (для собственных нужд) и решил выложить. Вроде все просто и удобно:

Код:

;Разработано Michael, 14.09.2006

 

Global ButtonID,mdown

 

Type button

 Field normal,active,down

 Field x,y

 Field width,height

 Field id

End Type 

 

Function CreateButton(normalimage$,activeimage$,downimage$,x,y)

 but.button=New button

 

 but\normal=LoadImage(normalimage$)

 but\active=LoadImage(activeimage$)

 but\down=LoadImage(downimage$)

 

 but\x=x

 but\y=y

 

 but\width=ImageWidth(but\normal)

 but\height=ImageHeight(but\normal)

 

 ButtonID=ButtonID+1

 but\id=ButtonID

 Return but\id

End Function

 

Function UpdateButtons()

 Local ID

 If MouseHit(1) mhit=True

 For but.button=Each button

  If RectsOverlap(MouseX(),MouseY(),1,1,but\x,but\y,but\width,but\height) Then

  If mdown=True Then

    If MouseDown(1)

    DrawImage but\down,but\x,but\y

    Else

    DrawImage but\active,but\x,but\y

    mdown=False

    ID=but\id

    EndIf

  Else

    If MouseDown(1)

    DrawImage but\down,but\x,but\y

    mdown=True

    Else

    DrawImage but\active,but\x,but\y

    EndIf

  EndIf

  Else

  DrawImage but\normal,but\x,but\y

  EndIf

 Next

 Return ID

End Function

 

Function DeleteButton(ButID)

 For but.button=Each button

  If but\id=ButID Then

  FreeImage but\normal

  FreeImage but\active

  FreeImage but\down

  Delete but

  Return

  EndIf

 Next

End Function

Пример использования:
ExitButton=Createbutton("normal.bmp","active.bmp", "down.bmp",100,100)
...
Repeat
...
event=Updatebutton()
If event=ExitButton end
...
Until KeyHit(1)
End

P.S. Для проверки нажатия кнопки используется система типа Windows, т.е. кнопка срабатывает при отпускании кнопки мыши, а не сразу при нажатие. Можно заменить на просто MouseHit(1);) ...

P.P.S. Подразумевается что все картинки для кнопок ОДИНАКОВОГО размера (размер определяется для первой картинки (but\Normal))...