Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!fb:porticula NoPaste
example0.bas
| Uploader: |  OneCypher |
| Datum/Zeit: | 13.10.2009 11:00:29 |
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
'dim as integer sx = 1000, sy = 900 '424
'screen 18,32,0,GFX_SHAPED_WINDOW + GFX_ALWAYS_ON_TOP'60
screenres sx,sy,32,0
'screenres sx,sy,32,0,GFX_SHAPED_WINDOW' + GFX_ALWAYS_ON_TOP
Width sx / 8, sy /16
Dim shared GOL as GameOfLife ptr
'Wird später initialisiert
Dim shared GOL2 as GameOfLife ptr
'Wird später initialisiert
Sub Drag_Scrollbar(go as any ptr, e as eventparameter)
dim sb as Scrollbar ptr = go
gol->ImageRotation = sb->Value
end sub
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
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
Sub ClearGOL
GOL->EraseAll
GOL2->EraseAll
end sub
Sub RndGOL
GOL->RandomizeAll
GOL2->RandomizeAll
end sub
Sub StepGol
GOL->CalcOneStep
GOL2->CalcOneStep
end sub
Sub ShowFPS(GO as any ptr, e as EventParameter)
dim l as label ptr = GO
l->Caption = "GameOfLife1 FPS: " & STR(GOL->FPS)
end sub
Sub ShowFPS2(GO as any ptr, e as EventParameter)
dim l as label ptr = GO
l->Caption = "GameOfLife2 FPS: " & STR(GOL2->FPS)
end sub
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
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
Sub WTick(w as GuiWindow ptr, e as EventParameter)
if e.key = "-" then
w->Object->zoom -= 0.1
end if
if e.key = "+" then
w->Object->zoom += 0.1
end if
if e.key = "*" then
w->Object->rotation -= 1
end if
if e.key = "/" then
w->Object->rotation += 1
end if
end sub
Sub WTick2(w as GuiWindow ptr, e as EventParameter)
if e.key = "-" then
w->Object->zoom -= 0.1
end if
if e.key = "+" then
w->Object->zoom += 0.1
end if
if e.key = "*" then
w->Object->rotation -= 0.1
end if
if e.key = "/" then
w->Object->rotation += 0.1
end if
end sub
Sub Quit(b as button ptr)
b->Object->root->Quit
end sub
' Event as
Use(new NullWindow )
Dim Cancel as Button ptr
Dim Cancel1 as Label ptr
dim Cancel2 as label ptr
Dim PauseIt1 as CheckBox ptr
Dim PauseIt2 as CheckBox ptr
'This->BackColor = RGB(255,0,255)
dim m1 as Menubar ptr = Me->Add(new MenuBar)
dim m11 as MenuButton ptr = m1->AddMenu("Datei")
m11->AddEntry("Open...")
m11->AddEntry("Save")
m11->AddEntry("Save as...")
m11->AddDivider
Cancel1 = m11->AddEntry("Quit")
GOL2 = Me->Add(new GameOfLife(440,86, "It's living 2!"))
Use(Me->Add(new GuiWindow(5,200,700,380,"Cockpit")))
Event(This)->OnTick = @Wtick
Me->zoom = 1
var m2 = New MenuBar
Me->Add(m2)
Use(m2->AddMenu("Datei"))
This->AddEntry("Open...")
This->AddEntry("Save")
This->AddEntry("Save as...")
This->AddDivider
Cancel2 = This->AddEntry("Quit")
EndUse
Use(m2->AddMenu("Figuren hinzufuegen"))
Event(This->AddEntry("Acorn setzen"))->SingleClick = @SetAcorn
Event(This->AddEntry("Renner setzen"))->SingleClick = @SetRunner
EndUse
Event(Me->Add(New Button(4,46,232,36,"Loeschen")))->SingleClick = @ClearGOL
Event(Me->Add(New Button(4,88,232,36,"Zufall")))->SingleClick = @RndGOL
Event(Me->Add(New Button(4,130,232,36,"Naechste >")))->SingleClick = cast(any ptr, @StepGol)
Cancel = Me->Add(New Button(4,172,232,36,"Beenden"))
Me->Add(New Divider(2,218))
Dim FPS1 as Label ptr = Me->Add(New Label(6, 226,"GameOfLife1 FPS: "))
FPS1->Style = 3
Event(FPS1)->OnDraw = @ShowFPS
Dim FPS2 as label ptr = Me->Add(New Label(6, 248,"GameOfLife2 FPS: "))
FPS2->Style = 2
Event(FPS2)->OnDraw = @ShowFPS2
Dim FPS3 as label ptr = Me->Add(New Label(6, 268,"Gui FPS: "))
FPS3->Style = 2
Event(FPS3)->OnDraw = @ShowFPS3
'Signal(FPS3)->OnDraw->Add @ShowFPS3
'FPS3->Object->Signal->OnDraw->Add @ShowFPS3
Dim TBox as TextBox ptr = Me->Add(New TextBox(4, 290,28))
TBox->text = "http://www.freebasic-portal.de/befehlsreferenz/mid-funktion-201.html"
GOL = Me->Add(new GameOfLife(440,40, "It's living..."))
PauseIt1 = GOL->VWindow.Object->Add(New CheckBox(6, 0, "Pause",1))
PauseIt2 = GOL2->VWindow.Object->Add(New CheckBox(6, 3, "Pause",1))
dim sv as Scrollbar ptr = GOL->VWindow.Object->Add(new Scrollbar(6,14,120,8))
sv->Value = 0
sv->MinValue = 0
sv->MaxValue = 360
Event(sv)->OnMouseDrag = @Drag_ScrollBar
Event(sv)->SingleClick = @Drag_ScrollBar
EndUse
Dim PBar1 as ProgressBar ptr = Me->Add(new ProgressBar(50,50,300,32))
Event(PBar1)->OnDraw = @PBarTick
dim TmpRC as uinteger
Dim Threaded as ubyte = 1
If Threaded then This->StartThread
do
TmpRC = RC(This)
if not PauseIt1->Value then Gol->CalcOneStep
if not PauseIt2->Value then GOL2->CalcOneStep
loop until TmpRC = Cancel or TmpRC = Cancel1 or TmpRC = Cancel2
If Threaded then This->QuitThread
EndUse