Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!fb:porticula NoPaste
FbTk.bi 'Eine erweiterbare GUI-Engine
| Uploader: |  OneCypher |
| Datum/Zeit: | 22.10.2008 01:10:02 |
'FbTk.bi
'Copyright Christian H. 2008
'Dieser Quelltext darf frei weitergegeben oder verändert werden.
Namespace fbtk
sub dummysub(tmp as any ptr)
end sub
'Hiermit kann jede UDT zu einem Toolkit-Objekt werden
type _tko
x as integer 'X-Position
y as integer 'Y-Position
w as integer 'Breite des Objekts
h as integer 'Höhe des Objekts
v as ubyte 'Sichtbar (<>0) = True
OnClick as sub(tko as any ptr) = @dummysub
OnMouseDown as sub (tko as any ptr) = @dummysub
'OnDblClick as sub(tko as any ptr) = @dummysub 'Doppelklick muss erst noch implementiert werden
PreClick as sub(tko as any ptr) = @dummysub 'Wird ausgeführt bevor OnClick ausgeführt wird
'PreDblClick as sub(tko as any ptr) = @dummysub 'Doppelklick muss erst noch implementiert werden
RePaint as sub(tko as any ptr) = @dummysub
end type
'Hier werden alle Steuerelemente/Objekte verkettet
type tko_list
tko as any ptr
nx_tko as tko_list ptr
end type
dim shared first_tko as tko_list ptr 'Erstes Steuerelement
dim shared last_tko as tko_list ptr 'Letztes Steuerelement
dim shared termsign as ubyte 'DoEvents beenden
'Eine Hilfsfunktion zum registrieren von Objekten in die Verkettung
Function NewTko(tkoptr as any ptr) as any ptr
if first_tko = 0 then
first_tko = new tko_list
first_tko->tko = tkoptr
last_tko = first_tko
else
last_tko->nx_tko = new tko_list
last_tko = last_tko->nx_tko
last_tko->tko = tkoptr
end if
return tkoptr
end function
'Verbindet eine Sub mit einem Event eines Steuerelementes
Sub OnClick(tko as any ptr, EventSub as sub)
dim tmp as _tko ptr = tko
tmp->OnClick = EventSub
end sub
Sub OnMouseDown(tko as any ptr, EventSub as sub)
dim tmp as _tko ptr = tko
tmp->OnMouseDown = EventSub
end sub
'Hier ein integriertes Objekte:
'Label
type _label
tko as _tko 'Es ist ein Toolkit-Objekt
caption as string 'Labeltext
rgbcolor as uinteger 'Farbe
style as ubyte 'Stil (0=normal, 1=umrandet, 2=unterstrichen, 3=umrandet und unterstrichen
end type
'Übernimmt das neuzeichnen des Labels
Sub LabelRepaint(label as _label ptr)
dim x as integer = label->tko.x
dim y as integer = label->tko.y
dim t as string = label->caption
dim c as uinteger = label->rgbcolor
select case label->style
case 0
draw string (x,y), t, c
case 1
draw string (x-1,y), t, c
draw string (x+1,y), t, c
draw string (x,y-1), t, c
draw string (x,y+1), t, c
draw string (x,y), t, RGB(255,255,255)
case 2
draw string (x,y), t, c
line (x,y+15)-(x+8 * len(t),y+15),RGB(0,0,0)
case 3
draw string (x-1,y), t, c
draw string (x+1,y), t, c
draw string (x,y-1), t, c
draw string (x,y+1), t, c
draw string (x,y), t, RGB(255,255,255)
line (x,y+15)-(x+8 * len(t),y+15),c
end select
end sub
'Hiermit kann man ein Label hinzufügen
function AddLabel(x as integer,y as integer, caption as string) as _label ptr
dim tmp_label as _label ptr = NewTko(new _label)
tmp_label->tko.x = x
tmp_label->tko.y = y
tmp_label->tko.h = 16
tmp_label->tko.w = 8 * len(caption)
tmp_label->tko.RePaint = @LabelRepaint
tmp_label->caption = caption
return tmp_label
end function
'Objekt Ende
sub ShowSelected(tko as _tko ptr)
dim x as integer = tko->x-3
dim y as integer = tko->y-3
dim x2 as integer = tko->x + tko->w+3
dim y2 as integer = tko->y + tko->h+3
line(x,y)-(x2,y),RGB(0,0,0),,21845
line(x,y)-(x,y2),RGB(0,0,0),,21845
line(x2,y)-(x2,y2),RGB(0,0,0),,21845
line(x,y2)-(x2,y2),RGB(0,0,0),,21845
end sub
Function DoEvents as ubyte
dim actual_tko as tko_list ptr = first_tko
dim mx as integer, my as integer, btn as integer
dim tko as _tko ptr, in as string
dim selected as tko_list ptr
screenlock
line(0,0)-(800,600),RGB(255,255,255),BF
while actual_tko <> 0
in = inkey
getmouse mx,my, ,btn
tko = actual_tko->tko
tko->repaint(actual_tko->tko)
if in = chr(9) then
if selected = 0 then
selected = first_tko
else
if selected->nx_tko = 0 then
selected = first_tko
else
selected = selected->nx_tko
end if
end if
end if
if in = CHR(13) and selected <> 0 then
pcopy 1,0
tko = selected->tko
tko->PreClick(selected->tko)
screenunlock
do
sleep 50
in = inkey
loop until in <> chr(13)
tko->OnClick(selected->tko)
screenlock
end if
if actual_tko = selected then Showselected tko
if btn <> 0 then
if mx > tko->x and my > tko->y and mx < (tko->x + tko->w) and my < (tko->y + tko->h) then
pcopy 1,0
tko->PreClick(actual_tko->tko)
ShowSelected tko
screenunlock
do
getmouse mx,my, ,btn
tko->OnMouseDown(actual_tko->tko)
loop until (btn = 0) or (mx < tko->x) or (my < tko->y) or (mx > (tko->x + tko->w)) or (my > (tko->y + tko->h))
if mx > tko->x and my > tko->y and mx < (tko->x + tko->w) and my < (tko->y + tko->h) then
tko->OnClick(actual_tko->tko)
end if
screenlock
selected = actual_tko
end if
end if
actual_tko = actual_tko->nx_tko
if actual_tko = 0 and termsign = 0 then
actual_tko = first_tko
screenunlock
pcopy 0,1
sleep 1
screenlock
line(0,0)-(800,600),RGB(255,255,255),BF
end if
wend
screenunlock
return termsign
end function
end namespace