Buchempfehlung
Windows System Programming
Windows System Programming
Das Kompendium liefert viele interessante Informationen zur Windows-Programmierung auf Englisch. [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

Menu.bi

Uploader:MitgliedOneCypher
Datum/Zeit:13.10.2009 11:06:50
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"
#include once "Divider.bi"


type MenuButton
    MButton as Button = Button(0,0,10,10,"")
    PullDownMenu as NullWindow ptr
    Entries as Collection
    declare function AddEntry(caption as string) as label ptr
    declare function AddDivider() as Divider ptr
    declare constructor(left as integer, top as integer, w as integer, h as integer, MenuCaption as string)
end type

Sub HighLightLabel(GO as any ptr, e as EventParameter)
    dim l as label ptr = GO
    'l->Style = 3
    l->BackColor = RGB(0,0,128)
    l->Forecolor = RGB(255,255,255)
    l->BackStyle = 1
end sub

Sub NormalLabel(GO as any ptr, e as EventParameter)
    dim l as label ptr = GO
    if e.mx < 0 or e.mx > l->Object->width or e.my < 0 or e.my > l->Object->height then
        'dump "" & e.mx & " " & e.my & " - " & l->Object->width  & " <-> " & l->Object->height
        l->Style = 0
        l->BackStyle = 0
        l->Forecolor = RGB(0,0,0)
    end if
end sub

Sub HidePullDown(GO as any ptr, e as EventParameter)
    dim l as label ptr = go
    l->Object->Parent->Enabled = 0
end sub


function MenuButton.AddDivider() as Divider ptr
    dim LastGuiObjectControl as GuiObjectControl ptr
    Dim GO as GuiObject ptr
    dim LastY as integer
    Dim D as divider ptr
    if Entries.count = 0 then
        D = Entries.Add(PullDownMenu->Object->Add(new Divider(0,2)))
    else
        LastGuiObjectControl = Entries.item(Entries.Count)
        GO = LastGuiObjectControl->GuiObjectPTR
        LastY = GO->top + GO->Height
        D = Entries.Add(PullDownMenu->Object->Add(new Divider(0,LastY + 4)))
    end if
    D->Object->FixedPosition = 1
    return D
end function

Function MenuButton.AddEntry(Caption as string) as label ptr
    dim LastGuiObjectControl as GuiObjectControl ptr
    dim LastY as integer
    Dim NewEntry as label ptr
    Dim TmpEntry as label ptr
    dim e as EventParameter
    Dim GO as GuiObject ptr
    dim o as GuiObject ptr
    dim nw as Nullwindow ptr

    if PullDownMenu = 0 then
        o = MButton.Object
        nw = new NullWindow(O->left,O->top + 19, len(MButton.Caption)*8 +4, 10)
        nw->Object->IgnoreClient = 1
        PullDownMenu = o->Parent->Add(nw)
        PullDownMenu->Object->Enabled = 0
        PullDownMenu->Object->AlwaysOnTop = 1
        PullDownMenu->BackColor = RGB(240,240,240) 'RGB(212,208,200) 'RGB(196,196,196)
        PullDownMenu->BorderStyle = 2
    end if

    if Entries.count = 0 then
        NewEntry = Entries.Add(PullDownMenu->Object->Add(new Label(2,2,Caption)))
    else
        LastGuiObjectControl = Entries.item(Entries.Count)
        GO = LastGuiObjectControl->GuiObjectPTR
        LastY = GO->top + GO->Height
        NewEntry = Entries.Add(PullDownMenu->Object->Add(new Label(2,LastY + 4,Caption)))
    end if

    if NewEntry->Object->width > PullDownMenu->Object->Width then
        e.mdx = (NewEntry->Object->width - PullDownMenu->Object->Width) + 6
    end if
    if NewEntry->Object->height + NewEntry->Object->top > PullDownMenu->Object->height then
        e.mdy = ((NewEntry->Object->height + NewEntry->Object->top) - PullDownMenu->Object->Height) + 4
    end if

    if e.mdx <> 0 or e.mdy <> 0 then
        ObjectResize(PullDownMenu, e )
    end if

    NewEntry->Object->PrivateEvents->OnMouseOver = @HighLightLabel
    NewEntry->Object->PrivateEvents->OnTick = @NormalLabel
    NewEntry->Object->PrivateEvents->SingleClick = @HidePullDown
    NewEntry->Object->FixedPosition = 1
    ForEach(TmpEntry) in(Entries)
    'for i as integer = 1 to Entries.count
    '   TmpEntry = Entries.item(i)
        if TmpEntry->Object->Width < PullDownMenu->Object->Width then TmpEntry->Object->Width = PullDownMenu->Object->Width -4
    'next
    NextOne

    return NewEntry
end function

sub DrawMenuButton(ButtonPTR as any ptr)
    dim b as Button ptr = ButtonPTR
    with *b
        select case .pressed
        case 0
            with *.object
                Draw string .buffer, (.left + ((.width /2) - ((len(b->caption)*8)/2)), .top + ((.height / 2) - 7)),b->caption, RGB(0,0,0)
            end with
        case 1
            with *.object
                Draw string .buffer, (1+.left + ((.width /2) - ((len(b->caption)*8)/2)), 1+.top + ((.height / 2) - 7)),b->caption, RGB(0,0,0)
            end with
        case 2
            with *.object
                line .buffer, (.left, .top)-(.left + .width, .top + .height),RGB(64,64,64),B
                line .buffer, (.left, .top)-(.left, .top + .height),RGB(255,255,255)
                line .buffer, (.left, .top)-(.left + .width, .top),RGB(255,255,255)
                Draw string .buffer, (.left + ((.width /2) - ((len(b->caption)*8)/2)), .top + ((.height / 2) - 7)),b->caption, RGB(0,0,0)
                b->pressed = 0
            end with
        end select
    end with
end sub

Sub MenuTick(GO as any ptr, e as EventParameter)
    dim mb as MenuButton ptr = GO
    dim nw as Nullwindow ptr = mb->PullDownMenu
    if nw <> 0 then

        if nw->Object->Enabled = 1 then
            if e.mb > 0 then
            if (e.mx < 0 or e.my < 0 or e.mx > nw->Object->Width or e.my > nw->Object->height + mb->MButton.Object->height) or (e.mx > mb->MButton.Object->width and e.my <= mb->MButton.Object->height) then

                nw->Object->Enabled = 0
                mb->MButton.Pressed = 0
            end if
            end if
        end if
    end if
end sub
sub MouseOverMenuButton(GO as any ptr, e as EventParameter)
    dim mb as MenuButton ptr = GO
    if mb->MButton.Pressed = 0 then mb->MButton.Pressed = 2
end sub

Sub ToggleMenu(GO as any ptr, e as EventParameter)
    dim mb as MenuButton ptr = GO
    if mb->PullDownMenu <> 0 then
        if mb->PullDownMenu->Object->Enabled = 0 then
            mb->PullDownMenu->Object->left = mb->MButton.Object->left
            mb->PullDownMenu->Object->top =  mb->MButton.Object->top + 19

            mb->PullDownMenu->Object->Enabled = 1
            mb->MButton.Pressed = 1
        else
            mb->PullDownMenu->Object->Enabled = 0
            mb->MButton.Pressed = 0
        end if
    end if
end sub

constructor MenuButton(left as integer, top as integer, w as integer, h as integer, ButtonCaption as string)
    'Objectconstruction
    MButton.Object->MyObject = @This
    with *MButton.Object
        .ClassName = "MenuButton"
        .left = left
        .top = top
        .width = w
        .height = h
        with *.PrivateEvents
            .OnDraw = @DrawMenuButton
            .OnMouseDown = 0
            .OnMouseUp = 0
            .OnMouseOver = @MouseOverMenuButton
            .OnTick = @MenuTick
            .SingleClick = @ToggleMenu
        end with
    end with
    'Controlelements
    MButton.Caption = ButtonCaption
end constructor





Type MenuBar
    Object as GuiObject ptr
    MenuButtons as Collection
    declare function AddMenu(caption as string) as MenuButton ptr
    declare Constructor()
end type

function MenuBar.AddMenu(Caption as string) as MenuButton ptr
    Dim NewMenuButton as MenuButton ptr
    dim LastButton as MenuButton ptr
    Dim LastX as integer
    Dim GO as GuiObject ptr

    if MenuButtons.Count = 0 then
        NewMenuButton = new MenuButton(object->left+4,Object->top+1, len(Caption)*8 +4, 18,caption)
        NewMenuButton->MButton.Object->IgnoreClient = 1
        Object->parent->Add(NewMenuButton)
        Object->parent->ClientTop += Object->Height
    else
        LastButton = MenuButtons.Item(MenuButtons.Count)
        GO = LastButton->MButton.Object
        LastX = GO->left + GO->width + 6
        NewMenuButton = new MenuButton(Object->left+LastX,Object->top + 1, len(Caption)*8 +4, 18,caption)
        NewMenuButton->MButton.Object->IgnoreClient = 1
        Object->parent->Add(NewMenuButton)
    end if
    NewMenuButton->MButton.Object->FixedPosition = 1

    MenuButtons.Add(NewMenuButton)
    return NewMenuButton
end function

Sub DrawMenuBar(GO as any ptr)
    Dim m as MenuBar ptr = GO
    with *m->Object
        line .buffer,(.left+2,.top)-(.parent->width -2,.top+.height),RGB(240,240,240),BF
        line .buffer,(.left+2,.top + .height)-(.parent->width -2,.top+.height),RGB(0,0,0)
    end with
end sub

Constructor MenuBar()
    Object = new GuiObject(@This)
    Object->ClassName = "MenuButton"
    Object->top = 0
    Object->left = 0
    Object->width = 0
    Object->height = 20
    Object->FixedPosition = 1
    Object->PrivateEvents = New Events
    Object->PrivateEvents->OnDraw = @ DrawMenuBar
    Object->FixedIndex = 1
    'Object->IgnoreClient = 1
end constructor