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

GuiPtr.bi

Uploader:MitgliedOneCypher
Datum/Zeit:13.10.2009 11:04:54
Hinweis: Dieser Quelltext ist Bestandteil des Projekts GuiPtr, zu dem es auf FreeBASIC-Portal.de eine Projektseite gibt.

#include "Collection.bi"
#include once "Multiput.bi"
sub dump(msg as string)
    open cons for output as #1
        print #1, msg
    close #1
end sub


type EventParameter
    Key as string
    mx as integer
    my as integer
    ax as integer
    ay as integer
    ms as integer
    mb as integer
    mdx as integer
    mdy as integer
    declare constructor()
end type

constructor EventParameter()
    key = "NULL"
    mx = 0
    my = 0
    ax = 0
    ay = 0
    ms = 0
    mb = 0
    mdx = 0
    mdy = 0
end constructor

'Dim shared NullEvent as EventParameter

declare sub CallRoot(GO as any ptr, e as EventParameter)

'type Slot
'    SignalPtr as any ptr ptr
'    declare operator let(v as any ptr)
'    declare operator cast() as any ptr
'end type

'operator Slot.let(v as any ptr)
'    *SlotPTR = v
'end operator

'operator Slot.cast() as any ptr
'    return *SlotPtr
'end operator

'function Connect(Signal as collection ptr, Slot as any ptr

type Signals
    SingleClick as Collection ptr
    DoubleClick as Collection ptr
    OnMouseOver as Collection ptr
    OnMouseDown as Collection ptr
    OnMouseDrag as Collection ptr
    OnMouseUp as Collection ptr
    OnKeyPress as Collection ptr
    OnEnter as Collection ptr
    OnTick as Collection ptr
    OnSelection as Collection ptr
    OnDraw as Collection ptr
end type

type Events
    Signal_SingleClick as Collection ptr = New Collection
    Signal_DoubleClick as Collection ptr = New Collection
    Signal_OnMouseOver as Collection ptr = New Collection
    Signal_OnMouseDown as Collection ptr = New Collection
    Signal_OnMouseDrag as Collection ptr = New Collection
    Signal_OnMouseUp as Collection ptr = New Collection
    Signal_OnKeyPress as Collection ptr = New Collection
    Signal_OnEnter as Collection ptr = New Collection
    Signal_OnTick as Collection ptr = New Collection
    Signal_OnSelection as Collection ptr = New Collection
    Signal_OnDraw as Collection ptr = New Collection

    SingleClick as any ptr 'Einfacher Klick
    DoubleClick as any ptr 'Doppel Klick
    OnMouseOver as any ptr 'Wenn die Maus über das Bedienelement fährt
    OnMouseDown as any ptr 'Wenn die Maustaste runtergedrückt wurde
    OnMouseDrag as any ptr 'Wenn die Maustaste gedrückt und die Mausposition verändert wird
    OnMouseUp as any ptr 'Wenn die Maustaste losgelassen wird
    OnKeyPress as any ptr 'Wenn eine Tastatur-Taste gedrückt wurde
    OnEnter as any ptr 'Wenn ENTER gedrückt wurde
    OnTick as any ptr 'Wenn die Ereignisse eines Bedienelements aufgerufen werden
    OnSelection as any ptr 'Wenn das Bedienelement selektiert wurde
    OnDraw as any ptr 'Wenn das Bedienelement gezeichnet werden soll


    declare Sub EmitSingleClick (GO as any ptr, e as EventParameter) 'Einfacher Klick
    declare Sub EmitDoubleClick (GO as any ptr, e as EventParameter) 'Doppel Klick
    declare Sub EmitMouseOver (GO as any ptr, e as EventParameter) 'Wenn die Maus über das Bedienelement fährt
    declare Sub EmitMouseDown (GO as any ptr, e as EventParameter) 'Wenn die Maustaste runtergedrückt wurde
    declare Sub EmitMouseDrag (GO as any ptr, e as EventParameter) 'Wenn die Maustaste gedrückt und die Mausposition verändert wird
    declare Sub EmitMouseUp (GO as any ptr, e as EventParameter) 'Wenn die Maustaste losgelassen wird
    declare Sub EmitKeyPress (GO as any ptr, e as EventParameter) 'Wenn eine Tastatur-Taste gedrückt wurde
    declare Sub EmitEnter (GO as any ptr, e as EventParameter) 'Wenn ENTER gedrückt wurde
    declare Sub EmitTick (GO as any ptr, e as EventParameter) 'Wenn die Ereignisse eines Bedienelements aufgerufen werden
    declare Sub EmitSelection (GO as any ptr) 'Wenn das Bedienelement selektiert wurde
    declare Sub EmitDraw (GO as any ptr) 'Wenn das Bedienelement gezeichnet werden soll
