Buchempfehlung
Windows System Programming
Windows System Programming
Das Kompendium liefert viele interessante Informationen zur Windows-Programmierung auf Englisch. [Mehr Infos...]
FreeBASIC-Chat
Es sind Benutzer im FreeBASIC-Chat online.
(Stand:  )
FreeBASIC bei Twitter
Twitter FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!

fb:porticula NoPaste

Info
Info / Hilfe
Liste
Übersicht / Liste
Neu
Datei hochladen
Suche
Quellcode suchen
Download
Dateidownload

DeGUI - Versuch einer kleinen GUI

Uploader:MitgliedDonStevone
Datum/Zeit:31.10.2011 17:22:52

'    =======================================================================
'    =                                                                     =
'    =             DeGUI - Damn easy - Graphical user interface            =
'    =                                                                     =
'    =             Autor  : Steven Mahnke alias DonStevone                 =
'    =             Datum  : 31.10.2011                                     =
'    =             Lizens : FreeBASIC-Portal-Standartlizenz(FBPSL)         =
'    =             Version: 1.0                                            =
'    =                                                                     =
'    =======================================================================

'    =======================================================================
'    =                                Button                               =
'    =======================================================================
'
'    Declare Constructor(ButtID as String, Event as Sub(ID as String), _
'                        ButtX as Integer, ButtY as Integer, _
'                        FileName as String, FileName2 as String)
'
'   -ButtID ist die ID die an das Event übergeben wird sobalt der Button geklickt wurde
'   -Event ist ein Handle auf eine Sub
'   -ButtX und ButtY sind die Koordinaten der linken oberen Ecke
'   -FileName ist der Name einer BMP welche als Button verwendet werden soll
'   -FileName2 ist der Name einer BMP welche als Button verwendet werde soll, aber nur
'       dann angezeigt wird wenn sich der Mauszeiger über dem Button befindet
'
'
'    Declare Constructor(ButtID as String, Event as Sub(ID as String), _
'                        ButtX as Integer, ButtY as Integer, _
'                        FileName as String)
'
'   -Siehe ersten Constructor - Unterschied: Hier wird kein alternativer Button angezeigt,
'       wenn man mit der Maus über diesen geht
'
'
'    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)
'
'   -Hier wird ein 'Standart Button verwendet (Ohne Bild)
'   -TextX ist die XKoordinate innerhalb des Buttons an der der Text stehen soll
'   -TextY ist die YKoordinate innerhalb des Buttons an der der Text stehen soll
'   -ButtText ist ein Text welcher auf dem Button stehen soll
'   -BWidth ist die Breite die der Button haben soll
'   -BHeight ist die Höhe die der Button haben soll
'
'
'    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)
'
'   -Siehe Constructor 3 - Unterschied: Mit Backgroundcolor und TextColor können noch die
'                          Farben des Buttons und des Textes bestimmt werden
'
'
'
'   Methoden:
'
'   Hide()
'   Versteckt den Button
'
'   Show()
'   Zeigt den Button
'
'   Control() !Wichtig
'   Steuerung des Buttons
'
'   GClear()
'   Überzeichnet den Button mit einer schwarzen Box
'
'   G() ! Wichtig
'   Zeichnet den Button
'
'
'
'   ========================================================================
'   =                              TextField                               =
'   ========================================================================
'
'   Declare Constructor(XPos as Integer, YPos as Integer, Laenge as Integer)
'
'   XPos ist die XKoordinate der linken oberen Ecke
'   YPos ist die YKoordinate der linken oberen Ecke
'   Laenge ist die maximale Anzahl an Zeichen innerhalb der Textbox
'
'   Declare Constructor(XPos as Integer, YPos as Integer, Laenge as Integer, SText as String)
'
'   Siehe Constructor 1 - Unterschied: Mit SText kann ein String vordefiniert werden,
'       der in der Textbox angezeigt werden soll
'
'
'
'   Methoden:
'
'   Hide()
'   Versteckt die Textbox
'
'   Show()
'   Zeigt die Textbox
'
'   Control() !Wichtig!
'   Steuerung der Textbox
'
'   GClear()
'   Überzeichnet die Textbox mit einer schwarzen Box
'
'   G() ! Wichtig
'   Zeichnet die Textbox
'
'
'
'   Public Attribute:
'   Text as String - Das ist die Stringvariable in der der Text innerhalb der Textbox steht
'
'
'
'   ========================================================================
'   =                               Label                                  =
'   ========================================================================
'
'   Declare Constructor(XPos as Integer, YPos as Integer, SText as String)
'
'   XPos ist die XKoordinate der linken oberen Ecke des Labels
'   YPos ist die YKoordinate der linken oberen Ecke des Labels
'   SText ist der Text welcher auf dem Label steht
'
'   Methoden:
'
'   Hide()
'   Versteckt das Label
'
'   Show()
'   Zeigt das Label
'
'   GClear()
'   Überzeichnet das Label mit einer schwarzen Box
'
'   G()
'   Zeichnet das Label
'
'
'
'   ========================================================================
'   =                                Checkbox                              =
'   ========================================================================
'
'   Declare Constructor(XPos as Integer, YPos as Integer, CheckID as String, Event as Sub(ID as String))
'
'   XPos ist die XKoordinate der linken oberen Ecke der Checkbox
'   YPos ist die YKoordinate der linken oberen Ecke der Checkbox
'   CheckID ist die ID die an das Event übergeben wird sobalt sich der Status der Checkbox geändert hat
'   Event ist ein Handle auf eine Sub
'
'   Methoden:
'
'   Hide()
'   Versteckt die Checkbox
'
'   Show()
'   Zeigt die Checkbox
'
'   Control() !Wichtig!
'   Steuerung der Checkbox
'
'   GClear()
'   Überzeichnet die Checkbock mit einer schwarzen Box
'
'   G()
'   Zeichnet die Checkbox
'
'   Public Attribute:
'
'   Checked as Byte - Aktueller Status der Checkbox

