Das deutsche QBasic- und FreeBASIC-Forum Foren-Übersicht Das deutsche QBasic- und FreeBASIC-Forum
Für euch erreichbar unter qb-forum.de, fb-forum.de und freebasic-forum.de!
 
FAQFAQ   SuchenSuchen   MitgliederlisteMitgliederliste   BenutzergruppenBenutzergruppen  RegistrierenRegistrieren
ProfilProfil   Einloggen, um private Nachrichten zu lesenEinloggen, um private Nachrichten zu lesen   LoginLogin
Zur Begleitseite des Forums / Chat / Impressum
Aktueller Forenpartner:

Text 5 Sekunden anzeigen(Timer zurücksetzen)
Gehe zu Seite Zurück  1, 2, 3, 4
 
Neues Thema eröffnen   Neue Antwort erstellen    Das deutsche QBasic- und FreeBASIC-Forum Foren-Übersicht -> Allgemeine Fragen zu FreeBASIC.
Vorheriges Thema anzeigen :: Nächstes Thema anzeigen  
Autor Nachricht
Muttonhead



Anmeldungsdatum: 26.08.2008
Beiträge: 566
Wohnort: Jüterbog

BeitragVerfasst am: 25.05.2011, 22:21    Titel: Antworten mit Zitat

... ist das Thema schon durch?

hätt da noch was:
(und warscheinlich Thema verfehlt)
grinsen

verwaltet maximal 40 Messages in einem Rollspeicher
bei mehr Messages muß entsprechend angepaßt werden

Code:
type message
  msgtime as double=-1  'Zeit, wann diese Message abgelaufen ist und gelöscht wird. hat nen 0:00 Uhr Problem und benötigt
                        'dafür noch ein workaround!!!
  txt as string
  xpos as integer
  ypos as integer
end type

type messagehandle
  private:
    msg (39) as message                                       'Messagespeicher, maximal 40 Messages können verwaltet werden
    oldestvalid as integer                                    'Index der ältesten noch gültigen Message
    latest as integer                                         'Index der neuesten Message

  public:
    declare constructor
    declare sub AddMessage(txt as string,x as integer, y as integer)
    declare sub CheckMessages
end type

constructor messagehandle
  oldestvalid=0
  latest=0
end constructor

sub messagehandle.AddMessage(txt as string,x as integer, y as integer)
  if msg(latest).msgtime<>-1 then latest = ((latest+1) mod 40)'wenn letzte MessageAblaufzeit noch gesetzt(gültig) ist,
                                                              'erhöhe (rotiere) den Index
                                                              'egal wie, jetzt Message erzeugen
  msg(latest).msgtime=timer+5                                 'Zeitpunkt wann diese Message abgelaufen ist --> + 5s

  'msg(latest).txt=txt
  'msg(latest).xpos=x
  'msg(latest).ypos=y

  'Zufallsverteilung
  msg(latest).txt="MSG" & latest
  msg(latest).xpos=rnd*320
  msg(latest).ypos=rnd*240
end sub

sub messagehandle.CheckMessages
  dim as integer index,exitdo
  index=oldestvalid                                 'Starten der Überprüfung mit letzten noch gültigen Message
  exitdo=0                                          'Signal zu Verlassen des Loops
  do
    if index=latest then exitdo=1                   'wenn letzte(neueste) Message erreicht Exitsignal setzen

    if msg(index).msgtime < timer then               'sollte Gültigkeit für diese Message überschritten sein dann...
      msg(index).msgtime=-1                         'Löschen der Message
      msg(index).txt=""
      msg(index).xpos=0
      msg(index).ypos=0
      if oldestvalid<>latest then oldestvalid = ((oldestvalid+1) mod 40)'wenn mehr als eine Message vorhanden ist,
                                                    'dann erhöhen(rotieren) des Index der letzten gültigen Message
    else                                            'falls diese Message gültig ist, dann...
      draw string (msg(index).xpos, msg(index).ypos), msg(index).txt'anzeigen
    end if

    index = ((index+1) mod 40)                      'Nächster Index
  loop until exitdo
end sub

'******************************************************************************