end type


Sub Events.EmitSingleClick (GO as any ptr, e as EventParameter)
    Dim f as sub(GO as any ptr, e as EventParameter) = SingleClick
    CallRoot(go, e)
    If SingleClick <> 0 then f(Go, e)
    ForEach(f) in(Signal_SingleClick)
        f(Go, e)
    NextOne
end Sub

sub Events.EmitDoubleClick (GO as any ptr, e as EventParameter)
    Dim f as sub(GO as any ptr, e as EventParameter) = DoubleClick
    CallRoot(go, e)
    if DoubleClick <> 0 then f(Go, e)
    ForEach(f) in(Signal_DoubleClick)
        f(Go, e)
    NextOne
end sub

sub Events.EmitMouseOver (GO as any ptr, e as EventParameter)
    Dim f as sub(GO as any ptr, e as EventParameter) = OnMouseOver
    if OnMouseOver <> 0 then f(Go, e)
    ForEach(f) in(Signal_OnMouseOver)
        f(Go, e)
    NextOne
end sub

sub Events.EmitMouseDown (GO as any ptr, e as EventParameter)
    Dim f as sub(GO as any ptr, e as EventParameter) = OnMouseDown
    if OnMouseDown <> 0 then f(Go, e)
    ForEach(f) in(Signal_OnMouseDown)
        f(Go, e)
    NextOne
end sub

sub Events.EmitMouseDrag (GO as any ptr, e as EventParameter)
    Dim f as sub(GO as any ptr, e as EventParameter) = OnMouseDrag
    if OnMouseDrag <> 0 then f(Go, e)
    ForEach(f) in(Signal_OnMouseDrag)
        f(Go, e)
    NextOne
end sub

sub Events.EmitMouseUp (GO as any ptr, e as EventParameter)
    Dim f as sub(GO as any ptr, e as EventParameter) = OnMouseUp
    if OnMouseUp <> 0 then f(Go, e)
    ForEach(f) in(Signal_OnMouseUp)
        f(Go, e)
    NextOne
end sub

sub Events.EmitKeyPress (GO as any ptr, e as EventParameter)
    Dim f as sub(GO as any ptr, e as EventParameter) = OnKeyPress
    if OnKeyPress <> 0 then f(Go, e)
    ForEach(f) in(Signal_OnKeyPress)
        f(Go, e)
    NextOne
end sub

sub Events.EmitEnter (GO as any ptr, e as EventParameter)
    Dim f as sub(GO as any ptr, e as EventParameter) = OnEnter
    CallRoot(go, e)
    if OnEnter <> 0 then f(Go, e)
    ForEach(f) in(Signal_OnEnter)
        f(Go, e)
    NextOne
end sub

sub Events.EmitTick (GO as any ptr, e as EventParameter)
    Dim f as sub(GO as any ptr, e as EventParameter) = OnTick
    if OnTick <> 0 then f(Go, e)
    ForEach(f) in(Signal_OnTick)
        f(Go, e)
    NextOne
end sub

sub Events.EmitSelection (GO as any ptr)
    Dim f as sub(GO as any ptr) = OnSelection
    if OnSelection <> 0 then f(Go)
    ForEach(f) in(Signal_OnSelection)
        f(Go)
    NextOne
end sub

sub Events.EmitDraw (GO as any ptr)
    Dim f as sub(GO as any ptr) = OnDraw
    if OnDraw <> 0 then f(Go)
    ForEach(f) in(Signal_OnDraw)
        f(Go)
    NextOne
end sub


