Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!fb:porticula NoPaste
mehrere UDTs durch ein Listenobjekt verwalten :(
| Uploader: |  Muttonhead |
| Datum/Zeit: | 29.01.2014 21:46:24 |
#include "fbgfx.bi"
'******************************************************************************
'jedem Type das als Liste verwaltet werden kann, wird eine Typkonstante zugeordnet
const WindowType=1
const GadgetType=2
const MenuHeaderType=3
const MenuItemType=4
const ImageType=5
const ListType=6
const GadgetExtenderType=10
const WindowExtenderType=11
'etwas forward referencing, nicht alle werden tatsächlich benötigt
type _sGUIWindow as sGUIWindow
type _sGUIGadget as sGUIGadget
type _sGUIWindowExtender as sGUIWindowExtender
type _sGUIGadgetExtender as sGUIGadgetExtender
type _sGUIMenuheader as sGUIMenuHeader
type _sGUIMenuItem as sGUIMenuItem
type _sGUIImage as sGUIImage
type _node as node
type _sGUIList as sGUIList
declare function CreateNode (NodeType as integer) as _node ptr
declare sub DeleteNode (n as _node ptr)
'alle Types die in Listen verwaltet werden sollen, müssen die
'ersten 16 Bytes wie folgt definieren:
'Integer 'Typ des Nodes
'Zeiger 'meist als Zeiger aufs vorhergehende Element
'Zeiger 'meist als Zeiger aufs nachfolgende Element
'Zeiger 'Zeiger auf Liste welcher das node zugeordnet ist
'danach entsprechend den Erfordernissen
'******************************************************************************
type sGUIWindow
NodeType as integer
prev_win as _sGUIWindow ptr
next_win as _sGUIWindow ptr
list as _sGUIList ptr
'...
end type
'******************************************************************************
type sGUIGadget
NodeType as integer
prev_gad as _sGUIGadget ptr
next_gad as _sGUIGadget ptr
list as _sGUIList ptr
sel as integer 'Gadget Selektion
act as integer 'Gadget Aktivierung
oldact as integer 'alte Gadget Aktivierung zum Restaurieren des vorhergehenden Zustandes
posx as integer 'PositionX
posy as integer 'PositionY
gadw as integer 'Gadgetbreite
gadh as integer 'Gadgethöhe
DoDraw as sub (gad as sGUIGadget ptr) 'Platzhalter Zeichenroutine
DoAction as function (refgad as sGUIGadget ptr, action as integer) as integer 'Platzhalter für Ereignis-Routine
DoUpdate as sub (gad as sGUIGadget ptr) 'Platzhalter Update
end type
'******************************************************************************
type sGUIWindowExtender
NodeType as integer
prev_winx as _sGUIWindowExtender ptr
next_winx as _sGUIWindowExtender ptr
list as _sGUIList ptr
'...
end type
'******************************************************************************
type sGUIGadgetExtender
NodeType as integer
prev_gadx as _sGUIGadgetExtender ptr
next_gadx as _sGUIGadgetExtender ptr
list as _sGUIList ptr
'...
end type
'******************************************************************************
type sGUIMenuHeader
NodeType as integer
prev_hdr as _sGUIMenuHeader ptr
next_hdr as _sGUIMenuHeader ptr
list as _sGUIList ptr
'...
end type
'******************************************************************************
type sGUIMenuitem
NodeType as integer
prev_itm as _sGUIMenuItem ptr
next_itm as _sGUIMenuItem ptr
list as _sGUIList ptr
'...
end type
'******************************************************************************
'da hier noch zusätzlicher Speicher anfällt(imagecreate), ein destructor für dieses type
type sGUIImage
NodeType as integer
prev_img as _sGUIImage ptr
next_img as _sGUIImage ptr
list as _sGUIList ptr
img as FB.Image ptr
declare destructor
end type
destructor sGUIImage
if img then imagedestroy img
end destructor
'******************************************************************************
'der node-Typ stellt zwar die Grundlage für alle oben definierten Types dar,
'wird jedoch immer nur innerhalb eines Listobjektes benutzt
type node
NodeType as integer
prev_node as _node ptr
next_node as _node ptr
list as _sGUIList ptr
end type
type sGUIList
public:
NodeType as integer
first_node as node ptr
last_node as node ptr
list as _sGUIList ptr
Listaccess as any ptr'Mutex dieser Liste
declare constructor
declare constructor (nt as integer)
declare destructor
declare function NewNode(NodeType as integer) as node ptr'erzeugt einen node entsprechend dem nodeype und hängt ihn an die liste
declare sub MoveNode(n as node ptr, shiftmode as integer=0)'verschiebt node an Listenanfang=0 / Listenende=1
declare sub DeleteNode(n as node ptr) 'löscht das node n aus Liste
declare sub DeleteAll 'löscht gesamte nodeliste
private:
declare sub Delink(n as node ptr) 'stellt ein node frei und modifiziert entsprechend die Liste, ohne es zu löschen!!!
declare sub LinkAsFirst(n as node ptr) 'fügt ein (freigestelltes!!) node an den Listenanfang (als first_node) ein
declare sub LinkAsLast(n as node ptr) 'hängt ein (freigestelltes!!) node ans Listenende (als last_node) an
end type
constructor sGUIList
NodeType=0
end constructor
constructor sGUIList (nt as integer)
NodeType=nt
end constructor
destructor sGUIList
DeleteAll
end destructor
function sGUIList.NewNode(NodeType as integer) as node ptr
function=0
dim n as node ptr
n=CreateNode (NodeType)
if n then
n->List=@this
LinkAsLast n
function=n
end if
end function
sub sGUIList.MoveNode(n as node ptr, shiftmode as integer=0)
if n then
Delink n
if shiftmode=0 then LinkAsFirst n else LinkAsLast n
end if
end sub
sub sGUIList.Delink(n as node ptr)
dim as integer delinkcase
if n then
if (n=first_node) and (n=last_node) then delinkcase=1 'es existiert nur ein node(ist damit sowohl erstes als auch letztes), das herausgelöst wird
if (n=first_node) and (n<>last_node) then delinkcase=2 'erste node der Liste wird herausgelöst
if (n<>first_node) and (n<>last_node) then delinkcase=3'weder erstes noch letztes node(also mittendrin) wird herausgelöst
if (n<>first_node) and (n=last_node) then delinkcase=4 'letztes node wird herausgelöst
select case delinkcase
case 1
first_node=0
last_node=0
case 2
n->next_node->prev_node=0 'im Nachfolger den Link zum Vorgänger löschen, damit wird auch innerhalb der Liste der Anfang neu definiert (zb. für Rückwärtssuche)
first_node=n->next_node 'Nachfolger von n zum ersten node machen
case 3
' +------------------+
' | |
' B | C D |
' <-a c-> <-b d-> <-c n-> |
' | |
' | | node C freistellen
' B | D |
' <-a d-> | <-b n-> |
' ^ | ^ |
' | | | |
' +---------+ +-------+
n->next_node->prev_node = n->prev_node'im Nachfolger den Link zum "Vorvorgänger" setzen
n->prev_node->next_node = n->next_node'im Vorgänger den Link zum "Nachnachfolger" setzen
case 4
n->prev_node->next_node=0 'im Vorgänger den Link zum Nachfolger löschen(=0), damit wird auch innerhalb der Liste das Ende neu definiert
last_node=n->prev_node 'Vorgänger von n zum letzten node machen
end select
n->prev_node=0 'alle Verlinkungen im freigestelltem node n auf 0 setzen
n->next_node=0
end if
end sub
sub sGUIList.LinkAsFirst(n as node ptr)
n->prev_node=0 'zur Sicherheit erst einmal alle Verlinkungen im übergebenen node auf 0 setzen
n->next_node=0
'Verlinken
if first_node then 'sollte schon mindestens ein node existieren, dann...
first_node->prev_node=n 'node n dort als Vorgänger definieren
n->next_node=first_node 'im node n bisheriges erstes node als Nachfolger definieren
first_node=n 'node n wird zum ersten der Liste
else 'sollte noch kein node existieren dann...
first_node=n 'sowohl...
last_node=n ' ...als auch
end if
end sub
sub sGUIList.LinkAsLast(n as node ptr)
n->prev_node=0 'zur Sicherheit erst einmal alle Verlinkungen im übergebenen node auf 0 setzen
n->next_node=0
'Verlinken
if last_node then 'sollte schon mindestens ein node existieren, dann...
last_node->next_node=n 'node n dort als Nachfolger definieren
n->prev_node=last_node 'im node n bisheriges letzes node als Vorgänger definieren
last_node=n 'node n wird zum letzten der Liste
else 'sollte noch kein node existieren dann...
first_node=n 'sowohl...
last_node=n ' ...als auch
end if
end sub
sub sGUIList.DeleteNode(n as node ptr)
if n then
Delink n
DeleteNode n
end if
end sub
sub sGUIList.DeleteAll
dim as node ptr n,nn
n=first_Node
if n then
do
nn=n->next_node 'Nachfolger sichern
DeleteNode n
delete n
n=nn 'Nachfolger zum akuellem node machen
loop until n=0 'wenn keine node >>> raus!!!
end if
end sub
'******************************************************************************
union ListTypes
win as sGUIWindow ptr
gad as sGUIGadget ptr
winx as sGUIWindowExtender ptr
gadx as sGUIGadgetExtender ptr
hdr as sGUIMenuHeader ptr
itm as sGUIMenuItem ptr
img as sGUIImage ptr
nod as node ptr
lst as sGUIList ptr
end union
'******************************************************************************
'dies sind keine MemberFunktionen des Listobjektes!!!
function CreateNode (NodeType as integer) as node ptr
dim as ListTypes LTypes
select case NodeType
case WindowType
LTypes.win=new sGUIWindow
case GadgetType
LTypes.gad=new sGUIGadget
case WindowExtenderType
LTypes.winx=new sGUIWindowExtender
case GadgetExtenderType
LTypes.gadx=new sGUIGadgetExtender
case MenuHeaderType
LTypes.hdr=new sGUIMenuHeader
case MenuItemType
LTypes.itm=new sGUIMenuItem
case ImageType
LTypes.img=new sGUIImage
case Listtype
LTypes.lst=new sGUIList
case else
LTypes.nod= new node
end select
LTypes.nod->NodeType=NodeType
function=LTypes.nod
end function
sub DeleteNode (n as node ptr)
dim as ListTypes LTypes
LTypes.nod=n
select case n->NodeType
case WindowType
delete LTypes.win
case GadgetType
delete LTypes.gad
case WindowExtenderType
delete LTypes.winx
case GadgetExtenderType
delete LTypes.gadx
case MenuHeaderType
delete LTypes.hdr
case MenuItemType
delete LTypes.itm
case ImageType
delete LTypes.img
case ListType
delete LTypes.lst
case else
delete LTypes.nod
end select
end sub
'******************************************************************************
'******************************************************************************
'******************************************************************************
print "Taste"
sleep