XProfan

Italia

p.specht

Kann nur ganz grobe Probleme erkennen helfen. Im Zweifelsfall immer einen Augenarzt konsultieren!!! Ohne jede Gewähr, rechtliche Fragen ungeprüft!!!

Hinweise: In den Ecken bestimmte Farben nicht zu sehen ist normal, wenn der Hintergrund-Grauwert kaum Kontrast bietet. Zum Arzt sollte man jedenfalls, wenn man auf den Punkt in der Mitte schaut, und dieser (z.B. bei einer bestimmten Grundfarbe wie Blau) plötzlich weg ist (Nasse Makula-Degeneration hat jeder 4. circa 50, gut behandelbar mit Laser und Vitaminspritzen), oder etwa wenn um die Mitte herum ganze Bereiche (nicht nur einzelne Punkte und nicht der sog. Blinde Fleck) beeinträchtigt sind.

Vorteil meiner Spielerei opposto Arztbesuch (dort muss es meistens husch husch gehen): Man kann sich lange lange Zeit nehmen und z.B. rote, grüne und blaue Punkte vor jeweils mehreren Grauschattierungen bzw Schwarz und Weiss ausprobieren.

Kompilieren Markieren Separieren

' Gesichtsfeld-Test - eine Demo von einem Hobby-Programmierer ohne medizinische Kenntnisse!! Ohne jede Gewähr!
WindowTitle "ETWA 25 CM VOR DEM SCHIRM (GGF. MIT LESEBRILLE ) EIN AUGE ZUHALTEN. BLICKEN SIE BITTE I M M E R NUR AUF DEN PUNKT IN DER MITTE! " +\
" BETÄTIGEN SIE DIE LANGE TASTE, WENN SIE DEN ZUSÄTZLICHEN PUNKT SEHEN (AUSWERTUNG MIT ESC-TASTE!)"
Windowstyle 1048
randomize:declare x&,y&,x&[1000],y&[1000],e&[1000],n&,i&,tm&,tc&,bg&
window 0,0 - %maxx,%maxy:Font 2
var xm&=width(%hwnd)\2:var ym&=height(%hwnd)\2:var tr&=1200
bg&=rgb(180,180,180)
cls bg&
usepen 0,1,rgb(255,255,255)
usebrush 1,rgb(255,255,255)
Ellipse xm&+4,(ym&+4) - (xm&-4),(ym&-4)
sound 2000,10
locate 30,40:print "  BITTE MAUSZEIGER AUS DEM WEG RÄUMEN!      WENN BEREIT, AUF DEN PUNKT SCHAUEN UND TASTE DRÜCKEN! "
waitinput
again:
sound 2000,10
n&=0
cls bg&
SetWindowPos %Hwnd=0,0 - %maxx,%maxy;0
usepen 0,1,rgb(255,255,255)
usebrush 1,rgb(255,255,255)
Ellipse xm&+4,(ym&+4) - (xm&-4),(ym&-4)
nochmal:

repeat

    x&=rnd(xm&*2)-xm&:x&[n&]=x&
    y&=rnd(ym&*2)-ym&:y&[n&]=y&
    usepen 0,1,rgb(0,0,255)
    usebrush 1,rgb(0,0,255)
    ellipse xm&+x&+3,(ym&-y&+3) - (xm&+x&-3),(ym&-3-y&)
    tm&=1000+rnd(3000)
    tc&=&gettickcount
    waitinput tm&
    case %key=27:break

    if (&gettickcount-tc&)<tr&:e&[n&]=1:endif

        usepen 0,1,bg&
        usebrush 1,bg&
        ellipse xm&+x&+3,(ym&-y&+3) - (xm&+x&-3),(ym&-3-y&)
        waitinput rnd(700)+1
        n&=n&+1

    until %key=27

    sound 2000,50
    Cls
    usepen 0,1,rgb(255,0,0):usebrush 1,rgb(255,0,0):Ellipse xm&+4,(ym&+4) - (xm&-4),(ym&-4)
    locate 10,10:print " AUSWERTUNG: Graue Punkte wurden erkannt, FARBIGE Punkte wurden NICHT erkannt! "

    whileloop n&:i&=&Loop

        if e&[i&]=0:

            usepen 0,1,rgb(0,0,255)
            usebrush 1,rgb(0,0,255)
            ellipse xm&+x&[i&]+3,(ym&-y&[i&]+3) - (xm&+x&[i&]-3),(ym&-3-y&[i&])

        else

            usepen 0,1,rgb(200,200,200)
            usebrush 1,rgb(200,200,200)
            ellipse xm&+x&[i&]+2,(ym&-y&[i&]+2) - (xm&+x&[i&]-2),(ym&-2-y&[i&])

        endif

    endwhile

    waitinput
    locate 30,40:Print " WIEDERHOLUNG ! "
    waitinput
    Goto "again"