Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!fb:porticula NoPaste
Schwimmleistungs-Organisator
| Uploader: |  nemored |
| Datum/Zeit: | 26.08.2008 13:26:54 |
' unverzichtbarer Organisator *hust* fuer regelmaessige Schwimmleistungen
' (oder sonstige Leistungen, die auf Entfernungen beruhen)
' benoetigt eine Datei schwimmstrecke.txt mit den Angaben zu den Zielen
'
#include "vbcompat.bi"
type TypZiel
as string name ' Name des Zieles
as ushort entfernung ' Entfernung vom Startpunkt
end type
type TypData
as uinteger datum ' Datum der Schwimmleistung
as ushort entfernung ' zurueckgelegte Strecke an diesem Tag
end type
declare sub berechneDaten
declare function pruefeDatum(eingabe as string) as byte
declare sub sortiereWerte(start as uinteger, ende as uinteger)
declare sub zeigeDaten
dim as ubyte f = freefile
dim shared as string*8 nextDate ' Datum des nächst erreichten Zieles
dim shared as uinteger nextZiel, nextDistance ' Nr. des naechsten Zieles und seine Entfernung
dim shared as uinteger AnzahlZiele = 0, AnzahlData = 0, totalDistance = 0
dim shared as single average ' durchschnittliche Schwimmleistung/Tag
redim shared as TypZiel ziel(0)
redim shared as TypData daten(0)
dim as string taste, e1, e2
' Zielorte einlesen
open "schwimmstrecke.txt" for input as #f
do while not eof(f)
dim as string zeile
line input #f, zeile
if trim(zeile) = "" then continue do
dim as ubyte split = instr(zeile, " ")
ziel(AnzahlZiele).entfernung = val(left(zeile, split-1))
ziel(AnzahlZiele).name = trim(mid(zeile, split+1))
if AnzahlZiele = 65535 then exit do
AnzahlZiele += 1
redim preserve ziel(AnzahlZiele)
loop
close #f
' bisherige Schwimmleistungen einlesen
open "schwimm.dat" for input as #f
do while not eof(f)
dim as string zeile
line input #f, zeile
if trim(zeile) = "" then continue do
dim as ubyte split = instr(zeile, " ")
daten(AnzahlData).datum = val(left(zeile, split-1))
daten(AnzahlData).entfernung = val(mid(zeile, split+1))
TotalDistance += daten(AnzahlData).entfernung
if AnzahlData = 65535 then exit do
AnzahlData += 1
redim preserve daten(AnzahlData)
loop
close #f
berechneDaten
' Menue
do
cls
locate 2, 1
if AnzahlData = 0 then
print " Bisher hast du noch keine Daten eingegeben."
else
print " Vom " & format(daten(0).datum, "dd.mm.yy") & " bis zum ";
print format(daten(AnzahlData-1).datum, "dd.mm.yy") & " bist du " & TotalDistance & " km geschwommen."
if nextZiel = AnzahlZiele then
print " Glueckwunsch, du hast das letzte Ziel bereits hinter dir!"
else
print " Du befindest dich " & nextDistance & " km von " & ziel(nextZiel).name & " entfernt."
print " Wenn du deinen bisherigen Schnitt von " & average & " km/Tag durchhaeltst,"
print " dann wirst du " & ziel(nextZiel).name & " voraussichtlich am " & nextDate & " erreichen."
end if
end if
print
print " Was willst du tun?"
print " 1) Neue Eingabe taetigen"
print " 2) Bisherige Eingaben ansehen"
print " 3) Programm beenden"
print
do
taste = input(1)
loop until val(taste) > 0 and val(taste) < 4
select case taste
case "1"
' neue Eingabe
input " Gib das Datum an (dd.mm.yy): ", e1
if pruefeDatum(e1) = 0 then
print : print " FEHLERHAFTE EINGABE!"
getkey
continue do
end if
input " Gib die geschwommenen km an: ", e2
if val(e2) <=0 or val(e2) > 999 then
print : print " FEHLERHAFTE EINGABE!"
getkey
continue do
end if
' Daten intern und extern speichern
daten(AnzahlData).datum = dateserial(val(mid(e1, 7))+2000, val(mid(e1, 4, 2)), val(left(e1, 2)))
daten(AnzahlData).entfernung = val(e2)
AnzahlData += 1
redim preserve daten(AnzahlData)
sortiereWerte(0, AnzahlData - 1)
TotalDistance += val(e2)
berechneDaten
open "schwimm.dat" for output as #f
for i as ubyte = 0 to AnzahlData - 1
print #1, daten(i).datum & " " & daten(i).entfernung
next
close #1
continue do
case "2"
' Daten anzeigen
zeigeDaten
end select
loop until taste = "3"
end
sub berechneDaten
' berechne Durchschnittsleistung, Entfernung zum naechsten Ziel, Erreichen des naechsten Zieles ...
if AnzahlData = 0 then return
average = TotalDistance / (datediff("d", daten(0).datum, daten(AnzahlData-1).datum)+1)
for nextZiel = 0 to AnzahlZiele - 1
if ziel(nextZiel).entfernung > TotalDistance then exit for
next
nextDistance = ziel(nextZiel).entfernung - TotalDistance
print ziel(nextZiel).entfernung / average
nextDate = format(ziel(nextZiel).entfernung / average + daten(0).datum, "dd.mm.yy")
end sub
function pruefeDatum(eingabe as string) as byte
' prueft (rudimentaer), ob der String ein gueltiges Datum beinhaltet
if len(eingabe)<>8 and len(eingabe)<>10 then return 0
dim as ubyte tag = val(left(eingabe, 2)), monat = val(mid(eingabe, 4, 2)), schaltjahr = 0
dim as ushort jahr
if len(eingabe) = 10 then jahr = val(right(eingabe, 4)) else jahr = val(right(eingabe, 2)) + 2000
if (jahr mod 400) = 0 or ((jahr mod 100)<>0 and (jahr mod 4) = 0) then schaltjahr = 1
if monat < 1 or monat > 12 or tag < 1 or tag > 31 then return 0
if (monat = 4 or monat = 6 or monat = 9 or monat = 11) and tag = 31 then return 0
if monat = 2 and tag > 28 + schaltjahr then return 0
return -1
end function
sub sortiereWerte(start as uinteger, ende as uinteger)
' QuickSort-Methode zum Sortieren der Schwimmdaten nach Datum
dim as integer neuStart = start, neuEnde = ende, mitte = daten((start+ende)\2).datum
do
while daten(neuStart).datum < mitte : neuStart += 1 : wend
while daten(neuEnde).datum > mitte : neuEnde -= 1 : wend
if neuStart <= neuEnde then
swap daten(neuStart), daten(neuEnde)
neuStart += 1
neuEnde -= 1
end if
loop until neuStart > neuEnde
if neuEnde > start then sortiereWerte start, neuEnde
if neuStart < ende then sortiereWerte neuStart, Ende
end sub
sub zeigeDaten
' Anzeige bisheriger Schwimmdaten, je 20 Eintraege/Seite
dim as uinteger gesamt = 0, ort = 0
cls
for i as ubyte = 0 to AnzahlData - 1
print format(daten(i).datum, "dd.mm.yy") & ": " & daten(i).entfernung & " km";
gesamt += daten(i).entfernung
if ort < AnzahlZiele and gesamt >= ziel(ort).entfernung then
print tab(25); "(" & ziel(ort).name & ")"
ort += 1
else
print
end if
if (i mod 20) = 19 and i < AnzahlData - 1 then
print
print "*** Taste druecken ***"
getkey
cls
end if
next
print
print "*** Taste druecken ***"
getkey
cls
end sub