Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!fb:porticula NoPaste
GuiPtr.bi
| Uploader: |  OneCypher |
| 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