Buchempfehlung
Windows-Programmierung. Das Entwicklerhandbuch zur WIN32-API
Windows-Programmierung. Das Entwicklerhandbuch zur WIN32-API
"Der" Petzold, das über 1000 Seiten starke Standardwerk zum Win32-API - besonders nützlich u. a. bei der GUI-Programmierung in FreeBASIC! [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

example.bas

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