Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!fb:porticula NoPaste
Menu.bi
| Uploader: |  OneCypher |
| 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