fb:porticula NoPaste

Info / Hilfe Liste
Übersicht / Liste Neu
Datei hochladen Suche
Quellcode suchen
Dateidownload
example2.bas

Uploader:	OneCypher
Datum/Zeit:	13.10.2009 11:02:28
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,sy

screen 16,32



'unterste Gui-Ebene:

Dim Application as NullWindow ptr = new Nullwindow



'Label1

dim shared Label1 as Label ptr

    Label1 = Application->Object->Add(new Label(150,10,"Hallo Welt!"))

    Label1->Style = 3

    Label1->BackStyle = 1

    label1->BackColor = RGB(128,0,0)



'Button1

dim Button1 as Button ptr = Application->Object->Add(new Button(100,300,300,50,"Alles klar!"))



'Window1 (ein Fenster im Hauptfenster)

dim Window1 as GuiWindow ptr = Application->Object->Add(new GuiWindow(120,170,230,120,"Fenster im Fenster"))

    Window1->Object->Transparency = 64  'Wem ein Transparentes Fenster zu viel schnickschnack bedeutet, sollte diese Zeile auskommentieren (0=Nicht transparent, 255 = unsichtbar)





'Button2

dim Button2 as Button ptr = Window1->Object->Add(new Button(20,30,200,40,"Hier passiert was!"))

    Sub Button2_Click(Button2 as Button ptr, e as EventParameter)

        Label1->Style +=1

        if Label1->Style > 3 then Label1->Style = 0

        Button2->Caption = "Label1 Style = " & Label1->Style

    end sub

    Event(Button2)->SingleClick = @Button2_Click

    '( Event() ist eine Funktion, die das Verbinden von Sub-Routinen mit Ereignissen eines Objekts vereinfachen/verkürzen soll und ist Bestandtteil der GuiPtrTools )



'Hiermit startet man seine Gui als Thread:

Application->StartThread

'Im prinzip, kann man den Thread sofort starten, nachdem man die unterste Gui-Ebene initiiert hat.. aber ordnungshalber sollte man den Thread erst starten, nachdem alle weiteren Kind-Objekte initiiert wurden.



'Fürs Beispiel ein paar variablen:

Dim TmpString as string = "Hierraus machen wir jetzt ein Lauftext..."

dim i as integer

dim t as double



'Und nun die Hauptschleife, sie läuft unabhängig vom Gui-Thread:

'(Folgendes Beispiel ist in dieser Form ohne Gui-Thread nur mit erheblichen umprogrammier-Aufwand realisierbar)

Do

    'Hier kann jetzt alles passieren, was separat neben dem Gui-Thread laufen soll:

    Label1->Caption = left(TmpString,11)



    t = timer: do: loop until t +1 < timer  'Kleine Warteschleife vorwärts ( Sleep könnte in verbindung mit einem thread der inkey abfragt probleme geben!)

    for i = 1 to len(TmpString) - 11        'Wir laufen einmal den string ab und zeigen immer nur einen 11-zeichen langes teil des ganzen strings

        Label1->Caption = mid(TmpString,i,11)

        t = timer: do: loop until t +0.05 < timer

    next



    for i = Len(TmpString) -11 to 1 step -1 'Kleine Warteschleife rückwärts

        Label1->Caption = mid(TmpString,i,11)

        t = timer: do: loop until t +0.05 < timer

    next

    'Die Gui bleibt, während der Lauftext durchläuft, die ganze zeit bedienbar und voll funktionsfähig.

    'Allerdings wird das Programm beim Click auf Button2-"Alles klar!" erst beendet,

    'wenn das Hauptprogramm einmal komplett durchlaufen wurde und der ReturnCode Button1 ergibt.

    'Soll das Programm schneller beenden,muss man eine IF-Klausel in die oberen schleifen einbauen welche die Schleife beendet falls RC(Application) = Button1 liefert..



    'Folgende zeile liest die Frames per Second der untersten Gui-Ebene aus und schreibt sie auf die Standard-ausgabe. (zu sehen im DOS-Fenster im hintergrund)

    Dump "Frames/Sek. des Gui-Thread: " & Application->Object->EventFPS





'Die Funktion RC( ) hat 2 verschiedene Aufgaben:

' - Arbeitet das Objekt als Thread, lockt RC() den entsprechenden Mutex und gibt den ReturnCode des Objekts zurück.

' - Arbeitet das Objekt nicht als Thread, führt RC()  die Ereignisabfrage des Objekts aus und gibt auch den ReturnCode des Objects zurück

'( RC() gehört zu den GuiPtr-Tools )

loop until RC(Application) = Button1



'Hiermit beendet man den Thread ordentlich:

Application->QuitThread