fb:porticula NoPaste
listbox.bi
Uploader: | OneCypher |
Datum/Zeit: | 13.10.2009 11:06:26 |
Hinweis: Dieser Quelltext ist Bestandteil des Projekts GuiPtr, zu dem es auf FreeBASIC-Portal.de eine Projektseite gibt.
#include once "GuiPtr.bi"
#include once "GuiWindow.bi"
#include once "Label.bi"
type ListBox
NWindow as NullWindow = NullWindow(0,0,128,128)
LabelCollection as Collection
MultiSelect as ubyte
declare function AddItem(Text as string) as label ptr
declare function ListCount as integer
declare function ListIndex as integer
declare function Selected as ubyte
declare sub Clear()
declare sub RemoveItem(Idx as integer)
declare property List(Idx as integer) as string
declare property List(Idx as integer, text as string)
declare constructor(l as integer, t as integer, w as integer, h as integer)
end type
Sub MultiSelectLabel(go as any ptr, e as EventParameter)
dim l as label ptr = go
if l->BackStyle = 0 then
l->BackStyle = 1
l->BackColor = RGB(0,0,128)
l->Forecolor = RGB(255,255,255)
else
l->BackStyle = 0
'label->BackColor = RGB(0,0,128)
l->Forecolor = RGB(0,0,0)
end if
end sub
Sub SingleSelectLabel(go as any ptr, e as EventParameter)
Dim l as label ptr = go
dim lb as ListBox ptr = l->Object->Parent->MyObject
Dim TmpLabel as Label ptr
'Dim AllLabels as Item = Item(@lb->LabelCollection,TmpLabel)
'do until AllLabels
ForEach(TmpLabel) in(lb->LabelCollection)
if TmpLabel <> l then
TmpLabel->Forecolor = RGB(0,0,0)
TmpLabel->BackStyle = 0
end if
NextOne
'loop
if l->BackStyle = 0 then
l->BackStyle = 1
l->BackColor = RGB(0,0,128)
l->Forecolor = RGB(255,255,255)
else
l->BackStyle = 0
'label->BackColor = RGB(0,0,128)
l->Forecolor = RGB(0,0,0)
end if
end sub
function ListBox.AddItem(Text as string) as label ptr
Dim NewLabel as Label ptr
Dim TmpLabel as Label ptr
Dim LastY as integer
dim e as EventParameter
ForEach(TmpLabel) in(LabelCollection)
If LastY < TmpLabel->Object->Top + TmpLabel->Object->Height then LastY = TmpLabel->Object->Top + TmpLabel->Object->Height
NextOne
NewLabel = NWindow.Object->Add(new Label(0,LastY + 2,text))
NewLabel->Object->width = NWindow.Object->Width -1
NewLabel->Object->PrivateEvents->SingleClick = @SingleSelectLabel
if NWindow.VScrollbar = 0 then
if NewLabel->Object->top + NewLabel->Object->height > NWindow.Object->Height then
NWindow.AddVScrollbar
'Do until AllLabels
ForEach(TmpLabel) in(LabelCollection)
TmpLabel->Object->Width = NWindow.Object->Width - 19
nextOne
'loop
NewLabel->Object->Width = NWindow.Object->Width - 19
end if
end if
CalcInnerSizes @NWindow, e
LabelCollection.Add NewLabel
Return NewLabel
end function
constructor ListBox(l as integer, t as integer, w as integer, h as integer)
NWindow = NullWindow(l,t,w,h)
NWindow.Object->MyObject = @This
with *NWindow.Object
.ClassName = "ListBox"
.PrivateEvents->OnMouseDrag = @DummyEvent2
.PrivateEvents->OnDraw = @RedrawNullWindow
end with
NWindow.BorderStyle = 1
NWindow.BackColor = RGB(255,255,255)
end constructor