home *** CD-ROM | disk | FTP | other *** search
/ Inside Multimedia 1995 August / IMM0895.BIN / magazin / optix / disk1 / optxppac.set / SORTTEST.OPT < prev    next >
Text File  |  1995-04-25  |  4KB  |  169 lines
  1.  
  2. def(i)
  3. def(j)
  4. def(k)
  5.  
  6. defs(upper$)
  7. defs(uppermem$)
  8. defs(lower$)
  9. defs(dum$)
  10.  
  11. defas(sort$,40,21)
  12. defaw(sort,31)
  13.  
  14. procedure lower(s,l)
  15.  
  16.   rem *** wandelt in der vorzubelegenden
  17.   rem *** globalen Stringvariable 'lower$'
  18.   rem *** ab Position 's' soviele Zeichen
  19.   rem *** in Kleinbuchstaben um, wie in
  20.   rem *** 'l' angegeben wurden. Ist 'l'=0,
  21.   rem *** so wird automatisch ab 's' bis
  22.   rem *** zum Stringende gewandelt. (Erwartet
  23.   rem *** außerdem globale Var 'dum$')
  24.  
  25.   locals(i,j,k)
  26.   if s:=0
  27.     s:=1
  28.   endif
  29.   if l=0
  30.     len(lower$,l)
  31.   endif
  32.   for i:=s to l do
  33.     dum$:=lower$[i]
  34.     instr(dum$,'ABCDEFGHIJKLMNOPQRSTUVWXYZÄÖÜ',j)
  35.     if j<>0
  36.       delete(lower$,i,1)
  37.       asc(dum$,k)
  38.       inc(k,32)
  39.       chr(dum$,k)
  40.       insert(dum$,lower$,i)
  41.     endif
  42.   next(i)
  43. return
  44.  
  45. procedure upper(s,l)
  46.  
  47.   rem *** wandelt in der vorzubelegenden globalen Stringvariable 'upper$'
  48.   rem *** ab Position 's' soviele Zeichen in Großbuchstaben um, wie in
  49.   rem *** 'l' angegeben wurden. Ist 'l'=0, so wird automatisch ab 's' bis
  50.   rem *** zum Stringende gewandelt. (Erwartet außerdem globale Var 'dum$')
  51.  
  52.   locals(i,j,k)
  53.   if s:=0
  54.     s:=1
  55.   endif
  56.   if l=0
  57.     len(upper$,l)
  58.   endif
  59.   for i:=s to l do
  60.     dum$:=upper$[i]
  61.     instr(dum$,'abcdefghijklmnopqrstuvwxyzäöü',j)
  62.     if j<>0
  63.       delete(upper$,i,1)
  64.       asc(dum$,k)
  65.       dec(k,32)
  66.       chr(dum$,k)
  67.       insert(dum$,upper$,i)
  68.     endif
  69.   next(i)
  70. return
  71.  
  72. procedure numsort(lim)
  73.  
  74.   rem *** Sortiert das numer. Feld 'sort' aufsteigend (0 - 9)
  75.   rem *** 'lim' gibt dabei den höchsten zu sortierenden Feldindex an
  76.  
  77.   locals(i,j,k,l)
  78.   for j:=1 to lim do
  79.  
  80.   rem **********************************************
  81.   rem *** nur zur Demo - bitte anschließend löschen
  82.  
  83.         for i:=1 to 30 do
  84.           setcolor(sort[i])
  85.           str(sort[i],4,dum$)
  86.           printat(380,20+i*8,dum$+'   ')
  87.         next(i)
  88.  
  89.   rem **********************************************
  90.  
  91.     for k:=j+1 to lim do
  92.       if sort[j] > sort[k]
  93.         i:=sort[j]                   Einträge 'swappen'
  94.         l:=sort[k]
  95.         sort[j]:=l
  96.         sort[k]:=i
  97.       endif
  98.     next(k)
  99.   next(j)
  100. return
  101.  
  102. procedure txtsort(lim)
  103.  
  104.   rem *** Sortiert das String-Feld 'sort$' aufsteigend (A-Z).
  105.   rem *** 'lim' gibt dabei den höchsten zu sortierenden Feldindex an.
  106.   rem *** Die Prozedur erwartet zusätzlich die globale Stringvar 'dum$'
  107.  
  108.   locals(j,k)
  109.   for j:=1 to lim do
  110.  
  111.   rem **********************************************
  112.   rem *** nur zur Demo - bitte anschließend löschen
  113.  
  114.           printtext(140,30,1,20,1)
  115.  
  116.   rem **********************************************
  117.  
  118.     for k:=j+1 to lim do
  119.       upper$:=sort$(j)
  120.       upper(1,0)
  121.       trim(upper$)
  122.       uppermem$:=upper$
  123.       upper$:=sort$(k)
  124.       upper(1,0)
  125.       trim(upper$)
  126.       if uppermem$ > upper$
  127.         dum$:=sort$[j]
  128.         sort$[j]:=sort$[k]
  129.         sort$[k]:=dum$
  130.       endif
  131.     next(k)
  132.   next(j)
  133. return
  134.  
  135. begin
  136.  
  137. new(sort)
  138. new(sort$)
  139. sysfont(2,0)
  140.  
  141. gradation(  1, 63,20, 0,20,63, 0,63)
  142. gradation( 64,127,20,20, 0,63,63, 0)
  143. gradation(128,191, 0,20,20, 0,63,63)
  144. gradation(192,255, 0,20, 0, 0,63, 0)
  145.  
  146. setcolor(255)
  147. readtext('SORTTEXT.TXT',1,20)
  148. printtext(30,30,1,20,1)
  149. txtsort(20)
  150.  
  151. for i:=1 to 30 do
  152.   random(254,j)
  153.   sort[i]:=j+1
  154. next(i)
  155.  
  156. sysfont(1,0)
  157.  
  158. for i:=1 to 30 do
  159.   str(sort[i],4,dum$)
  160.   printat(320,20+i*8,dum$)
  161. next(i)
  162.  
  163. numsort(30)
  164.  
  165. pause(10000)
  166.  
  167.  
  168. end
  169.