Type Button
    Private:
    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
    ButtIMG2    as Any PTR
    Thread      as Any PTR
    ID          as String
    ExtEvent    as Sub(ID as String)
    ButtType    as Byte
    H           as Byte
    MOver       as Byte

    Declare Sub GetSize(ByVal Dateiname as String, ByRef Breite as UInteger, ByRef Hoehe as UInteger)

    Public:
    Declare Constructor(ButtID as String, Event as Sub(ID as String), _
                        ButtX as Integer, ButtY as Integer, _
                        FileName as String, FileName2 as String)
    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 Hide()
    Declare Sub Show()
    Declare Sub Control()
    Declare Sub GClear(BgColor as UByte)
    Declare Sub G()
End Type

'###############################################################################
Constructor Button(ButtID as String, Event as Sub(ID as String), _
                    ButtX as Integer, ButtY as Integer, _
                    FileName as String, FileName2 as String)

    ID = ButtID
    ExtEvent = Event
    X = ButtX
    Y = ButtY
    ButtType = 1

    GetSize(FileName, ButtWidth, ButtHeight)
    ButtIMG = Imagecreate(ButtWidth, ButtHeight)
    BLoad FileName, ButtIMG
    GetSize(FileName2, ButtWidth, ButtHeight)
    ButtIMG2 = Imagecreate(ButtWidth, ButtHeight)
    BLoad FileName2, ButtIMG2
    If ButtIMG  = 0 then ?!"Something went wrong while loading File in: Constructor Button(ButtID as String, Event as Sub(ID as String), ButtX as Integer, ButtY as Integer, FileName as String)\nAre you sure this was the correct filename?"
    If ButtIMG2 = 0 then ?!"Something went wrong while loading File in: Constructor Button(ButtID as String, Event as Sub(ID as String), ButtX as Integer, ButtY as Integer, FileName as String)\nAre you sure this was the correct filename?"
End Constructor