type GuiObject
    Public:
    name as string                          'Name des Objekts (wird vom Klassenname abgeleitet)
    ClassName as string                     'Name der Klasse

    'Indizierung des Objekts beeinflussen:
    FixedIndex as ubyte                     'Wenn 1 dann schiebt sich das Objekt beim Anklicken nicht in den Vordergrund
    FixedPosition as ubyte                  'Wenn 1 dann soll das Objekt nicht verschoben werden können..
    AlwaysOnTop as ubyte                    'Wenn 1 dann erscheint das Objekt immer im Vordergrund
    IgnoreClient as ubyte                   'Wenn 1 dann verschiebt sich das Objekt beim erstellen nicht um die Clientposition

    'LaufzeitMessungen:
    EventFrames as integer                  'Zum ermitteln der FPS eines Bedienelements
    EventTimer as double
    EventFPS as integer                     'Frames per Second des Objekts

    'Das "Aussehen" des Objekts:
    left as integer                         'Linker Abstand
    top as integer                          'Oberer Abstand
    width as integer                        'Breite
    height as integer                       'Höhe
    buffer as any ptr                       'GrafikPuffer
    DrawPriority as uinteger                'Priorität des Zeichenvorgangs
    DrawCounter as uinteger
    Transparency as ubyte                   'Die transparenz des Objekts 0=Sichtbar 255=Unsichtbar
    Zoom as single =1                          'Zoomfaktor
    rotation as integer                     'Rotaionsfaktor

    'Beeinflussung der Kind-Objekte
    ClientLeft as integer                   'Schiebt alle neue Objekte weiter nach links
    ClientTop as integer                    'Schiebt alle neue Objekte weiter nach unten


    'Ereignisse:
    PublicEvents as Events ptr = new Events 'Öffentliche Ereignisse (darf der Benutzer festlegen)
    Signal as Signals ptr
    PrivateEvents as Events ptr             'Private Ereignisse (darf nur das Objekt selbst verwenden)
    LastClick as double                     'Die Zeit seit dem letzten MausKlick (zum ermitteln eines DoubleClicks)
    Enabled as ubyte = 1                    'Wenn 1 ist das Objekt angeschaltet und liefert Ereignisse. Wenn 0 liefert es keine ereignisse mehr und die Kind-Objekte werden nicht weiter ausgeführt
    Selection as GuiObject ptr              'Wenn das Objekt ein Root ist findet man hier den Zeiger auf das grade selektierte Objekt
    SelectionIdx as integer                 'Wenn das Objekt mehrere Kind-Objekte hat, findet man dort den Index des grade selektierten Kindes. (Wird mit TAB durchiteriert)

    'Hierarchiestufen des Objekts:
    MyObject as any ptr                     'Zeigt auf das Bedienelement
    ChildObjects as Collection              'Hier sind die Kind-Objekte gespeichert.
    Parent as GuiObject ptr                 'Zurück zum Eltern-Objekt
    root as GuiObject ptr                   'Zurück zum untersten Objekt
    'Object Funktionen:
    declare function Add (byref GOC as any ptr, NewPtr as any ptr = 0) as any ptr     'Fügt ein Kind-Objekt hinzu
    declare function DoEvents() as uinteger  'Führt die Ereignisse des Objekts aus. (Der Parameter e ist optional und wird nur Objekt-Intern verwendet!)
    declare function DoEvents(byval e as EventParameter = EventParameter) as uinteger  'Führt die Ereignisse des Objekts aus. (Der Parameter e ist optional und wird nur Objekt-Intern verwendet!)
    declare sub ReDraw                      'Zeichnet das Objekt im jeweiligen Buffer und dessen Kinder rekursiv neu
    declare sub ReTick(e as EventParameter)                      'Tickt jedes Objekt rekursiv an
    declare sub ChangeBuffer (FromBuffer as any ptr, ToBuffer as any ptr)   'Änder die Grafikpuffer der Kind-Objekte
    declare constructor(GO as any ptr, Descriptor as String = "" )      'Objekt Konstruktor wird beim Initialisieren des Bedienelementes mit dem Parameter @This aufgerufen
    declare sub SelectNext()                'Selektiert das nächste Bedienelement.
    declare function CountClasses(ClsName as string) as integer

    declare function Exec as integer    'Führt das Programm aus, bis es das signal zum beenden bekommt.
    declare Sub Quit
    'Thread-Variablen:
    ThreadMutex as any ptr
    ThreadCancel as integer
    ThreadID as any ptr

    ReturnValue as uinteger                 'Hier kann man einen Wert als rückgabe-Information hinterlegen
    'Testroutinen:
    declare function DumpObjects(s as string = "") as string
end type

Type GuiObjectControl
    GuiObjectPTR as GuiObject ptr
end type

sub GuiObject.Quit
    ThreadCancel = (1 <> 0)
end sub


