Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!fb:porticula NoPaste
UDT um einfach Buttons zu erstellen (erste Version)
| Uploader: |  DonStevone |
| Datum/Zeit: | 30.09.2011 13:35:34 |
Type ButtUDT
X as Integer
Y as Integer
ButtWidth as Integer
ButtHeight as Integer
BColor as UInteger
TColor as UInteger
Text as String
ButtIMG as Any PTR
Thread as Any PTR
ID as String
ExtEvent as Sub(ID as String)
ShowStop as Byte
Declare Constructor()
Declare Constructor(ButtID as String, Event as Sub(ID as String), _
ButtX as Integer, ButtY as Integer, _
FileName as String)
Declare Constructor(ButtID as String, Event as Sub(ID as String), _
ButtX as Integer, ButtY as Integer, _
TextX as Integer, TextY as Integer, _
ButtText as String, BWidth as Integer, BHeight as Integer)
Declare Constructor(ButtID as String, Event as Sub(ID as String), _
ButtX as Integer, ButtY as Integer, _
TextX as Integer, TextY as Integer, _
ButtText as String, BWidth as Integer, BHeight as Integer, _
BackgroundColor as UInteger, TextColor as UInteger)
Declare Destructor
Declare Sub Show()
Declare Static Sub G(ByVal ThisButt as ButtUDT)
Declare Function GetX() as Integer
Declare Function GetY() as Integer
Declare Function GetIMG() as Any PTR
Declare Function GetStop() as Byte
Declare Function GetID() as String
Declare Function GetCallback() as Sub(ID as String)
Declare Sub GetSize(ByVal Dateiname as String, ByRef Breite as UInteger, ByRef Hoehe as UInteger)
Declare Sub Hide()
End Type
'###############################################################################
Constructor ButtUDT()
End Constructor
'###############################################################################
Constructor ButtUDT(ButtID as String, Event as Sub(ID as String), _
ButtX as Integer, ButtY as Integer, _
FileName as String)
ID = ButtID
ExtEvent = Event
X = ButtX
Y = ButtY
This.GetSize(FileName, ButtWidth, ButtHeight)
ButtIMG = Imagecreate(ButtWidth, ButtHeight)
BLoad FileName, ButtIMG
If ButtIMG = 0 then ?"Something went wrong while loading File in: Constructor ButtUDT(ButtID as String, Event as Sub(ID as String), ButtX as Integer, ButtY as Integer, FileName as String)"
End Constructor
'###############################################################################
Constructor ButtUDT(ButtID as String, Event as Sub(ID as String), _
ButtX as Integer, ButtY as Integer, _
TextX as Integer, TextY as Integer, _
ButtText as String, BWidth as Integer, BHeight as Integer)
ID = ButtID
ExtEvent = Event
X = ButtX
Y = ButtY
ButtWidth = BWidth
ButtHeight = BHeight
BColor = &h0000FF
TColor = &h000000
Text = ButtText
ButtIMG = Imagecreate(ButtWidth, ButtHeight, BColor, 32)
Draw String ButtIMG, (TextX, TextY), Text, TColor
End Constructor
'###############################################################################
Constructor ButtUDT(ButtID as String, Event as Sub(ID as String), _
ButtX as Integer, ButtY as Integer, _
TextX as Integer, TextY as Integer, _
ButtText as String, BWidth as Integer, BHeight as Integer, _
BackgroundColor as UInteger, TextColor as UInteger)
ID = ButtID
ExtEvent = Event
X = ButtX
Y = ButtY
ButtWidth = BWidth
ButtHeight = BHeight
BColor = Backgroundcolor
TColor = TextColor
Text = ButtText
ButtIMG = Imagecreate(ButtWidth, ButtHeight, BColor, 32)
Draw String ButtIMG, (TextX, TextY), Text, TColor
End Constructor
'###############################################################################
Destructor ButtUDT
Deallocate ButtIMG
End Destructor
'###############################################################################
Sub ButtUDT.Show()
ShowStop = 0
Thread = Threadcreate(Cast(Any PTR, @ButtUDT.G), @This)
End Sub
'###############################################################################
Static Sub ButtUDT.G(ByVal ThisButt as ButtUDT)
Static ID as String
Static ButtIMG as Any PTR
Static X as Integer
Static Y as Integer
Static ShowStop as Byte
Static ButtWidth as Integer
Static ButtHeight as Integer
Static MX as Integer
Static MY as Integer
Static MB as Integer
Static EEvent as Sub(ID as String)
ID = ThisButt.GetID()
X = ThisButt.GetX()
Y = ThisButt.GetY()
ButtIMG = ThisButt.GetIMG()
ImageInfo ButtIMG, ButtWidth, ButtHeight
EEvent = ThisButt.GetCallback()
While(ShowStop = 0)
If ThisButt.GetStop() = 1 then EXIT While
Put (X, Y), ButtIMG, ALPHA, 255
GetMouse(MX, MY,, MB)
If MX > X and MX < X + ButtWidth and MY > Y and MY < Y + ButtHeight and MB = 1 then EEvent(ID)
Sleep 10
Wend
End Sub
'###############################################################################
Function ButtUDT.GetX() as Integer
Return X
End Function
'###############################################################################
Function ButtUDT.GetY() as Integer
Return Y
End Function
'###############################################################################
Function ButtUDT.GetIMG() as Any PTR
Return ButtIMG
End Function
'###############################################################################
Sub ButtUDT.GetSize(ByVal Dateiname as String, ByRef Breite as UInteger, ByRef Hoehe as UInteger)
Dim as UByte B1, B2
Dim as Integer File = Freefile
Dim as UInteger B, H
Open Dateiname for Input as File
Get #File,, B1
Get #File,, B2
If B1 <> 66 and B2 <> 77 then
Hoehe = 0
Breite = 0
Else
Seek File, 19
Get #File,, B
Seek File, 23
Get #File,, H
Breite = B
Hoehe = H
Endif
End Sub
'###############################################################################
Function ButtUDT.GetStop() as Byte
Return ShowStop
End Function
'###############################################################################
Sub ButtUDT.Hide()
ShowStop = 1
End Sub
'###############################################################################
Function ButtUDT.GetID() as String
Return ID
End Function
'###############################################################################
Function ButtUDT.GetCallback() as Sub(ID as String)
Return ExtEvent
End Function
'###############################################################################
Screenres 1024, 768, 32
Declare Sub Butt1(ID as String)
Dim Shared as ButtUDT PTR Butt
Butt = NEW ButtUDT("Butt1", @Butt1, 10, 10, 2, 2, "Test", 40, 10, &hFFFFFF, &h000000)
Butt->Show()
While(NOT Multikey(&h01))
Sleep 10
Wend
Sub Butt1(ID as String)
Butt->Hide()
CLS
End Sub