'###############################################################################
Constructor Button(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
    ButtType = 1

    GetSize(FileName, ButtWidth, ButtHeight)
    ButtIMG = Imagecreate(ButtWidth, ButtHeight)
    BLoad FileName, ButtIMG
    If ButtIMG = 0 then ?!"Something went wrong while loading File in: Constructor Button(ButtID as String, Event as Sub(ID as String), ButtX as Integer, ButtY as Integer, FileName as String)\nAre you sure this was the correct filename?"
End Constructor

'###############################################################################
Constructor Button(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)
    ButtIMG2    = Imagecreate(ButtWidth, ButtHeight, TColor, 32)

    Draw String ButtIMG, (TextX, TextY), Text, TColor
    Draw String ButtIMG2, (TextX, TextY), Text, BColor
End Constructor

'###############################################################################
Constructor Button(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)
    ButtIMG2    = Imagecreate(ButtWidth, ButtHeight, TColor, 32)

    Draw String ButtIMG, (TextX, TextY), Text, TColor
    Draw String ButtIMG2, (TextX, TextY), Text, BColor
End Constructor

'###############################################################################
Destructor Button
    Deallocate ButtIMG
End Destructor

'###############################################################################
Sub Button.G()
    If H = 0 then
        If MOver = 1 and ButtIMG2 <> 0 then Put (X, Y), ButtIMG2, ALPHA, 255
        If MOver = 0 then Put (X, Y), ButtIMG, ALPHA, 255
    Endif
End Sub

'###############################################################################
Sub Button.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

'###############################################################################
Sub Button.Hide()
    H = 1
End Sub

'###############################################################################
Sub Button.Show()
    H = 0
End Sub

'###############################################################################
Sub Button.Control()
    Dim as Integer MX, MY, MB

    If H = 0 then
        GetMouse(MX, MY,, MB)
        If MX > X and MX < X + ButtWidth and MY > Y and MY < Y + ButtHeight then
            MOver = 1
            IF MB = 1 then ExtEvent(ID)
        Else
            MOver = 0
        Endif
    Endif
End Sub

'###############################################################################
Sub Button.GClear(BgColor as UByte)
    Line (X, Y) - (X + ButtWidth, Y + ButtHeight), BgColor, BF
End Sub

'###############################################################################
'###############################################################################
'###############################################################################
Type TextField
    Text        as String
    Private:
    X           as Integer
    Y           as Integer
    H           as Byte
    MOver       as Byte
    Auswahl     as Byte
    L           as Integer


    Public:
    Declare Constructor(XPos as Integer, YPos as Integer, Laenge as Integer)
    Declare Constructor(XPos as Integer, YPos as Integer, Laenge as Integer, SText as String)
    Declare Sub Hide()
    Declare Sub Show()
    Declare Sub Control()
    Declare Sub GClear()
    Declare Sub G()
End Type

'###############################################################################
Constructor TextField(XPos as Integer, YPos as Integer, Laenge as Integer)
    X = XPos
    Y = YPos
    L = Laenge
End Constructor

'###############################################################################
Constructor TextField(XPos as Integer, YPos as Integer, Laenge as Integer, SText as String)
    X = XPos
    Y = YPos
    L = Laenge
    Text = SText
End Constructor

'###############################################################################
Sub TextField.G()
    If H = 0 then
        Line(X, Y) - (X + L * 8, Y + 8), &hBBBBBB00, BF
        Draw String(X + 1, Y + 1), Text, &h000000FF
    Endif
End Sub

'###############################################################################
Sub TextField.Hide()
    H = 1
End Sub

'###############################################################################
Sub TextField.Show()
    H = 0
End Sub

'###############################################################################
Sub TextField.Control()
    Dim as Integer MX, MY, MB
    Dim as String T

    If H = 0 then
        GetMouse(MX, MY,, MB)
        If MX > X and MX < X + L * 8 and MY > Y and MY < Y + 8 then
            IF MB = 1 then
                Auswahl = 1
                T = "a"
                Do While(Len(T) = 1)
                    T = Inkey()
                    Sleep 10
                Loop
            Endif
        Else
            If MB = 1 then Auswahl = 0
        Endif
    Endif
    If Auswahl = 1 then
        T = Inkey()

        If ASC(Mid(T, 1, 1)) = 8 then
            Text = Mid(Text, 1, Len(Text) - 1)
        Else
            If Len(Text) < L then Text += T
        Endif
    Endif
End Sub

'###############################################################################
Sub TextField.GClear()
    If H = 0 then
        Line (X, Y) - (X + L * 8, Y + 8), 0, BF
    Endif
End Sub

'###############################################################################
'###############################################################################
'###############################################################################
Type Label
    Private:
    X           as Integer
    Y           as Integer
    H           as Byte
    MOver       as Byte
    L           as Integer
    Text        as String


    Public:
    Declare Constructor(XPos as Integer, YPos as Integer, SText as String)
    Declare Sub Hide()
    Declare Sub Show()
    Declare Sub GClear()
    Declare Sub G()
End Type

'###############################################################################
Constructor Label(XPos as Integer, YPos as Integer, SText as String)
    X = XPos
    Y = YPos
    L = Len(SText)
    Text = SText
End Constructor

'###############################################################################
Sub Label.G()
    If H = 0 then
        Line(X, Y) - (X + L * 8, Y + 8), &hFFFFFF, BF
        Draw String(X + 1, Y + 1), Text, &h000000
    Endif
End Sub

'###############################################################################
Sub Label.Hide()
    H = 1
End Sub

'###############################################################################
Sub Label.Show()
    H = 0
End Sub

'###############################################################################
Sub Label.GClear()
    If H = 0 then
        Line (X, Y) - (X + L * 8, Y + 8), 0, BF
    Endif
End Sub

'###############################################################################
'###############################################################################
'###############################################################################
Type Checkbox
    Checked     as Byte
    Private:
    X           as Integer
    Y           as Integer
    ButtIMG     as Byte PTR
    ButtIMG2    as Byte PTR
    ID          as String
    ExtEvent    as Sub(ID as String)
    H           as Byte
    MOver       as Byte
    MLock       as Byte


    Public:
    Declare Constructor(XPos as Integer, YPos as Integer, CheckID as String, Event as Sub(ID as String))
    Declare Destructor
    Declare Sub Hide()
    Declare Sub Show()
    Declare Sub Control()
    Declare Sub GClear()
    Declare Sub G()
End Type

'###############################################################################
Constructor Checkbox(XPos as Integer, YPos as Integer, CheckID as String, Event as Sub(ID as String))
    X = XPos
    Y = YPos
    ID = CheckID
    ExtEvent = Event
    Checked = 0

    ButtIMG  = Imagecreate(25, 25, &hFFFFFF, 32)
    Line ButtIMG, (1, 1) - (23, 23), &h000000, BF

    ButtIMG2 = Imagecreate(25, 25, &hFFFFFF, 32)
    Line ButtIMG2, (1, 1) - (23, 23), &h000000, BF
    Line ButtIMG2, (1, 1) - (25, 25), &hFFFFFF
    Line ButtIMG2, (23, 1) - (1, 23), &hFFFFFF

End Constructor

'###############################################################################
Destructor Checkbox
    If ButtIMG  <> 0 then ImageDestroy ButtIMG
    If ButtIMG2 <> 0 then ImageDestroy ButtIMG2
End Destructor

'###############################################################################
Sub Checkbox.G()
    If H = 0 then
        If Checked = 1 then Put (X, Y), ButtIMG2, ALPHA, 255
        If Checked = 0 then Put (X, Y), ButtIMG, ALPHA, 255
    Endif
End Sub

'###############################################################################
Sub Checkbox.Hide()
    H = 1
End Sub

'###############################################################################
Sub Checkbox.Show()
    H = 0
End Sub

'###############################################################################
Sub Checkbox.Control()
    Dim as Integer MX, MY, MB

    If H = 0 then
        GetMouse(MX, MY,, MB)
        If MX > X and MX < X + 25 and MY > Y and MY < Y + 25 and MLock = 0 then
            IF MB = 1 then
                Checked += 1
                If Checked > 1 then Checked = 0
                ExtEvent(ID)
            Endif
        Endif
        If MB = 1 then MLock = 1 else MLock = 0
    Endif
End Sub

'###############################################################################
Sub Checkbox.GClear()
    If H = 0 then
        Line (X, Y) - (X + 25, Y + 25), 0, BF
    Endif
End Sub

'###############################################################################