dim mh as messagehandle 'Messageverwaltung erzeugen

Screen 18,32

Print "q beendet das Programm."
Print "Space erzeugt zu einem beliebigen Zeitpunkt eine Message"
print "die nach 5 sec. wieder verschwindet"
print
print "zum Start eine Taste druecken"
sleep

dim as string key

do
  sleep 1
  key=inkey

  if key=" " then mh.AddMessage(" ",0,0)'hier ohne Parameter
  screenlock
    cls
    mh.CheckMessages
  screenunlock
loop until key="q"
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden E-Mail senden
nemored



Anmeldungsdatum: 22.02.2007
Beiträge: 4704
Wohnort: ~/

BeitragVerfasst am: 26.05.2011, 18:43    Titel: Antworten mit Zitat

gefällt mir - nur wenn ich "zu viele" Meldungen absetze, scheint er alle wieder zu löschen; schöner wäre es natürlich, wenn er in diesem Fall nur die älteste löschen würde. Aber sonst richtig nett.
_________________
Deine Chance beträgt 1:1000. Also musst du folgendes tun: Vergiss die 1000 und konzentriere dich auf die 1.
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden
XOR



Anmeldungsdatum: 23.07.2010
Beiträge: 161

BeitragVerfasst am: 26.05.2011, 21:18    Titel: Antworten mit Zitat

Zitat:
'Zeit, wann diese Message abgelaufen ist und gelöscht wird. hat nen 0:00 Uhr Problem und benötigt
'dafür noch ein workaround!!!

Wiso denn das, wir schreiben in FB und nicht in QB.
Im FB-Portal steht bei Timer folgendes:
Zitat:
Unterschiede zu QB:

Es wird nicht mehr die Zeit seit Mitternacht, sondern seit Systemstart zurückgegeben. Läuft der PC mehr als 24 Stunden durch, wird der Wert nicht zurückgesetzt. Der TIMER-Reset geschieht erst, sobald die DOUBLE-Speicherstelle voll ist.
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden
Muttonhead



Anmeldungsdatum: 26.08.2008
Beiträge: 566
Wohnort: Jüterbog

BeitragVerfasst am: 26.05.2011, 21:25    Titel: Antworten mit Zitat

grinsen japp, ich weiß.... wenn as array voll ist und warscheinlich latest oldestvalid "überholt". Mir ist nur noch nicht der genaue "Mechanismus" klar... grinsen

Ne Liste mit New und Delete scheint mir dann doch praktikabler. Der Code läßt sich bestimmt dahingehend modifizieren. XOR hatte das ja eigentlich schon so ähnlich realisiert...

edit

@XOR: ich bin alt grinsen.... hast aber recht.

Nachtrag:

Beispiel ohne die Begrenzung durch das Array. Messages sind durch NEW
erzeugte Speicherblöcke die nach 5 sec wieder durch DELETE verschwinden...

Code:
type message
  msgtime as double
  txt as string
  xpos as integer
  ypos as integer
  nextmsg as message ptr
end type

type messagehandle
  private:
    oldestvalid as message ptr                                   'Pointer auf die älteste noch gültige Message
    latest as message ptr                                        'Pointer auf die neueste Message

  public:
    declare constructor
    declare destructor
    declare sub AddMessage(txt as string,x as integer, y as integer)
    declare sub CheckMessages
  private:
    declare sub KillMessages
end type

constructor messagehandle
  KillMessages
end constructor

destructor messagehandle
  oldestvalid=0
  latest=0
end destructor

sub messagehandle.AddMessage(txt as string,x as integer, y as integer)
  dim as message ptr msgtmp  'temporärer Message Pointer

  msgtmp = new message        'erzeuge eine neue Message
  if msgtmp then              'wenn erfolgreich erzeugt dann...
                              '"Befüllen" der Message
    msgtmp->msgtime=timer+5

    msgtmp->txt="MSG @" & msgtmp
    msgtmp->xpos=rnd*320
    msgtmp->ypos=rnd*240

    'msgtmp->txt=txt
    'msgtmp->xpos=x
    'msgtmp->ypos=y
    msgtmp->nextmsg=0

    if oldestvalid=0 then     'sollte keine existieren (zB: noch keine erstellt / alle ungültig und gelöscht) dann...

                              'ist die grad erzeugte
      oldestvalid=msgtmp      'sowohl die ältest gültige,
      latest=msgtmp           'als auch die neueste Message

    else                      'existiert jedoch schon was dann...

      latest->nextmsg=msgtmp  'sagen wir der bisherigen neuesten das sie ne Nachfolgerin hat, dadurch entsteht eine Liste
      latest=msgtmp           'und erklären die grad erzeugte zur neuesten Message

    end if
  end if