function GuiObject.Exec as integer
    Dim TmpRC as uinteger
    do
        if ThreadMutex <> 0 then MutexLock ThreadMutex
        TmpRC = DoEvents
        if ThreadMutex <> 0 then MutexUnlock ThreadMutex
    loop until ThreadCancel <> 0
    Return TmpRC
end function

function GuiObject.DumpObjects(s as string = "") as string
    Dim Child as GuiObject ptr
    dim s2 as string
    if ChildObjects.Count = 0 then
        s2 = s & chr(196) & chr(196) & Name & CHR(13,10)
    else
        s2 = s & chr(196) & CHR(194) & Name & CHR(13,10)
    end if

    for i as integer = 1 to ChildObjects.Count
        Child = ChildObjects.Item(i)
        if i < ChildObjects.Count then
            s2 = s2 & Child->DumpObjects(space(len(s))  & " " & chr(179))
        else
            s2 = s2 & Child->DumpObjects(space(len(s)) & " " & CHR(192))
        end if
    next
    return s2
end function

function GuiObject.CountClasses(ClsName as string) as integer
    Dim Child as GuiObject ptr
    dim c as integer
    if ClassName = ClsName then c +=1
    for i as integer = 1 to ChildObjects.Count
        Child = ChildObjects.Item(i)
        c += Child->CountClasses(ClsName)
    next
    return c
end function


Sub CallRoot(GO as any ptr, e as EventParameter)
    dim g as GuiObjectControl ptr = GO
    dim o as GuiObject ptr = g->GuiObjectPTR
    o->Root->ReturnValue = cast(uinteger, GO)
end sub

Sub GuiObject.SelectNext()
    dim o as GuiObject ptr
    do
        if root->Selection = @This then
            SelectionIdx += 1
            If SelectionIdx > ChildObjects.Count then
                SelectionIdx = 0
                if parent <> 0 then
                    root->selection = parent
                    parent->SelectNext
                else
                    root->Selection = 0
                end if
                exit sub
            else
                do
                    o = ChildObjects.item(SelectionIdx)
                    if o->enabled = 0 then
                        SelectionIdx += 1
                    else
                        o->SelectNext
                    end if
                loop until o->Enabled = 1 or SelectionIdx > ChildObjects.count
            end if
        else
            root->Selection = @This
            PrivateEvents->EmitSelection(MyObject)
            PublicEvents->EmitSelection(MyObject)
        end if
    loop until SelectionIdx <= ChildObjects.Count

end sub


sub GuiObject.ChangeBuffer(FromBuffer as any ptr, ToBuffer as any ptr)
    Dim Child as GuiObject ptr
    if Buffer = FromBuffer then Buffer = ToBuffer
    for i as integer = 1 to ChildObjects.Count
        Child = ChildObjects.Item(i)
        Child->ChangeBuffer FromBuffer, ToBuffer
    next
end sub

function GuiObject.Add(byref GOC as any ptr, NewPtr as any ptr = 0) as any ptr
    'dump str(NewPtr) & "|" & str(GOC)
    If NewPtr <> 0 then GOC = NewPtr
    Dim NewObject as GuiObjectControl ptr = GOC
    Dim NewGuiObject as GuiObject ptr = NewObject->GuiObjectPTR
    if NewGuiObject->Buffer = 0 then
        NewGuiObject->Buffer = Buffer
        NewGuiObject->DrawPriority = DrawPriority
    end if
    NewGuiObject->parent = @This
    if root = 0 then
        NewGuiObject->root = @This
    else
        NewGuiObject->root = root
    end if
    if NewGuiObject->IgnoreClient = 0 then
        NewGuiObject->Left += ClientLeft
        NewGuiObject->Top += ClientTop
    end if

    ChildObjects.add NewObject->GuiObjectPTR
    NewGuiObject->Name = NewGuiObject->ClassName & root->CountClasses(NewGuiObject->ClassName)
    return GOC
end function

function GuiObject.DoEvents() as uinteger
    Dim e as EventParameter
    return DoEvents(e)
end function

