Benutzer:FbNutzer/FreeBasicThemen
Programme für FreeBasic und QuickBasic
Schließen des gfx-Grafikfensters mit dem X-Button Bearbeiten
Beim FreeBasic-Grafikmodus, der QuickBasic ähnlich sein soll (gfx-Grafikfenster) besteht das Problem, dass der X-Button (Schließbutton-> WM_CLOSE-Ereignis) des Grafikfensters nicht automatisch funktioniert, sondern der Programmierer sich um die Überwachung kümmern muss. Dazu gibt es die einfache Möglichkeit über den Inkey-Befehl, der nicht nur Tastaturbuchstaben, sondern auch das WM_CLOSE-Ereignis empfängt. Das Problem ist aber, dass Inkey den Tastaturpuffer leert und deshalb inkompatibel mit dem praktischen Input-Befehl ist (MultiKey leert nicht den Puffer, empfängt dabei aber nicht das WM_CLOSE-Ereignis. Will man Input nutzen, führt also kein Weg daran vorbei, sich in die Windows-Ereignisbehandlungsprozedur einzuhängen, wie bei einer normalen WIN-API Programmierung auch. Dies macht die Windowprozedur endbeiXbn.gfxWndProc. Wenn ein WM_CLOSE Ereignis ankommt, dann beendet diese das Programm möglichst harmonisch: Sie ruft den Thread endbeiXbn.ProgramCloseThread auf, der ExitProcess(0) aufruft. Dieser Code ist i.w. gleich mit dem Ausgangscode (bei diesem holt sich ScreenControl einmal das Fensterhandle und hängt dann die gfxWndProc-Prozedur ein) eines erfahrenen Nutzers vom FreeBasic Portal (www.freebasic-portal.de).
Es besteht aber noch das Problem, dass beim -evtl. auch nur versuchten- Wechsel vom Fenstermodus in den Vollbildmodus (z.B. via Maximize-Button) sich das Handle des Fensters ändert, das Fenster also jetzt eigentlich ein anderes ist (auch wenn der Inhalt ins neue Fenster hinüberkopiert wurde). Die gfxWndProc-Prozedur ist nach dieser Änderung natürlich dann abgehängt und es muss wieder das Handle geholt werden und die Prozedur wieder eingehängt werden. Es ist also eine stetige Kontrolle des Fensterhandles notwendig und dies macht der Thread endbeiXbn.control. Diese Erweiterung von mir hat also einen evtl. unbegrenzt laufenden Thread und damit eine mögliche Absturzquelle. Der Thread aber pausiert durch sleep 200,1 jeweils um ca. 200 msec und braucht deswegen kaum Ressourcen und es gibt auch praktisch keine Zugriffskonfikte (die Kommunikation mit dem Hauptprogramm erfolgt über zwei Integer-Variablen - jeweils nur in eine Richtung): Durch die globale Variable endbeiXbn.controlRequQuit kann man die Loop Schleife des Threads beenden, dies braucht aber etwas Zeit, ca. 250 msec ,da die Sleep Verzögerung im Thread alleine schon 200 msec dauert. Mit der globalen Variable endbeiXbn.controlIstaktiv kann man überprüfen, ob der Thread beendet ist. Probleme gibt es, wenn man das Auslaufenlassen der Threads unterlässt und einen neuen Screen oder Screenres-Befehl abgibt, dann kann das Programm abstürzen. Bricht der Nutzer aber das Programm mit dem Taskmanager (unvollständig?) ab, dann kann es bei erneutem Aufrufen in bestimmten Konstellationen zu einem Abbruch kommen: beim Anfang des Programms oder erst beim Wechsel in den Vollbildmodus.
Include-Datei endbeiXbn.bas Bearbeiten
(Der Thread endbeiXbn.control ist wichtig, weil bei Maximierung des Grafikfensters sich das Fensterhandle ändern kann und dann endbeiXbn.gfxWndProc nicht mehr aufgerufen werden würde.)
'Davor muss "windows.bi" und "fbgfx.bi" eingebunden sein
'mit Freebasic 0.24.0 übersetzen
'Wenn confirmStr<>"" ist, dann wird vor einem Abbruch erst gefragt
Namespace endbeiXbn
dim shared as zstring*255 confirmStr=""
dim shared as wndproc OldWndProc
dim shared as integer controlRequQuit=true
dim shared as integer controlIstaktiv=false
Sub ProgramCloseThread(hwnd1 as hwnd)
if confirmStr="" orelse _
MessageBox (hwnd1,confirmStr, "", mb_yesnocancel)=idyes Then
ExitProcess(0)
end if
End Sub
Function gfxWndProc(hwnd1 As hwnd, uMsg As uInt, wParam1 As wParam,_
lParam1 As lParam) As lResult
If uMsg = wm_close Then
ThreadCall ProgramCloseThread(hwnd1)
Return 0
End If
Return OldWndProc(hwnd1, uMsg, wParam1, lParam1)
End Function
Sub control
Static as hwnd hwnd2=null
Dim as hwnd hWnd1
Dim Param1 as Integer
controlIstaktiv=true
Do
Sleep 200,1
ScreenControl fb.get_window_handle, Param1
hWnd1=Cast(hwnd,Param1)
If hWnd1=null Then
hWnd2=null '->bei null das untere nicht ausführen
End If
If hwnd1<>hwnd2 Then
OldWndProc = _
Cast(wndproc,SetWindowLongPtr(hwnd1, gwlp_wndproc,_
Cast(long_ptr, ProcPtr(gfxWndProc))))
hwnd2=hwnd1
End If
Loop until controlRequQuit
controlIstaktiv=false
End Sub
Function StartControlThread as Handle
controlRequQuit=false
return ThreadCall control
End Function
Sub controlInitQuit: controlRequQuit=true : End Sub
End Namespace
Beispielprogramm, das endbeiXbn.bas nutzt Bearbeiten
' mit Freebasic 0.24.0 übersetzen
#Include "windows.bi"
#Include "fbgfx.bi"
#Include "endbeiXbn.bas"
dim r as double
screen 12
endbeiXbn.StartControlThread
print "Grafik-Modus 12"
print
input "r=";r
circle(320,240),r
endbeiXbn.controlInitQuit
while endbeiXbn.controlIstaktiv
print "*";
sleep 20,1
wend
input "<Enter druecken>",r 'hier nur Dummy
screenres 700,550,32
endbeiXbn.StartControlThread
print "Grafik-Modus 700x500x32"
print
Do
input "r= ";r
if r=-100 then : endbeiXbn.controlInitQuit : end if 'zum Testen
circle(350,250),r
Loop
endbeiXbn.controlInitQuit
sleep 250,1
'nur Auslaufenlassen des Programms; schnelles Programmende mit "end"
Anwendungsprogramm, das endbeiXbn.bas verwendet Bearbeiten
' Programm "mult1x1.bas" zur 1x1 Multiplikation, by FbNutzer
' mit Freebasic 0.24.0 übersetzen
#include once "windows.bi"
#include "fbgfx.bi"
#include "endbeiXbn.bas"
'Definition der Variablen und Konstanten
dim as double zeit_min,zeitvorgabe,zeit,zeit1,zeit2
dim as integer ch,a,b,a1,b1,c,richtige,falsche,punkte
dim as integer zeitsek,anz,ppm,maxppm,typ,r
dim as string frage,taste
const as string uekl = chr(129), aekl = chr(132),oekl = chr(148) 'ü,ä,ö
const as string szett = chr(225), mal="x"
const as integer kurzzeit = 100 '100 Millisekunden
'
function tastedruecken as string
print
print " [Taste dr";uekl;"cken] ";
tastedruecken=chr(getkey)
sleep kurzzeit,1 'kurz verzögern
end function
'Beginn des Hauptprogramms
anz=0
maxppm=0
WindowTitle "1x1 Multiplikation"
screen 12
endbeiXbn.StartControlThread
'optional, zum Schließen des gfxGrafikfensters mit dem X-Button;
'mögl. Absturzquelle bei Programmbeginn bzw. Wechsel in Vollbildmod.
color 15,1 '<- weiße Schrift auf blauem Hintergrund
cls
print
print " Multiplikation: Das kleine und gro";_
szett;"e Einmaleins"
print
print
print " (Wechsel in den Vollbildmodus und zur";uekl;"ck";
print " mit [Alt][Enter])"
print
print
print " Punkte = richtige Ergebnisse - falsche Ergebnisse ";mal;" 2"
print
print " (13 richtige und 5 falsche Ergebnisse -> 3 Punkte)"
print
print " Kleines 1x1 (k) [Standard] oder gro";szett;"es 1x1 (g) w";_
aekl;"hlen: ";
input frage
if (frage="g") or (frage="G") then
typ=1
else
typ=0
end if
print
if typ=1 then
print " Gro";szett;"es 1x1 gew";aekl;"hlt.";
print " Der 1.Faktor geht bis 20."
r=19
else
print " Kleines 1x1 gew";aekl;"hlt.";
print " 1.Faktor geht nur bis 10."
r=9
end if
do
richtige=0
falsche=0
zeit=0
anz+=1 'zählt wie viele Durchgänge es gibt'
print:print
input " Zeitdauer (1-5 Minuten): ",zeit_min
if zeit_min<1 then 'übertriebene Werte korrigieren
zeit_min=1
end if
if zeit_min>5 then
zeit_min=5
end if
zeitvorgabe=zeit_min*60 'zeitvorgabe in Sekunden
print " Zeitdauer auf ";zeit_min;" Min. =";zeitvorgabe;_
" Sekunden gesetzt."
taste=tastedruecken
a1=2
b1=2
randomize
do
do
a=int(rnd*r)+2
b=int(rnd*8)+2
loop while (a=a1) and (b=b1) 'ggf. neue Zufallszahlen
a1=a
b1=b
do
cls
print:print:print:print
print " ";a;" ";mal;b;" = ";
zeit1=timer
input c
zeit2=timer
loop while c=0 'c=0 entsteht wenn nur Return gedrückt wurde
zeit=zeit+(zeit2-zeit1)
print
sleep kurzzeit,1 'kurz verzögern: Computer soll auch "denken"
if a*b=c then
richtige+=1
print " Richtig!"
else
sleep kurzzeit,1 'wenn falsch,dann "denkt" der C. noch
falsche+=1
print " Nein, ";a;" ";mal;b;" = ";a*b
end if
sleep kurzzeit,1
if zeit<zeitvorgabe then
print
print
zeitsek=int(zeitvorgabe-zeit)
if zeitsek<=1 then
print " Eine Aufgabe geht noch!"
else
print " Zeit: noch gut ";zeitsek;" Sekunden"
end if
print
print " (Abbruch mit ESC-Taste,";
print " weiter mit beliebiger anderer Taste.)"
end if
taste=tastedruecken
loop while (zeit<zeitvorgabe) and (taste<>chr(27))
cls
print
print " Es gab ";
if richtige=1 then
print "1 richtiges Ergebnis und ";
else
print richtige;" richtige Ergebnisse und ";
end if
if falsche=1 then
print "1 falsches Ergebnis."
else
print falsche;" falsche Ergbnisse."
end if
taste=tastedruecken
print:print
print " richtige E. - falsche E. ";mal;" 2 ->";
punkte=richtige-falsche*2
if punkte<=0 then
print " Leider keine Punkte."
else
if punkte=1 then
print " 1 Punkt.";
else
print punkte;" Punkte.";
end if
print " Zeit:";int(zeit+0.5);" Sekunden."
if zeit>45 then 'Score nicht bei zu kurzen Zeiten
ppm=int(punkte*60/zeit+0.5)
print
print " ->";ppm;" Punkte/Minute"
if ppm>maxppm then
maxppm=ppm
end if
end if
end if
print
if anz>=5 then
print " Bereits 5 Druchg";aekl;"nge. Jetzt erst mal eine Pause!"
taste=tastedruecken
frage="N"
else
while inkey<>"" 'Tastaturpuffer leeren
wend
print " Weiter (j/n) ? ";
ch=GetKey
if (ch=106) or (ch=74) then
frage="j"
else
frage="n"
cls
end if
end if
loop while frage="j"
print
if (maxppm>0) and (anz>1) then
print " ";anz;" Durchg";aekl;"nge. H";_
oekl;"chster Wert: ";maxppm;" Punkte/Minute"
taste=tastedruecken
end if
endbeiXbn.controlInitQuit 'setzt nur eine Variable
sleep 250,1
'nur Auslaufenlassen des Programms; schnelles Programmende mit "end"