Buchempfehlung
Mikrocomputertechnik mit Controllern der Atmel AVR-RISC-Familie
Mikrocomputertechnik mit Controllern der Atmel AVR-RISC-Familie
Umfassend, aber leicht verständlich führt dieses Buch in die Programmierung von ATMEL AVR Mikrocontrollern ein. [Mehr Infos...]
FreeBASIC-Chat
Es sind Benutzer im FreeBASIC-Chat online.
(Stand:  )
FreeBASIC bei Twitter
Twitter FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!

fb:porticula NoPaste

Info
Info / Hilfe
Liste
Übersicht / Liste
Neu
Datei hochladen
Suche
Quellcode suchen
Download
Dateidownload

listbox.bi

Uploader:MitgliedOneCypher
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