' --- binäre Suche --- windowtitle "B I N Ä R E S U C H E" window 925,375 cls RGB(234,222,126) textcolor RGB(50,55,100), RGB(224,224,224) declare zb$[] 'sortiertes Feld aus je zwei Buchstaben usefont "Arial",14,8,0,0,0 drawtext 5, 20, " Index " drawtext 5, 60, " sortiertes Feld (zwei Buchstaben) " drawtext 5,100, " Marken Links Mitte Rechts " drawtext 5,140, " Teilfeld " usefont "Courier New",16,11,1,0,0 ' Platzhalter drawtext 5, 35, space$(100) drawtext 5, 75, space$(100) drawtext 5,115, space$(100) drawtext 5,155, space$(100) drawtext 5,300, "Suchschritte: " drawtext 125,300, space$(2) ' Stringvariablen für die Anzeige var index$ = "" var sortf$ = "" var marke$ = "" var teilf$ = "" var step% = 0 var k% = 0 ' Index index$ = index$ + space$(3-len(str$(k%))) + str$(k%) + space$(2) var c1% = 97 ' Code des Zeichens a var c2% = 97 randomize c1% = c1% + rnd(7) c2% = c2% + rnd(17) zb$[k%]= chr$(c1%)+chr$(c2%) sortf$ = sortf$ + space$(1) + zb$[k%] + space$(2) k% = 1 while k% <= 19 ' sortierte Buchstabenfolge erzeugen index$ = index$ + space$(3-len(str$(k%))) + str$(k%) + space$(2) if rnd(10) = 5 ' in 10% bleibt der erste Buchstabe ... c1% = ord(left$(zb$[k%-1], 1)) c2% = ord(right$(zb$[k%-1], 1))+ rnd(6) else ' aber häufiger nächster erster Buchstabe c1% = ord(left$(zb$[k%-1], 1)) + 1 c2% = rnd(117-97) + 97 ' höchstens Buchstabe u wegen rnd(6) endif zb$[k%] = chr$(c1%) + chr$(c2%) sortf$ = sortf$ + space$(1) + zb$[k%] + space$(2) inc k% endwhile drawtext 5, 35, index$ drawtext 5, 75, sortf$ messagebox("Bitte geben Sie jetzt 2 kleine Buchstaben als Suchbegriff ein.",\ "Information",64) var in1$ = "" ' Eingabe 1. Zeichen var in2$ = "" ' Eingabe 2. Zeichen repeat in1$ = getkey$() case %scankey = 20 : drawtext 50,35,"Feststelltaste ist aktiviert!" until (96 < ord(in1$)) and (ord(in1$) < 123) repeat in2$ = getkey$() case %scankey = 20 : drawtext 50,35,"Feststelltaste ist aktiviert!" until (96 < ord(in2$)) and (ord(in2$) < 123) var su$ = in1$ + in2$ drawtext 5,275,"Suchbegriff " + su$ drawtext 150,300," nächster Suchschritt - Taste drücken. " var pos% = binsuch(su$, zb$[], 0, 19) if pos% = -1 drawtext 150,275," Der Begriff wurde nicht gefunden! " else drawtext 150,275," gefunden bei Index " + str$(pos%) endif drawtext 150,300," Die Suche ist beendet! " messagebox("Die Suche ist beendet!", "Information",64) repeat waitinput until %key=27 '-------------------------------------------------------------------------- proc binsuch parameters su$, zb$[], l%, r% ' l = links, r = rechts var m% = (l% + r%)\2 ' m = mittig anzeige_marke l%, r%, m% anzeige_teilfeld l%, r% warten if r% < l% return -1 ' Suche erfolglos else if zb$[m%] = su$ anzeige_marke m%, m%, m% anzeige_teilfeld m%, m% return m% ' gefunden! endif if su$ < zb$[m%] binsuch(su$, zb$[], l%, m%-1) ' im linken Teilfeld suchen else binsuch(su$, zb$[], m%+1, r%) ' im rechten Teilfeld suchen endif endif endproc proc warten getkey$(): inc step% : drawtext 125,300, " " + str$(step%) endproc proc anzeige_marke parameters l%, r%, m% if l% < r%-1 marke$ = space$(5*l%)+" L "+space$(5*(m%-l%-1))+" M " \ + space$(5*(r%-m%-1))+ " R " + space$(5*(19-r%)) endif if l% = r%-1 marke$ = space$(5*l%)+" L/M R " + space$(5*(19-r%)) endif if l% = r% marke$ = space$(5*l%)+" M " + space$(5*(19-r%)) endif drawtext 5,115, marke$ endproc proc anzeige_teilfeld parameters l%, r% teilf$ = "" ' altes Teilfeld löschen if l%=r% teilf$ = teilf$ + space$(5*l%) + "[" + zb$[l%]+ " ]"+space$(5*(19-r%)) endif if l%