function GuiObject.DoEvents overload(byval e as EventParameter) as uinteger
    Dim Child as GuiObject ptr
    dim TmpChild as GuiObject ptr

    Dim NewEvent as EventParameter

    dim as integer tmpx1, tmpy1, tmpx2, tmpy2, TmpMB

    dim OtherEvents as ubyte
    Dim TmpTime as double


    'Wenn das Objekt angeschaltet ist....
    if enabled then
        '... zähle die Frames und setze den Timer
        EventFrames += 1
        if EventTimer = 0 then EventTimer = timer

        'Wenn dieses Objekt ein Root ist dann lese Maus und tastatur ein...
        if root = @This then
            e.key = inkey
            getmouse e.mx,e.my,e.ms,e.mb
            e.ax = e.mx:e.ay = e.my
            'Wenn TAB gedrückt wurde soll die Selektion einen Schritt weiterrücken
            if e.key = chr(9) then
                if selection <> 0 then
                    Selection->SelectNext
                else
                    SelectNext
                end if
            end if
        end if

        e.mx -= left
        e.my -= top   'Damit jedes Objekt die Mauskoordinaten relativ zu sich selbst bekommt
        e.mx /= zoom
        e.my /= zoom

        e.mx = e.mx + sin((rotation/360) * 2 * pi) * e.mx
        e.my = cos((rotation/360) * 2 * pi) * e.my

        'e.mx = sin(rotation)

        'Schau nach ob das Objekt selektiert wurde...
        if root->Selection = @This then
            if e.key <> "" and e.key <> CHR(9) then
                if e.key = CHR(13) then     '... und ENTER gedrückt wurde, löse entsprechende Events aus
                    PrivateEvents->EmitSingleClick(MyObject, e)
                    PublicEvents->EmitSingleClick(MyObject, e)
                    PrivateEvents->EmitEnter(MyObject, e)
                    PublicEvents->EmitEnter(MyObject, e)
                else    '.. und wenn was anderes gedrückt wurde löse auch entsprechende Events aus
                    PrivateEvents->EmitKeyPress(MyObject, e)
                    PublicEvents->EmitKeyPress(MyObject, e)
                end if
            end if
        end if

        'Wenn das Objekt Root ist, dann löse die rekursive Redraw-Funktion aus (zeichnet nicht nur sich selbst, sondern auch die Kind-Objekte)
        if root = @this then Redraw

        'Hier wird die AlwaysOnTop-Funktion realsiert. (Der Index eines Objekt, welches mit AlwaysOnTop markiert wurde, wird nach hinten verschoben)
        for i as integer = 1 to ChildObjects.count
            Child = ChildObjects.item(i)
            If Child->AlwaysOnTop and Child->Enabled then
                TmpChild = ChildObjects.Item(ChildObjects.count)
                ChildObjects.Item(ChildObjects.count) = Child
                ChildObjects.Item(i) = TmpChild
            end if
        next


        'Um die Reihenfolge der gezeichneten Objekte mit den Ereignissen übereinstimmen zu lassen
        'müssen die Kind-Objekte von hinten durchlaufen werden und auf Ereignisse geprüft werden

        if (e.mx > 0 and e.mx < width and e.my > 0 and e.my < height) or e.key <> "" then

            for i as integer = ChildObjects.count to 1 step -1
                Child = ChildObjects.item(i)

                if Child->Enabled then
                    tmpx1 = e.ax
                    tmpy1 = e.ay  'Mit TmpX1,X2 und TmpY1,Y2 wird die relative Mausveränderung nach den Kind-Ereignissen berechnet
                    Child->DoEvents e
                    getmouse tmpx2, tmpy2, , TmpMB

                    tmpx2 -= tmpx1: tmpy2 -= tmpy1

                    e.mx += tmpx2: e.my += tmpy2    'Hier wird die relative Mausveränderung nach den Kind-Ereignissen übernommen

                    if e.mx > Child->Left and e.mx < Child->Left + (Child->Width * Child->zoom)then
                        if e.my > Child->top and e.my < Child->top + (Child->height * Child->zoom)then
                            OtherEvents = 1
                            if e.mb > 0  and Child->FixedIndex = 0 then
                                for i2 as integer = i to ChildObjects.count -1
                                    ChildObjects.item(i2) = ChildObjects.item(i2+1)
                                next
                                ChildObjects.item(ChildObjects.count) = Child
                            end if
                            exit for
                        end if
                    end if
                    e.mb = TmpMB
                end if
            next
        end if

        'löse rekursiv das OnTick-Event aus wenn du root bist
        if root = @This then
            ReTick e
        end if

        if (e.mx > 0 and e.mx < width and e.my > 0 and e.my < height) or e.key <> "" then
            'Wenn kein Kind-Ereignis vorangegangen ist, dann gehen wir in die Ereignisse des aktuellen Objekts
            if OtherEvents = 0 then
                'Wenn die Maus innerhalb des aktuellen Objekts liegt...
                '...lösen wir das entsprechende Ereignis aus
                PrivateEvents->EmitMouseOver(MyObject, e)
                PublicEvents->EmitMouseOver(MyObject, e)

                'Wenn eine Maustaste gedrückt wurde...
                if e.mb > 0 then
                    root->selection = @This     '... wird die Selektion aufs aktuelle Objekt gelegt
                    '...lösen wir das entsprechende Ereignis aus
                    PrivateEvents->EmitMouseDown(MyObject, e)
                    PublicEvents->EmitMouseDown(MyObject, e)

                    getmouse tmpx1,tmpy1    'Mit TmpX1,X2 und TmpY1,Y2 wird die relative Mausbewegung für die Ereignisse des Objekts berechnet
                    TmpMB = e.mb
                    while e.mb = TmpMB
                        getmouse tmpx2,tmpy2,,e.mb
                        if tmpx2 >= 0 and tmpy2 >= 0 then
                            if tmpx2 <> tmpx1 or tmpy2 <> tmpy1 then
                                e.mdx = tmpx2 - tmpx1
                                e.mdy = tmpy2 - tmpy1
                                e.mx += e.mdx: e.my += e.mdy    'Hier wird die relative Mausveränderung für die Ereignisse übernommen
                                tmpx1 = tmpx2: tmpy1 = tmpy2
                                e.key = inkey
                                PrivateEvents->EmitMouseDrag(MyObject, e)
                                PublicEvents->EmitMouseDrag(MyObject, e)
                            end if
                        end if
                        root->ReDraw
                    wend
                    'Hier wird geprüft ob nach dem Tastendruck die Mausposition noch innerhalb des Objekts liegt
                    if e.mx > 0 and e.mx < width and e.my > 0 and e.my < Height then
                        'Wenn die Maus noch innerhalb des Objekts liegt prüfen wir ob ein Doppelklick vorliegt
                        if Timer <= LastClick + 0.4 then
                            PrivateEvents->EmitDoubleClick(MyObject, e)
                            PublicEvents->EmitDoubleClick(MyObject, e)
                            LastClick = 0
                        else
                            PrivateEvents->EmitSingleClick(MyObject, e)
                            PublicEvents->EmitSingleClick(MyObject, e)
                            LastClick = Timer
                        end if
                    end if
                    'Hier wird die Maustaste aus losgelassen angesehen und das entsprechende Event wird ausgelöst
                    PrivateEvents->EmitMouseUp(MyObject, e)
                    PublicEvents->EmitMouseUp(MyObject, e)
                end if
            end if
        end if

        'Hier werden die FPS des Objekts berechnet
        TmpTime = Timer
        if EventTimer + 1.5 <= TmpTime then 'Alle 0.1 sekunden werden die FPS hochgerechnet
            TmpTime -= EventTimer
            EventFPS = EventFrames / TmpTime
            EventFrames = 0
            EventTimer = Timer
        end if

    end if
    return ReturnValue