end sub

sub messagehandle.CheckMessages
  dim as message ptr msg,nmsg   'msg=aktuell überprüfte Message, nmsg=aus ihr ausgelesene Nachfolgerin

  if oldestvalid then             'existiert überhaupt etwas zum Überprüfen dann...
    msg=oldestvalid               'Starten der Überprüfung mit der letzten gültigen Message
    do
      nmsg=msg->nextmsg           'Nachfolgerin aus aktuell Überprüfte holen
      if timer > msg->msgtime then'sollte Gültigkeit für diese Message überschritten sein dann...
        delete msg                'diese Message löschen
        if nmsg=0 then            'sollte keine Nachfolgerin existieren dann...
                                  'dann existiert gar keine mehr
          oldestvalid=0
          latest=0
        else                      'existiert hingegen noch eine Nachfolgerin dann...
          oldestvalid=nmsg        'dann wird diese zu ältest gültigen erklärt, und stellt nun den Anfang der Liste dar
        end if
      else                        'ist die Message gültig dann...
        draw string(msg->xpos,msg->ypos),msg->txt'Anzeige
      end if
      msg=nmsg                    'Nachfolgerin zur aktuellen erklären für nächsten Loop bzw. Abbruchbedingung
    loop until msg=0              'Abbruch wenn keine Nachfolgerin existiert
  end if
end sub

sub messagehandle.KillMessages
  dim as message ptr msg,nmsg     'msg=zu löschende Message, nmsg=aus ihr ausgelesene Nachfolgerin
  if oldestvalid then             'existiert überhaupt etwas zum Löschen dann...
    msg=oldestvalid               'Starten des Löschens mit der letzten gültigen Message
    do
      nmsg=msg->nextmsg           'Nachfolgerin aus aktuell Überprüfte holen
      delete msg                  'diese Message löschen
      msg=nmsg                    'Nachfolgerin zur aktuellen erklären für nächsten Loop bzw. Abbruchbedingung
    loop until msg=0              'Abbruch wenn keine Nachfolgerin existiert
  end if
end sub
'******************************************************************************

dim mh as messagehandle 'Messageverwaltung erzeugen

Screen 18,32



Print "q beendet das Programm."
Print "Space erzeugt zu einem beliebigen Zeitpunkt eine Message"
print "die nach 5 sec. wieder verschwindet"
print
print "zum Start eine Taste druecken"
sleep

dim as string key

do
  sleep 1
  key=inkey

  if key=" " then mh.AddMessage(" ",0,0)'hier ohne Parameter
  screenlock
    cls
    mh.CheckMessages
  screenunlock
loop until key="q"
Nach oben
Benutzer-Profile anzeigen Private Nachricht senden E-Mail senden
Beiträge der letzten Zeit anzeigen:   
Neues Thema eröffnen   Neue Antwort erstellen    Das deutsche QBasic- und FreeBASIC-Forum Foren-Übersicht -> Allgemeine Fragen zu FreeBASIC. Alle Zeiten sind GMT + 1 Stunde
Gehe zu Seite Zurück  1, 2, 3, 4
Seite 4 von 4

 
Gehe zu:  
Du kannst keine Beiträge in dieses Forum schreiben.
Du kannst auf Beiträge in diesem Forum nicht antworten.
Du kannst deine Beiträge in diesem Forum nicht bearbeiten.
Du kannst deine Beiträge in diesem Forum nicht löschen.
Du kannst an Umfragen in diesem Forum nicht mitmachen.

 Impressum :: Datenschutz