fb:porticula NoPaste

Info / Hilfe Liste
Übersicht / Liste Neu
Datei hochladen Suche
Quellcode suchen
Dateidownload
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