end function

Sub GuiObject.ReTick(e as EventParameter)
    'Wird immer aufgerufen wenn das Objekt angeschaltet ist
    Dim Child as GuiObject ptr
    Dim NewEvent as EventParameter
    dim as integer TmpX, TmpY, NewLeft, NewTop
    if enabled = 1 then
        PrivateEvents->EmitTick(MyObject, e)
        PublicEvents->EmitTick(MyObject, e)
        for i as integer = 1 to ChildObjects.count
            Child = ChildObjects.item(i)
            with NewEvent
                .key = e.key
                NewLeft = Child->Left
                NewTop = Child->Top

                'NewLeft = Child->Left+ (Child->Width/2) + ( -cos(( (Child->rotation -90)/ 360) * 2 * pi) *(Child->Width/2)   + sin(((Child->rotation -90)/ 360) * 2 * pi) *(Child->Height / 2) )
                'NewTop  = Child->Top + (Child->Height/2) + (  cos(( (Child->rotation -90)/ 360) * 2 * pi) *(Child->Height / 2) + sin(((Child->rotation -90)/ 360) * 2 * pi) *(Child->Width / 2) )

                TmpX = (e.mx - NewLeft) /child->zoom   'Damit wird festgelegt das die Ereignisse eines Objekts
                TmpY = (e.my - NewTop) / child->zoom    'die Mausdaten relativ zu sich selbst erhält.

                .mx =  cos(((360-Child->rotation) /360) *2*pi) * TmpX + sin(((360-Child->rotation) /360) *2*pi) * TmpY

                .my =  cos(((360-Child->rotation) /360) *2*pi) * TmpY + sin(((Child->rotation) /360) *2*pi) * TmpX

                .ms = e.ms
                .mb = e.mb
            end with
            Child->ReTick NewEvent
        next
    end if
