home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / dtx9101 / clipper / saamenu.prg < prev    next >
Encoding:
Text File  |  1991-06-27  |  31.5 KB  |  768 lines
  1. /*******************************************
  2. * Name:  SAAMENU
  3. * Art:   FUNCTION
  4. * Autor: FRANK PACHER
  5. * Datum: 15.Mai 1991
  6. * Dateien:  %
  7. * Programme: UDF-Sammlung "STRING.PRG" von NANTUCKET wird benötigt
  8. * Compiling: /n /m /b
  9. * Aufruf:   SAAMENU(Nummer,MenuArray)
  10. *                       Nummer    - Nummer des Menues (default=1 bei NIL)
  11. *                       MenuArray - Array mit den Menueinträgen
  12. * Glob.Var.: %
  13. * Besonderheiten:
  14. *                 RELEASE 2.o mit verbesserter UDF()-behandlung !
  15. *
  16. *                    (c) by F.PACHER
  17. ******************************************************************************/
  18. function SaaMenu(iMenuNum,aMenuArray)
  19.  
  20. //  -> wird spaeter als PRIVATE definiert !! private p_aKoordy    := {}[2]
  21. local l_sBild1
  22. local l_sBild2
  23. local l_aBild3           := {}
  24. local l_sBild4
  25. local l_aHorMenu         := {}
  26. local l_sString          := {}
  27. local l_sOldColor
  28. local l_iLauf1           := 1
  29. local l_iLauf2           := 1
  30. local l_iLauf3
  31. local l_iLauf4
  32. local l_iLaufA
  33. local l_iLaufE
  34. local l_iTempE           :=.F.
  35. local l_iTaste           := 0
  36. local l_bExit1           :=.F.
  37. local l_bExit2           :=.F.
  38. local l_bExit3           :=.T.
  39. local l_sTaste
  40. local l_CodeBlock
  41. local l_sTempString
  42. private p_aUntMenSpeicher   :={}
  43. private p_aUnterMenu      :={}
  44. private p_aRueck          :={}
  45. private p_aColorA         :={}
  46. private p_aColor           := Array(5)
  47. private p_iLauf5
  48. private udfabbruch            := .F.
  49. /************* weitere Declarationen und Defaults setzen ***************/
  50. // defaults setzen :
  51. if iMenuNum = NIL                   // Menu Nummer
  52.    iMenuNum := 1
  53. endif
  54. if aMenuArray[iMenuNum,1] = NIL                // Menu Name
  55.    aMenuArray[iMenuNum,1] :='Hauptmenu'
  56. endif
  57. if aMenuArray[iMenuNum,11] = NIL   // Farbe Unterbalken
  58.    if(IsColor(),aMenuArray[iMenuNum,11]:='g+/n',aMenuArray[iMenuNum,11]:='w/n')
  59. endif
  60. if aMenuArray[iMenuNum,10] = NIL  // Farbe Menu
  61.    if(IsColor(),aMenuArray[iMenuNum,10]:='n/w+,w+/b,r,r+/w+,w+/w',aMenuArray[iMenuNum,10]:='g+/n,n/w,b+,b+/n,w/n')
  62. endif
  63. if aMenuArray[iMenuNum,14]  = NIL  // Menu Zeile
  64.    aMenuArray[iMenuNum,14] := 0
  65. endif
  66. if aMenuArray[iMenuNum,12]  = NIL  // ESC-Erlaubt
  67.    aMenuArray[iMenuNum,12] := .F.
  68. endif
  69. if aMenuArray[iMenuNum,9]   = NIL  // Unterbalken
  70.    aMenuArray[iMenuNum,9]  := .T.
  71. endif
  72. if aMenuArray[iMenuNum,15]  = NIL  // ständiges Hot-Key anzeigen
  73.    aMenuArray[iMenuNum,15] := 'F1 Hilfe '
  74. endif
  75. if aMenuArray[iMenuNum,8]  = NIL  // Farbe d. Message
  76.    if(IsColor(),aMenuArray[iMenuNum,8]:='gr+/b',aMenuArray[iMenuNum,8]:='w/n')
  77. endif
  78. if aMenuArray[iMenuNum,7] = NIL // Länge der Message
  79.    aMenuArray[iMenuNum,7]:= 65
  80. endif
  81. if aMenuArray[iMenuNum,6] = NIL  // zeile d. Message
  82.    aMenuArray[iMenuNum,6]:= 24
  83. endif
  84. if aMenuArray[iMenuNum,5] = NIL  // Farbe Menuname
  85.    if(IsColor(),aMenuArray[iMenuNum,5]:='gr+/b',aMenuArray[iMenuNum,5]:='w/n')
  86. endif
  87. if aMenuArray[iMenuNum,4] = NIL   // Farbe Begrenzer
  88.    if(IsColor(),aMenuArray[iMenuNum,4]:='gr+/b',aMenuArray[iMenuNum,4]:='w/n')
  89. endif
  90.  
  91. l_aHorMenu := aMenuArray[iMenuNum,13]
  92. p_sHotZeig := aMenuArray[iMenuNum,15]
  93. p_aColor   := ListAsArray(aMenuArray[iMenuNum,10],',')
  94. private p_aKoordy  := Array(len(l_aHorMenu),3)
  95. private p_iZeile            := aMenuArray[iMenuNum,6]
  96. private p_iLaenge           := aMenuArray[iMenuNum,7]
  97. private p_sFarbeMess        := aMenuArray[iMenuNum,8]
  98. /******************Beginn der Funktion********************************/
  99. /******************MenuBildAufbau*************************************/
  100. SetCursor(0)
  101. l_sBild1 := SaveScreen(0,0,24,79)
  102. SetColor(p_aColor[1])
  103. @ aMenuArray[iMenuNum,14],0 clear to aMenuArray[iMenuNum,14],79
  104. @ aMenuArray[iMenuNum,14],0
  105. if aMenuArray[iMenuNum,9]
  106.     SetColor(aMenuArray[iMenuNum,11])
  107.     @ aMenuArray[iMenuNum,14]+1,0 clear to aMenuArray[iMenuNum,14]+1,79
  108.     @ aMenuArray[iMenuNum,14]+1,0 to aMenuArray[iMenuNum,14]+1,79 double
  109.     @ aMenuArray[iMenuNum,14]+1,2 say ' '+chr(27)+chr(29)+chr(26)+' '
  110.     @ aMenuArray[iMenuNum,14]+1,57 say ' (c) Pacher ═'
  111. endif
  112. SetColor(p_aColor[1])
  113. @ aMenuArray[iMenuNum,14],0
  114. for l_ilauf1:=1 to len(l_aHorMenu)
  115.      if .NOT. l_aHorMenu[l_iLauf1,3]
  116.             SetColor(p_aColor[5])
  117.             l_sString:=ListAsArray(l_aHorMenu[l_ilauf1,1],'~')
  118.             SetColor(p_aColor[5])
  119.             p_aKoordy[l_iLauf1,3]:=col()+2
  120.             @ aMenuArray[iMenuNum,14],col()+2  say l_sString[1]+l_sString[2]+l_sString[3]
  121.             p_aKoordy[l_iLauf1,1]:= 0
  122.             p_aKoordy[l_iLauf1,2]:= 0
  123.         else
  124.           l_sString:=ListAsArray(l_aHorMenu[l_ilauf1,1],'~')
  125.           do Case
  126.           Case l_sString[1]==''
  127.              SetColor(p_aColor[4])
  128.              p_aKoordy[l_iLauf1,3]:=col()+2
  129.              @ aMenuArray[iMenuNum,14],col()+2  say l_sString[2]
  130.              p_aKoordy[l_iLauf1,1] := col()-1
  131.              p_aKoordy[l_iLauf1,2] := Asc(Upper(l_sString[2]))
  132.              SetColor(p_aColor[1])
  133.              @ aMenuArray[iMenuNum,14],col()  say l_sString[3]
  134.          Case l_sString[3]==''
  135.              SetColor(p_aColor[1])
  136.              p_aKoordy[l_iLauf1,3]:=col()+2
  137.              @ aMenuArray[iMenuNum,14],col()+2  say l_sString[1]
  138.              SetColor(p_aColor[4])
  139.              @ aMenuArray[iMenuNum,14],col()  say l_sString[2]
  140.              p_aKoordy[l_iLauf1,1] := col()-1
  141.              p_aKoordy[l_iLauf1,2] := Asc(Upper(l_sString[2]))
  142.          Otherwise
  143.              SetColor(p_aColor[1])
  144.              p_aKoordy[l_iLauf1,3]:=col()+2
  145.              @ aMenuArray[iMenuNum,14],col()+2  say l_sString[1]
  146.              SetColor(p_aColor[4])
  147.              @ aMenuArray[iMenuNum,14],col()  say l_sString[2]
  148.              p_aKoordy[l_iLauf1,1] := col()-1
  149.              p_aKoordy[l_iLauf1,2] := Asc(Upper(l_sString[2]))
  150.              SetColor(p_aColor[1])
  151.              @ aMenuArray[iMenuNum,14],col()  say l_sString[3]
  152.          endcase
  153.      endif
  154. next
  155. l_sBild2 := SaveScreen(aMenuArray[iMenuNum,14],0,aMenuArray[iMenuNum,14],79)
  156. l_sBild4 := Savescreen(0,0,24,79)
  157. SetColor(p_aColor[2])
  158. l_iLauf1:=1
  159. do While l_iLauf1 <= len(p_aKoordy)
  160.    if p_aKoordy[l_iLauf1,2] <> 0
  161.       l_iLaufA := l_iLauf1
  162.       EXIT
  163.    endif
  164.    l_iLauf1 := l_iLauf1+1
  165. enddo
  166. l_iLauf1 := 1
  167. DO WHILE (l_iLauf1 <= len(p_aKoordy))
  168.   IF (p_aKoordy[l_ilauf1,2] <> 0)
  169.       l_iLaufE := l_iLauf1
  170.   ENDIF
  171.   l_iLauf1 := l_iLauf1+1
  172. ENDDO
  173. l_iLauf1 := 1
  174. if l_iLaufA = NIL
  175.    return
  176. endif
  177. l_sString:=ListAsArray(l_aHorMenu[l_iLaufA,1],'~')
  178. @ aMenuArray[iMenuNum,14],p_aKoordy[l_iLaufA,3] say l_sString[1]+l_sString[2]+l_sString[3]
  179. SetCenterText(aMenuArray[iMenuNum,1],aMenuArray[iMenuNum,2],aMenuArray[iMenuNum,5],aMenuArray[iMenuNum,3],aMenuArray[iMenuNum,4])
  180. SetMessage(aMenuArray[iMenuNum,6],aMenuArray[iMenuNum,7],l_aHorMenu[l_iLaufA,2],aMenuArray[iMenuNum,8],p_aColor[2])
  181. l_iLauf3:=l_iLaufA
  182. /********************* HorizontaleMenuSteuerung *************************/
  183.  // NEU HINZUGEKOMMEN !!!
  184. if (l_iLaufA = l_iLaufE).and.(aMenuArray[iMenuNum,12]=.T.)
  185.     l_iLaufE := l_iLaufE+1
  186.     l_iTempE := .T.
  187. endif
  188. //************************
  189. l_CodeBlock := {|x| x[2] = l_sTaste}
  190. do While (l_bExit1=.F.).and.(.NOT.(l_iLaufA = l_iLaufE))  // solange nicht
  191.                                                            // <ET> / Hotkey
  192.     // NEU HINZUGEKOMMEN !!!
  193.    if l_iTempE
  194.       l_iLaufE := l_iLaufE-1
  195.    endif
  196.    //************************
  197.    do While .NOT.l_bExit2                // solange keine zulaessige Taste
  198.        l_sTaste := Inkey(0)
  199. /*************************************************************
  200. ****** wird eine Helpdatei mit gelinkt, so müssen die
  201. ****** nächsten Zeilen aktiviert werden !! (für F1-Taste im
  202. ******                                      Hauptmenu )      */
  203. /*       if l_sTaste=28
  204.            help()
  205.        endif*/
  206. //************************************************************
  207.        if (l_sTaste = 27).and.(aMenuArray[iMenuNum,12]=.T.)
  208.             AAdd(p_aRueck,0)
  209.             l_bExit1 := .T.
  210.             l_iLaufA := l_iLaufE
  211.             exit  // Ende SAAMenu übergabe von 0 für <ESC>-Taste
  212.        endif
  213.        if (l_sTaste >= 97).AND.(l_sTaste <= 122)
  214.                    // Konvert. Kleinbuchst. -> Grossbuchst.
  215.            l_sTaste := l_sTaste-32
  216.        endif
  217.        do Case
  218.  
  219.           Case (l_sTaste = 19).or.(l_sTaste = 4).or.(l_sTaste = 1)
  220.                l_bExit2 :=.T.
  221.  
  222.           Case (l_sTaste = 13).or.(l_sTaste = 6)
  223.                l_bExit2 :=.T.
  224.  
  225.           Case AScan(p_aKoordy,l_CodeBlock) <> 0
  226.                l_bExit2 :=.T.
  227.  
  228.           Otherwise
  229.                l_bExit2 :=.F.
  230.        endcase
  231.    enddo
  232. /********************MenuZeileNeuSchreiben*********************************************/
  233.    RestScreen(aMenuArray[iMenuNum,14],0,aMenuArray[iMenuNum,14],79,l_sBild2)
  234. /*********************LeuchtBalkenSchreiben********************************************/
  235.    SetColor(p_aColor[2])
  236.    do Case
  237.       Case (l_sTaste=4) // Rechtspfeil
  238.          do Case
  239.             Case (l_iLauf3 = l_iLaufE)        // ist aktueller MP der letzte MP
  240.                    l_iLauf3 := l_iLaufA       // gehe zu Anfang
  241.  
  242.             Case (l_aHorMenu[l_iLauf3+1,3])=.F.  // ist der naechste MP gesperrt
  243.                  l_iLauf3 := l_iLauf3+1          // zeiger auf gesperrten MP
  244.                  do While (l_aHorMenu[l_iLauf3,3])=.F.  // wiederhole so lange
  245.                                                         // gesperrt
  246.                       l_iLauf3 := l_iLauf3+1              // Zeiger erhöhen
  247.                                                           // letzer freier MP
  248.                       do case
  249.                           case ((l_iLauf3+1) = l_iLaufE).and.((l_aHorMenu[l_iLauf3+1,3])=.F.)
  250.                                l_iLauf3 := l_iLaufA            // zeiger an anfang
  251.                                exit                            // und raus aus schleife
  252.                           case ((l_iLauf3+1) = l_iLaufE)
  253.                                l_iLauf3 := l_iLaufE            // zeiger an anfang
  254.                                exit                            // und raus aus schleife
  255.                       endcase
  256.                  enddo
  257.              Otherwise                           // alles andere
  258.                   l_iLauf3 := l_iLauf3+1         // Zeiger erhöhen
  259.          endCase
  260.       Case (l_sTaste=19)                      // Linkspfeil
  261.          do Case
  262.             Case (l_iLauf3 = l_iLaufA)       //ist aktueller  MP der erste MP
  263.                    l_iLauf3 := l_iLaufE      // setze zeiger an den schluss setzen
  264.  
  265.             Case (l_aHorMenu[l_iLauf3-1,3])=.F. //ist vorhergehender MP zulässig
  266.                  l_iLauf3 := l_iLauf3-1         //zeiger auf gesperrten MP
  267.                  do While (l_aHorMenu[l_iLauf3,3])=.F. //wiederhole solange
  268.                                                        // MP gesperrt
  269.                       l_iLauf3 := l_iLauf3-1           //zeiger um 1 erniedrigen
  270.                  enddo
  271.              Otherwise                       //alles andere
  272.                  l_iLauf3 := l_iLauf3-1      //zeiger erniedrigen
  273.          endCase
  274.          Case AScan(p_aKoordy,l_CodeBlock) <> 0  // auf Hot-key testen
  275.                l_iLauf3 := AScan(p_aKoordy,l_CodeBlock)
  276.                l_staste := 13
  277.       endcase
  278.           l_sString:=ListAsArray(l_aHorMenu[l_iLauf3,1],'~')
  279.            SetColor(p_aColor[2])
  280.            @ aMenuArray[iMenuNum,14],p_aKoordy[l_iLauf3,3] say l_sString[1]+l_sString[2]+l_sString[3]
  281.            SetCenterText(aMenuArray[iMenuNum,1],aMenuArray[iMenuNum,2],aMenuArray[iMenuNum,5],aMenuArray[iMenuNum,3],aMenuArray[iMenuNum,4])
  282.            SetMessage(aMenuArray[iMenuNum,6],aMenuArray[iMenuNum,7],l_aHorMenu[l_iLauf3,2],aMenuArray[iMenuNum,8],p_aColor[2])
  283.    if l_sTaste=13
  284.         /*********************** Wurde Ausgewählt und nun bearbeitet*****/
  285.            l_bExit1 := .T.
  286.            l_iTaste := 1
  287.            p_aRueck    := {}
  288.            AAdd(p_aRueck,l_iLauf3)
  289.         /***************************UnterMenuAufrufe**********************/
  290.         /**************************Test ob UnterMenu vorhanden**************/
  291.         if l_aHorMenu[l_iLauf3,4] <> NIL
  292.           /**********************Vorbereiten**********************************/
  293.           p_iLauf5 := 1
  294.           p_aUnterMenu := l_aHorMenu[l_iLauf3,4]
  295.           AAdd(p_aUntMenSpeicher,NIL)
  296.           p_aUntMenSpeicher[p_iLauf5] := p_aUnterMenu
  297.           p_aColorA    := ListAsArray(p_aUnterMenu[11],',')
  298.           SetColor(p_aUnterMenu[11])
  299.            /*******************PULL-DOWN aktivieren **************************/
  300.            if l_aHorMenu[l_iLauf3,4] = NIL
  301.                  l_bExit3 :=.T.
  302.               else
  303.                  l_bExit3 :=.F.
  304.            endif
  305.            //******** Pulldown aufrufen
  306.            do while .NOT.l_bExit3    //Solange l_bExit3<>.T.
  307.              //********BS speichern
  308.              if len(l_aBild3) < p_iLauf5
  309.                     AAdd(l_aBild3,savescreen(0,0,24,79))
  310.                 else
  311.                     l_aBild3[p_iLauf5] := savescreen(0,0,24,79)
  312.              endif
  313.             /************************erster UnterMenuAufruf***********************
  314.              *************************Bild vorbereiten****************************/
  315.              p_aColorA    := ListAsArray(p_aUntMenSpeicher[p_iLauf5,11],',')
  316.              SetColor(p_aUntMenSpeicher[p_iLauf5,11])
  317.              if (aMenuArray[iMenuNum,9]).and.(p_iLauf5 = 1)  // wenn Unterbalken
  318.                 @ p_aUntMenSpeicher[p_iLauf5,1]-1,p_aUntMenSpeicher[p_iLauf5,2] clear to p_aUntMenSpeicher[p_iLauf5,1]+1,p_aUntMenSpeicher[p_iLauf5,2]+3
  319.              endif
  320.              BoxShadow(p_aUntMenSpeicher[p_iLauf5,1],p_aUntMenSpeicher[p_iLauf5,2],p_aUntMenSpeicher[p_iLauf5,3]+1,p_aUntMenSpeicher[p_iLauf5,4]+1)
  321.              @ p_aUntMenSpeicher[p_iLauf5,1],p_aUntMenSpeicher[p_iLauf5,2] clear to p_aUntMenSpeicher[p_iLauf5,3]+1,p_aUntMenSpeicher[p_iLauf5,4]+1
  322.              @ p_aUntMenSpeicher[p_iLauf5,1],p_aUntMenSpeicher[p_iLauf5,2] to p_aUntMenSpeicher[p_iLauf5,3]+1,p_aUntMenSpeicher[p_iLauf5,4]+1 double
  323.              if (aMenuArray[iMenuNum,9]).and.(p_iLauf5=1)  // wenn Unterbalken
  324.                        @ p_aUntMenSpeicher[p_iLauf5,1]-1,p_aUntMenSpeicher[p_iLauf5,2] say chr(187)+'  '+chr(201)
  325.                        @ p_aUntMenSpeicher[p_iLauf5,1],p_aUntMenSpeicher[p_iLauf5,2] say chr(186)+'  '+chr(200)
  326.              endif
  327.              if (p_iLauf5=1).and.(.NOT.(aMenuArray[iMenuNum,9]))
  328.                        @ p_aUntMenSpeicher[p_iLauf5,1]-1,p_aUntMenSpeicher[p_iLauf5,2] clear to p_aUntMenSpeicher[p_iLauf5,1]-1,p_aUntMenSpeicher[p_iLauf5,2]+3
  329.                        @ p_aUntMenSpeicher[p_iLauf5,1]-1,p_aUntMenSpeicher[p_iLauf5,2] say chr(186)+'  '+chr(186)
  330.                        @ p_aUntMenSpeicher[p_iLauf5,1],p_aUntMenSpeicher[p_iLauf5,2] say chr(186)+'  '+chr(200)
  331.               endif
  332.               if p_iLauf5 > 1
  333.                        @ p_aUntMenSpeicher[p_iLauf5,1],p_aUntMenSpeicher[p_iLauf5,2] say chr(17)
  334.              endif
  335.            @ p_aUntMenSpeicher[p_iLauf5,3]+1,p_aUntMenSpeicher[p_iLauf5,2]+3 say ' '+chr(24)+chr(25)+' '
  336.            SetMessage(p_iZeile,p_iLaenge,p_aUntMenSpeicher[p_iLauf5,6,p_aUntMenSpeicher[p_iLauf5,9]],p_sFarbeMess,p_aColor[2])
  337.            SetColor(p_aUntMenSpeicher[p_iLauf5,11])
  338.            l_iTaste := Achoice(p_aUntMenSpeicher[p_iLauf5,1]+1,p_aUntMenSpeicher[p_iLauf5,2]+1,p_aUntMenSpeicher[p_iLauf5,3],p_aUntMenSpeicher[p_iLauf5,4],p_aUntMenSpeicher[p_iLauf5,5],p_aUntMenSpeicher[p_iLauf5,7],'PDownMessage',p_aUntMenSpeicher[p_iLauf5,9],p_aUntMenSpeicher[p_iLauf5,10])
  339.                if l_iTaste = 0
  340.                    l_bExit1 := .F.
  341.                    if p_iLauf5 > 1
  342.                           ASize(p_aRueck,p_iLauf5)
  343.                       else
  344.                           p_aRueck :={}
  345.                    endif
  346.                    ASize(l_aBild3,p_iLauf5)
  347.                    ASize(p_aUntMenSpeicher,p_iLauf5)
  348.                    if p_iLauf5=1
  349.                        l_bExit3 := .T.
  350.                    endif
  351.                    if p_iLauf5 <= 1
  352.                       p_iLauf5 := 1
  353.                      else
  354.                       p_iLauf5 := p_iLauf5-1
  355.                    endif
  356.                    RestScreen(0,0,24,79,l_aBild3[p_iLauf5])
  357.                  else
  358.                    l_bExit1 :=.T.
  359.                    if len(p_aRueck) <= p_iLauf5
  360.                           AAdd(p_aRueck,l_iTaste)
  361.                       else
  362.                           p_aRueck[p_iLauf5+1] := l_iTaste
  363.                    endif
  364.                    if p_aUntMenSpeicher[p_iLauf5,12] = NIL
  365.                          l_bExit3 :=.T.
  366.                       else
  367.                          p_iLauf5 := p_iLauf5+1
  368.                          if len(p_aUntMenSpeicher) = p_iLauf5-1
  369.                                  AAdd(p_aUntMenSpeicher,NIL)
  370.                                  p_aUntMenSpeicher[p_iLauf5] := p_aUntMenSpeicher[p_iLauf5-1,12,l_iTaste]
  371.                             else
  372.                                  p_aUntMenSpeicher[p_iLauf5] := p_aUntMenSpeicher[p_iLauf5-1,12,l_iTaste]
  373.                          endif
  374.                          l_bExit3 :=.F.
  375.                          if p_aUntMenSpeicher[p_iLauf5,1] = NIL
  376.                              l_bExit3 :=.T.
  377.                          endif
  378.                     endif
  379.                 endif
  380.            enddo
  381.            //********Gewählt oder Abgebrochen
  382.            /********************** ENDE Pull-Down ************/
  383.      //*********************** ende der bearbeitung
  384.      endif
  385.      if l_bExit1 = .T.
  386.         exit
  387.      endif
  388.  endif
  389.  // NEU HINZUGEKOMMEN !!!
  390.  if l_iTempE
  391.     l_iLaufE := l_iLaufE+1
  392.  endif
  393.  //**********************
  394.  l_bExit2 :=.F.
  395. enddo
  396. if udfabbruch
  397.    p_aRueck[len(p_aRueck)]:=p_aRueck[len(p_aRueck)]-1
  398. endif
  399. SetCursor(1)
  400. if grundangaben[1,12]
  401.    restscreen(0,0,24,79,l_sBild1)
  402.  else
  403.   restscreen(0,0,24,79,l_sBild4)
  404. endif
  405. RETURN p_aRueck
  406. /*********************** Ende of Function ************************/
  407. /*****************************************************************/
  408. *
  409. *  ListAsArray( <cList>, <cDelimiter> ) --> aList
  410. *  Konvertiert einen String mit Trennzeichen in ein Array
  411. *
  412. *  Beispiels UDFs zur Verarbeitung von Strings
  413. *
  414. *  Copyright (c) 1990 Nantucket Corp. All rights reserved.
  415. *
  416. *  Deutsche Anpassung:
  417. *  Copyright (c) 1990 Nantucket GmbH
  418. *
  419. */
  420. FUNCTION ListAsArray( cList, cDelimiter )
  421.    LOCAL nPos
  422.    LOCAL aList := {}                            // Definiert leeres Array
  423.  
  424.    IF cDelimiter = NIL
  425.       cDelimiter := ","
  426.    ENDIF
  427.    //
  428.    DO WHILE (nPos := AT(cDelimiter, cList)) != 0
  429.       AADD(aList, SUBSTR(cList, 1, nPos - 1))   // Fügt ein neues Element hinzu
  430.       cList := SUBSTR(cList, nPos + 1)
  431.    ENDDO
  432.    AADD(aList, cList)                           // Letztes Element hinzufügen
  433.    //
  434.    RETURN aList                                 // Array zurückgeben
  435.  
  436.  
  437. /*********************** Ende of Function ************************/
  438.  
  439. /*****************************************************************
  440. *  Occurs( <cSearch>, <cTarget> ) --> nCount
  441. *  Stellt die Anzahl des Zeichens <cSearch> in <cTarget> fest
  442. *
  443. *  Beispiels UDFs zur Verarbeitung von Strings
  444. *
  445. *  Copyright (c) 1990 Nantucket Corp. All rights reserved.
  446. *
  447. *  Deutsche Anpassung:
  448. *  Copyright (c) 1990 Nantucket GmbH
  449. *
  450. ******************************************************************/
  451. FUNCTION Occurs( cSearch, cTarget )
  452.    LOCAL nPos, nCount := 0
  453.    DO WHILE !EMPTY( cTarget )
  454.       IF (nPos := AT( cSearch, cTarget )) != 0
  455.          nCount++
  456.          cTarget := SUBSTR( cTarget, nPos + 1 )
  457.       ELSE
  458.          // End of string
  459.          cTarget := ""
  460.       ENDIF
  461.    ENDDO
  462.    RETURN nCount
  463. /*********************** Ende of Function ************************/
  464. /*****************************************************************
  465. * Name:    WELCHE HOT-KEYS
  466. * Art:     FUNCTION
  467. * Autor:   FRANK PACHER
  468. * Datum:   10.APRIL 1991
  469. * Dateien:  %
  470. * Programme: SAAMENU()
  471. * Compiling: %
  472. * Aufruf:    WHotKey(zeile,menupunkt)
  473. *                    zeile     - Anzeigezeile für Hot-Key
  474. *                    menupunkt - Nummer des Menupunktes
  475. * Glob.Var.:
  476. * Besonderheiten: nur für SAAMENU()
  477. *              (c) by F.PACHER
  478. ******************************************************************/
  479. function WHotKey(x,punkt)
  480. if p_aKoordy[punkt,2] <> NIL
  481.        @ x,p_aKoordy[punkt,1] say p_aKoordy[punkt,2]
  482. endif
  483. return NIL
  484. /*********************** Ende of Function ************************/
  485. /*****************************************************************
  486. * Name:  TEXT_CENTRIEREN
  487. * Art:   FUNCTION
  488. * Autor: PACHER
  489. * Datum: 19/03/91
  490. * Dateien:   %
  491. * Programme: %
  492. * Compiling:   /N /M
  493. * Aufruf:      SetCenterText(ls_menuname,li_zeile,ls_farbe1,ls_begrenz,
  494. *                            ls_farbe2) -> NIL
  495. * Glob.Var.:
  496. * Besonderheiten: ls_menuname = STRING
  497. *                               Text der ausgegeben werden soll
  498. *                 li_zeile    = INTEGER
  499. *                               Ausgabezeile
  500. *                 ls_farbe1   = STRING
  501. *                               Farbe des Namens (vor/nint) (default='w+/r')
  502. *                 ls_begrenz  = STRING[2]
  503. *                               Begrenzungszeichen des Namens (default='')
  504. *                 ls_farbe2   = STRING
  505. *                               Farbe der Begrenzer (vor/hint)
  506. *                                                   (default=color_norm)
  507. *              (c) by F.PACHER
  508. *******************************************************************************/
  509.  
  510. function SetCenterText(ls_menuname,li_zeile,ls_farbe1,ls_begrenz,ls_farbe2)
  511.  
  512. private pi_stranfang
  513. private pi_strende
  514. private pi_strlaenge := len(ls_menuname)
  515. private ps_tmpcolor  := SetColor()
  516. if ls_begrenz <> NIL
  517.     private ps_tmpbe1    :=SubStr(ls_begrenz,1,1)
  518.     private ps_tmpbe2    :=SubStr(ls_begrenz,2,1)
  519. endif
  520.  
  521. if ls_farbe1   = NIL
  522.    ls_farbe1  :='w+/r'
  523. endif
  524. if ls_farbe2   = NIL
  525.    ls_farbe2  := color_norm
  526. endif
  527. pi_stranfang  := INT((80/2)-(pi_strlaenge/2))
  528. pi_strende    := pi_stranfang+pi_strlaenge
  529. if ls_begrenz <> NIL
  530.         SetColor(ls_farbe2)
  531.         @ li_zeile,pi_stranfang-1 say ps_tmpbe1
  532.         @ li_zeile,pi_strende     say ps_tmpbe2
  533. endif
  534. SetColor(ls_farbe1)
  535. @ li_zeile,pi_stranfang say ls_menuname
  536. SetColor(ps_tmpcolor)
  537. return NIL
  538. /*********************** Ende of Function ************************/
  539. /*******************************************
  540. * Name:  NACHICHT SETZEN
  541. * Art:   FUNCTION
  542. * Autor: FRANK PACHER
  543. * Datum: 12.APRIL 1991
  544. * Dateien:   %
  545. * Programme: SAAMENU() / freiverwendbar
  546. * Compiling: /n /m /b
  547. * Aufruf:   SetMessage(p_iZeile,p_iLaenge,l_sMessage,l_sFarbe,l_sFarbeF1)
  548. *                      p_iZeile   - zeile der Nachicht
  549. *                      p_iLaenge  - Max Länge der Nachicht
  550. *                      l_sMessage - Nachicht-Text
  551. *                      l_sFarbe   - farbe d. Nachicht
  552. *                      l_sFarbeF1 - farbe für F1-Darstellung
  553. * Glob.Var.:
  554. * Besonderheiten:
  555. *              (c) by F.PACHER
  556. ******************************************************************/
  557. function SetMessage(p_iZeile,p_iLaenge,l_sMessage,l_sFarbe,l_sFarbeF1)
  558.  
  559. local l_iSpalte1
  560. local l_iSpalte2
  561. l_iSpalte1 := 40-Round((len(l_sMessage)/2),0)
  562. l_iSpalte2 := 40-Round((p_iLaenge/2),0)
  563. SetColor(l_sFarbe)
  564. @ p_iZeile,l_iSpalte2 say replicate(' ',p_iLaenge)
  565. @ p_iZeile,l_iSpalte1 say l_sMessage
  566. @ p_iZeile,0 say '│'
  567. SetColor(l_sFarbeF1)
  568. @ p_iZeile,1 say p_sHotZeig
  569. SetColor(l_sFarbe)
  570. @ p_iZeile,col() say '│'
  571. return NIL
  572. /*********************** Ende of Function ************************/
  573. /*****************************************************************
  574. *  BoxShadow( <nOben>, <nLinks>, <nUnten>, <nRechts> ) --> NIL
  575. *  Zeichnet eine Schattenbox
  576. *
  577. *
  578. *  Copyright (c) 1990 Nantucket Corp. All rights reserved.
  579. *
  580. *  Deutsche Anpassung:
  581. *  Copyright (c) 1990 Nantucket GmbH
  582. *
  583. ******************************************************************/
  584. ******************************************************************/
  585.  
  586. FUNCTION BoxShadow( nTop, nLeft, nBottom, nRight )
  587.    LOCAL nShadTop, nShadLeft, nShadBottom, nShadRight
  588.  
  589.    nShadTop   := nShadBottom := MIN(nBottom + 1, MAXROW())
  590.    nShadLeft  := nLeft + 1
  591.    nShadRight := MIN(nRight + 1, MAXCOL())
  592.  
  593.    RESTSCREEN( nShadTop, nShadLeft, nShadBottom, nShadRight,;
  594.        TRANSFORM( SAVESCREEN(nShadTop, nShadLeft, nShadBottom, nShadRight),;
  595.        REPLICATE("X", nShadRight - nShadLeft + 1 ) ) )
  596.  
  597.    nShadTop    := nTop + 1
  598.    nShadLeft   := nShadRight := MIN(nRight + 1, MAXCOL())
  599.    nShadBottom := nBottom
  600.  
  601.    RESTSCREEN( nShadTop, nShadLeft, nShadBottom, nShadRight,;
  602.        TRANSFORM( SAVESCREEN(nShadTop,  nShadLeft , nShadBottom,  nShadRight),;
  603.        REPLICATE("X", nShadBottom - nShadTop + 1 ) ) )
  604.  
  605.    RETURN NIL
  606. /*********************** Ende of Function ************************/
  607. /*******************************************
  608. * Name: PULL DOWN MESSAGE Release 1.5
  609. * Art:  FUNCTION
  610. * Autor: FRANK PACHER
  611. * Datum: 4.MAI 1991
  612. * Dateien:    %
  613. * Programme:  SAAMENU()
  614. * Compiling:  %
  615. * Aufruf:    PDownMessage(Para1,Para2,Para3)
  616. * Glob.Var.:
  617. * Besonderheiten:  Ist eine UDF() für den Aktuellen Menu Punkt vorhanden,
  618. *                  werden die Rückgabe-parameter von ACHOICE über PDOWNMESSAGE
  619. *                  an die UDF() weitergegeben. (als PRIVATE-Variable)
  620. *                  AModus     -> aktueller ACHOICE-Modus
  621. *                  APosZeiger -> aktuelle Position d. MenuZeigers
  622. *                  APosRel    -> Relative  -"-         -"-
  623. *                  Rueck      -> Rueckgabewert wie bei ACHOICE()-UDFStatus
  624. *                                ( 0 / 1 / 2 / 3)
  625. *                  ACHTUNG : Die Positionierung mittels Buchstabe ist
  626. *                            hier noch NICHT möglich !!
  627. *                            Release 2.0 abwarten !
  628. *                  EXTRA ZUM EINBINDEN
  629. *                  FÜR ACHOICE() ---> Parameter 1 / 2 / 3
  630. *              (c) by F.PACHER
  631. ******************************************************************/
  632. function PDownMessage
  633. parameters AModus, APosZeiger, APosRel
  634.   local l_sBild4
  635.   local udfrueck     := NIL
  636.   local ufunc        := p_aUntMenSpeicher[p_iLauf5,8]
  637.   private Rueck      := 2
  638.  
  639. do case
  640.   case AModus = 1
  641.        Rueck := 2
  642.        @ p_aUntMenSpeicher[p_iLauf5,3]+1,p_aUntMenSpeicher[p_iLauf5,2]+3 say '  '+chr(25)+' '
  643.   case AModus = 2
  644.        Rueck := 2
  645.        @ p_aUntMenSpeicher[p_iLauf5,3]+1,p_aUntMenSpeicher[p_iLauf5,2]+3 say ' '+chr(24)+'  '
  646.   case (AModus = 0)
  647.   SetMessage(p_iZeile,p_iLaenge,p_aUntMenSpeicher[p_iLauf5,6,APosZeiger],p_sFarbeMess,p_aColor[2])
  648.   do case
  649.   case LastKey() = 13
  650.        Rueck := 1
  651.        SetColor(p_aUntMenSpeicher[p_iLauf5,11])
  652.        SetColor(p_aUntMenSpeicher[p_iLauf5,11])
  653.        @ p_aUntMenSpeicher[p_iLauf5,3]+1,p_aUntMenSpeicher[p_iLauf5,2]+3 say ' '+chr(2)+chr(2)+' '
  654.               l_sOldColor := p_aUntMenSpeicher[p_iLauf5,11]
  655.               l_sTempString :=trim(p_aUntMenSpeicher[p_iLauf5,5,APosZeiger])
  656.               l_sTempString :=substr(l_sTempString,1,(p_aUntMenSpeicher[p_iLauf5,4]-p_aUntMenSpeicher[p_iLauf5,2]-1))
  657.               SetColor(p_aColorA[2])
  658.               @ p_aUntMenSpeicher[p_iLauf5,1]+1+APosRel,p_aUntMenSpeicher[p_iLauf5,2]+1 say l_sTempString
  659.               @ p_aUntMenSpeicher[p_iLauf5,1]+1+APosRel,p_aUntMenSpeicher[p_iLauf5,2] say chr(26)
  660.               SetColor(l_sOldColor)
  661.   case (LastKey() = 27).or.(LastKey() = 19).or.(LastKey() = 4)
  662.        Rueck := 0
  663.        SetColor(p_aUntMenSpeicher[p_iLauf5,11])
  664.        @ p_aUntMenSpeicher[p_iLauf5,3]+1,p_aUntMenSpeicher[p_iLauf5,2]+3 say ' '+chr(24)+chr(25)+' '
  665.   case (LastKey() = 5).or.(LastKey() = 24)
  666.        Rueck := 2
  667.        SetColor(p_aUntMenSpeicher[p_iLauf5,11])
  668.        @ p_aUntMenSpeicher[p_iLauf5,3]+1,p_aUntMenSpeicher[p_iLauf5,2]+3 say ' '+chr(24)+chr(25)+' '
  669.   case (LastKey() = 1).or.(LastKey() = 6)
  670.        Rueck := 2
  671.        SetColor(p_aUntMenSpeicher[p_iLauf5,11])
  672.        @ p_aUntMenSpeicher[p_iLauf5,3]+1,p_aUntMenSpeicher[p_iLauf5,2]+3 say ' '+chr(24)+chr(25)+' '
  673.   case (LastKey() = 18).or.(LastKey() = 3)
  674.        Rueck := 2
  675.        SetColor(p_aUntMenSpeicher[p_iLauf5,11])
  676.        @ p_aUntMenSpeicher[p_iLauf5,3]+1,p_aUntMenSpeicher[p_iLauf5,2]+3 say ' '+chr(24)+chr(25)+' '
  677.   otherwise
  678.        Rueck := 2
  679.        SetColor(p_aUntMenSpeicher[p_iLauf5,11])
  680.        @ p_aUntMenSpeicher[p_iLauf5,3]+1,p_aUntMenSpeicher[p_iLauf5,2]+3 say ' '+chr(24)+chr(25)+' '
  681.   endcase
  682. /******************************* UEbergebene UDF() aufrufen ****/
  683.   if (ufunc <> NIL)
  684.       udfrueck:=eval(ufunc)
  685.    endif
  686.   case (AModus = 3)
  687.   SetMessage(p_iZeile,p_iLaenge,p_aUntMenSpeicher[p_iLauf5,6,APosZeiger],p_sFarbeMess,p_aColor[2])
  688.   do case
  689.   case LastKey() = 13
  690.        Rueck := 1
  691.        SetColor(p_aUntMenSpeicher[p_iLauf5,11])
  692.        SetColor(p_aUntMenSpeicher[p_iLauf5,11])
  693.        @ p_aUntMenSpeicher[p_iLauf5,3]+1,p_aUntMenSpeicher[p_iLauf5,2]+3 say ' '+chr(1)+chr(1)+' '
  694.               l_sOldColor := p_aUntMenSpeicher[p_iLauf5,11]
  695.               l_sTempString :=trim(p_aUntMenSpeicher[p_iLauf5,5,APosZeiger])
  696.               l_sTempString :=substr(l_sTempString,1,(p_aUntMenSpeicher[p_iLauf5,4]-p_aUntMenSpeicher[p_iLauf5,2]-1))
  697.               SetColor(p_aColorA[2])
  698.               @ p_aUntMenSpeicher[p_iLauf5,1]+1+APosRel,p_aUntMenSpeicher[p_iLauf5,2]+1 say l_sTempString
  699.               @ p_aUntMenSpeicher[p_iLauf5,1]+1+APosRel,p_aUntMenSpeicher[p_iLauf5,2] say chr(26)
  700.               SetColor(l_sOldColor)
  701.   case (LastKey() = 27).or.(LastKey() = 19).or.(LastKey() = 4)
  702.        Rueck := 0
  703.        SetColor(p_aUntMenSpeicher[p_iLauf5,11])
  704.        @ p_aUntMenSpeicher[p_iLauf5,3]+1,p_aUntMenSpeicher[p_iLauf5,2]+3 say ' '+chr(24)+chr(25)+' '
  705.   case (LastKey() = 5).or.(LastKey() = 24)
  706.        Rueck := 2
  707.        SetColor(p_aUntMenSpeicher[p_iLauf5,11])
  708.        @ p_aUntMenSpeicher[p_iLauf5,3]+1,p_aUntMenSpeicher[p_iLauf5,2]+3 say ' '+chr(24)+chr(25)+' '
  709.   case (LastKey() = 1).or.(LastKey() = 6)
  710.        Rueck := 2
  711.        SetColor(p_aUntMenSpeicher[p_iLauf5,11])
  712.        @ p_aUntMenSpeicher[p_iLauf5,3]+1,p_aUntMenSpeicher[p_iLauf5,2]+3 say ' '+chr(24)+chr(25)+' '
  713.   case (LastKey() = 18).or.(LastKey() = 3)
  714.        Rueck := 2
  715.        SetColor(p_aUntMenSpeicher[p_iLauf5,11])
  716.        @ p_aUntMenSpeicher[p_iLauf5,3]+1,p_aUntMenSpeicher[p_iLauf5,2]+3 say ' '+chr(24)+chr(25)+' '
  717.   case ((LastKey() >= 65).and.(LastKey() <=90 )).or.((LastKey() >= 97).and.(LastKey() <=122 ))
  718.         Rueck := 3
  719.        SetColor(p_aUntMenSpeicher[p_iLauf5,11])
  720.        @ p_aUntMenSpeicher[p_iLauf5,3]+1,p_aUntMenSpeicher[p_iLauf5,2]+3 say ' '+chr(24)+chr(25)+' '
  721.   otherwise
  722.        Rueck := 2
  723.        SetColor(p_aUntMenSpeicher[p_iLauf5,11])
  724.        @ p_aUntMenSpeicher[p_iLauf5,3]+1,p_aUntMenSpeicher[p_iLauf5,2]+3 say ' '+chr(24)+chr(25)+' '
  725.   endcase
  726.   /******************************* UEbergebene UDF() aufrufen ****/
  727.   if (ufunc <> NIL)
  728.       udfrueck:=eval(ufunc)
  729.    endif
  730.   case AModus = 4
  731.      l_sBild4 := SaveScreen(0,0,24,79)
  732.      SetColor('w+/r')
  733.      BoxShadow(8,9,14,32)
  734.      @ 7,8 clear to 14,32
  735.      @ 7,8 to 14,32 double
  736.      @ 7,15 say '╡ FEHLER ╞'
  737.      @ 9,10 say '   Es ist kein'
  738.      @ 10,10 say 'Menupunkt anwählbar !'
  739.      SetColor('w+*/r')
  740.      @ 12,10 say '    <TASTE>'
  741.      SetColor(p_aUntMenSpeicher[p_iLauf5,11])
  742.      tone(2000)
  743.      tone(1500)
  744.      tone(1000)
  745.      tone(950)
  746.      tone(900)
  747.      tone(850)
  748.      tone(800)
  749.      tone(750)
  750.      tone(700)
  751.      inkey(0)
  752.      RestScreen(0,0,24,79,l_sBild4)
  753.      Rueck := 0
  754.      @ p_aUntMenSpeicher[p_iLauf5,3]+1,p_aUntMenSpeicher[p_iLauf5,2]+3 say ' '+chr(24)+chr(25)+' '
  755.    endcase
  756.    if udfrueck<>NIL
  757.       Rueck:=Udfrueck
  758.       if Rueck=1
  759.          udfabbruch:=.T.
  760.       endif
  761.    endif
  762.    SetColor(p_aUntMenSpeicher[p_iLauf5,11])
  763. RETURN Rueck
  764. /*********************** Ende of Function ************************/
  765.  
  766. /************************ END of FILE ****************************/
  767.  
  768.