Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!fb:porticula NoPaste
example.bas
| Uploader: |  OneCypher |
| Datum/Zeit: | 13.10.2009 11:00:11 |
Hinweis: Dieser Quelltext ist Bestandteil des Projekts GuiPtr, zu dem es auf FreeBASIC-Portal.de eine Projektseite gibt.
#INCLUDE "fbgfx.bi"
#include "GuiPTR.bi"
#include "GuiPtrTools.bi"
#include "GuiPtrControls.bi"
USING FB
dim as integer sx = 1280, sy = 640 '424
'screen 18,32,0,GFX_SHAPED_WINDOW + GFX_ALWAYS_ON_TOP'60
screenres sx,sy,32
'screenres sx,sy,32,0,GFX_SHAPED_WINDOW' + GFX_ALWAYS_ON_TOP
Width sx / 8, sy /16
'dim w1 as GuiWindow ptr = new GuiWindow(5,5,530,270,"Game Of Life")
dim w1 as NullWindow ptr = new NullWindow
' w1->BackColor = RGB(255,0,255)
dim m1 as Menubar ptr = new MenuBar
w1->Object->Add(m1)
dim m11 as MenuButton ptr = m1->AddMenu("Datei")
m11->AddEntry("Open...")
m11->AddEntry("Save")
m11->AddEntry("Save as...")
m11->AddDivider
m11->AddEntry("Quit")
dim w2 as GuiWindow ptr = w1->Object->Add(new GuiWindow(5,140,400,380,"Cockpit"))
dim m2 as Menubar ptr = w2->Object->Add(new MenuBar)
dim m21 as MenuButton ptr = m2->AddMenu("Datei")
m21->AddEntry("Open...")
m21->AddEntry("Save")
m21->AddEntry("Save as...")
m21->AddDivider
dim Cancel2 as label ptr = m21->AddEntry("Quit")
'dim w2 as NullWindow ptr = w1->Object->Add(new NullWindow(5,5,240,270))
' w2->BackColor = RGB(0,128,128)
Dim shared GOL as GameOfLife ptr
'Wird später initialisiert
Dim shared GOL2 as GameOfLife ptr
'Wird später initialisiert
dim sv as Scrollbar ptr = w1->Object->Add(new Scrollbar(w1->Object->width - 100,10,14,200))
sv->Value = 0
sv->MinValue = 0
sv->MaxValue = 360
Sub Drag_Scrollbar(go as any ptr, e as eventparameter)
dim sb as Scrollbar ptr = go
gol->ImageRotation = sb->Value
end sub
Event(sv)->OnMouseDrag = @Drag_ScrollBar
Event(sv)->SingleClick = @Drag_ScrollBar
dim sh as Scrollbar ptr = w1->Object->Add(new Scrollbar(20, w1->Object->height - 100,600,14))
'sh->Value = 0
'sh->MinValue = 0
'sh->MaxValue = 1
dim m22 as MenuButton ptr = m2->AddMenu("Figuren hinzufuegen")
sub SetAcorn
GOL->GolField(GOL->AField,50,50) = 1
GOL->GolField(GOL->AField,51,50) = 1
GOL->GolField(GOL->AField,51,48) = 1
GOL->GolField(GOL->AField,53,49) = 1
GOL->GolField(GOL->AField,54,50) = 1
GOL->GolField(GOL->AField,55,50) = 1
GOL->GolField(GOL->AField,56,50) = 1
GOL2->GolField(GOL->AField,50,50) = 1
GOL2->GolField(GOL->AField,51,50) = 1
GOL2->GolField(GOL->AField,51,48) = 1
GOL2->GolField(GOL->AField,53,49) = 1
GOL2->GolField(GOL->AField,54,50) = 1
GOL2->GolField(GOL->AField,55,50) = 1
GOL2->GolField(GOL->AField,56,50) = 1
end sub
event(m22->AddEntry("Acorn setzen"))->SingleClick = @SetAcorn
dim runner as Label ptr = m22->AddEntry("Renner setzen")
sub setrunner
GOL->GolField(GOL->AField,100,100) = 1
GOL->GolField(GOL->AField,100,101) = 1
GOL->GolField(GOL->AField,100,102) = 1
GOL->GolField(GOL->AField,101,102) = 1
GOL->GolField(GOL->AField,102,101) = 1
GOL2->GolField(GOL->AField,100,100) = 1
GOL2->GolField(GOL->AField,100,101) = 1
GOL2->GolField(GOL->AField,100,102) = 1
GOL2->GolField(GOL->AField,101,102) = 1
GOL2->GolField(GOL->AField,102,101) = 1
end sub
event(runner)->SingleClick = @SetRunner
Dim EraseIt as Button ptr = New Button(4,46,232,36,"Loeschen")
w2->Object->Add(EraseIt)
Sub ClearGOL
GOL->EraseAll
GOL2->EraseAll
end sub
Event(EraseIt)->SingleClick = cast(any ptr, @ClearGOL)
Dim RndIt as Button ptr = w2->Object->Add(New Button(4,88,232,36,"Zufall"))
Sub RndGOL
GOL->RandomizeAll
GOL2->RandomizeAll
end sub
Event(RndIt)->SingleClick = cast(any ptr, @RndGOL)
Dim OneStep as Button ptr = w2->Object->Add(New Button(4,130,232,36,"Naechste >"))
Sub StepGol
GOL->CalcOneStep
GOL2->CalcOneStep
end sub
Event(OneStep)->SingleClick = cast(any ptr, @StepGol)
Dim Cancel as Button ptr = w2->Object->Add(New Button(4,172,232,36,"Beenden"))
Dim Spacer as Divider ptr = w2->Object->Add(New Divider(2,218))
Dim FPS as Label ptr = w2->Object->Add(New Label(6, 226,"GameOfLife1 FPS: "))
Sub ShowFPS(GO as any ptr, e as EventParameter)
dim l as label ptr = GO
l->Caption = "GameOfLife1 FPS: " & STR(GOL->FPS)
end sub
FPS->Style = 3
Event(FPS)->OnDraw = cast(any ptr, @ShowFPS)
Dim FPS2 as Label ptr = w2->Object->Add(New Label(6, 248,"GameOfLife2 FPS: "))
Sub ShowFPS2(GO as any ptr, e as EventParameter)
dim l as label ptr = GO
l->Caption = "GameOfLife2 FPS: " & STR(GOL2->FPS)
end sub
FPS2->Style = 2
Event(FPS2)->OnDraw = cast(any ptr, @ShowFPS2)
Dim FPS3 as Label ptr = w2->Object->Add(New Label(6, 268,"Gui FPS: "))
Sub ShowFPS3(GO as any ptr, e as EventParameter)
dim l as label ptr = GO
dim fps as double
fps = l->Object->Root->EventFPS
l->Caption = "Gui FPS: " & STR(int(fps))
end sub
FPS3->Style = 2
Event(FPS3)->OnDraw = cast(any ptr, @ShowFPS3)
dim tbox as TextBox ptr = w2->Object->Add(New TextBox(4, 290,28))
tbox->text = "http://www.freebasic-portal.de/befehlsreferenz/mid-funktion-201.html"
GOL = w1->Object->Add(new GameOfLife(440,46, "It's living..."))
GOL2 = w2->Object->Add(new GameOfLife(240,26, "It's living 2!"))
Dim PauseIt1 as CheckBox ptr = GOL->VWindow.Object->Add(New CheckBox(6, 3, "Pause",1))
Dim PauseIt2 as CheckBox ptr = GOL2->VWindow.Object->Add(New CheckBox(6, 3, "Pause",1))
dim pbar as Progressbar ptr = w1->Object->Add(new ProgressBar(50,50,300,32))
Sub PBarTick(GO as any ptr, e as EventParameter)
dim pb as ProgressBar ptr = GO
dim fps as double
pb->Value = pb->Object->Root->EventFPS
end sub
Event(Pbar)->OnDraw = cast(any ptr, @PBarTick)
w1->AddVScrollBar
w1->AddHScrollBar
dump w1->Object->DumpObjects
dim TmpRC as uinteger
Dim Threaded as ubyte = 0
If Threaded = 1 then w1->StartThread
do
TmpRC = RC(w1)
if PauseIt1->Value = 0 then
Gol->CalcOneStep
end if
if PauseIt2->Value = 0 then
GOL2->CalcOneStep
end if
if PauseIt1->Value = 1 and PauseIt2->Value = 1 then
if Threaded = 0 then sleep 1
If Threaded = 1 then w1->SleepThread 1
end if
loop until TmpRC = Cancel or TmpRC = Cancel2
If Threaded = 1 then w1->QuitThread