Тема: ButtonSystem
Показать сообщение отдельно
Старый 14.09.2006, 23:05   #1
MiXaeL
Бывалый
 
Аватар для MiXaeL
 
Регистрация: 22.08.2006
Сообщений: 700
Написано 146 полезных сообщений
(для 267 пользователей)
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))...
(Offline)
 
Ответить с цитированием