end sub


Sub GuiObject.Redraw
    'Hier wird das aktuelle Objekt und dessen Kind-Objekte gezeichnet
    Dim Child as GuiObject ptr
    Dim NewDraw as integer
    if Enabled = 1 then
        if root = @This and Buffer = 0 then screenlock

        'Falls das Objekt angeschaltet ist, werden die Entsprechenden "Zeichnen-Ereignisse" des aktuellen objekts aufgerufen
        If DrawCounter >= DrawPriority or (root->Selection = @This) then
            PrivateEvents->EmitDraw(MyObject)
            PublicEvents->EmitDraw(MyObject)
            DrawCounter = 0
        else
            DrawCounter += 1
        end if
        'Und hier wird ein Rahmen ums objekt gemalt, falls das aktuelle Objekt selektiert ist
        if root->selection = @This then
            if root <> @This then
                if ChildObjects.Count = 0 then
                    if parent->Buffer <> buffer then
                        line buffer, (0,0)-(width, height), RGB(255,255,255),B
                        line buffer, (0,0)-(width, height), RGB(0,0,0),B, &b1010101010101010
                    else
                        line buffer, (left-2,top-2)-(left + width+2, top + height+2), RGB(255,255,255),B
                        line buffer, (left-2,top-2)-(left + width+2, top + height+2), RGB(0,0,0),B, &b1010101010101010
                    end if
                end if
            end if
        end if

        'Hier werden die Kind-Objekte durchlaufen und gemalt
        If DrawCounter = 0 then NewDraw = 1 else NewDraw = 0
        ForEach(Child) in(ChildObjects)
            If NewDraw = 1 then Child->DrawCounter = Child->DrawPriority +1
            Child->ReDraw
            If Child->DrawCounter = 0 or Child->Buffer <> Buffer then NewDraw = 1
        NextOne

        'Hier wird alles auf dem Bildschirm ausgegeben, falls wir es mit einem Root-Element zu tun haben...
        if root = @This then
            if Buffer <> 0 then
                put (left, top),buffer,PSET
            end if
        else
            if buffer <> parent->buffer then
                'rotozoom_alpha2( parent->buffer, buffer, left+ (width*zoom)/2, top + (height*zoom) / 2, rotation, Zoom, Zoom)
                'put parent->buffer,(left, top),buffer, Alpha, 255 - transparency

                MultiPut(parent->Buffer, left+ (width*zoom)/2, top + (height*zoom) / 2, buffer, Zoom, Zoom, rotation, 0, 0, 0, 255, 0, 0)

            end if
        end if
        if root = @This and buffer = 0 then screenunlock
    end if
end sub

function CSVParser(InS as string,n as integer) as string 'Ein kleiner Parser der mir Semikolon separierte strings zerlegt
    dim c as string
    dim o as string
    dim z as integer = 1

    for i as integer = 1 to len(InS)
        c = mid(InS,i,1)
        if c = ";" or i = len(InS) then
            if i = len(InS) then o = o & c
            if z = n then return o
            z = z +1
            c = "": o = ""
        end if
        o = o & c
    next
end function



Constructor GuiObject(GO as any ptr, Descriptor as string = "")
    'Der Konstruktor für das GuiObjekt ist relativ simple:
    'Der Konstruktor braucht lediglich einen Zeiger aufs eigentliche Objekt
    'Und er sieht sich in erster linie selbst als Root
    'Wenn er selbst nicht root ist, wird ihm das von seinem Eltern-Objekt mitgeteilt bzw "überschrieben"
    MyObject = GO
    if Descriptor <> "" then
        Left = val(CSVParser(Descriptor, 1))
        Top  = val(CSVParser(Descriptor, 2))
        Width = val(CSVParser(Descriptor, 3))
        Height = val(CSVParser(Descriptor, 4))
    end if
    Signal = cast(any ptr, PublicEvents)
    root = @This
end constructor