home *** CD-ROM | disk | FTP | other *** search
/ Boston 2 / boston-2.iso / DOS / DEUTSCH / SONSTIGE / KFZWERK / KFZUTL.SC < prev    next >
Text File  |  1993-12-01  |  16KB  |  791 lines
  1. ; Kfzutl
  2.  
  3.  
  4. AppLib = "Kfzutl"
  5. Createlib AppLib
  6.  
  7.  
  8. proc HelpKey()
  9.  
  10.   Help
  11.   Echo Normal
  12.  
  13.   while (HelpMode() <> "None")
  14.    KeyPress getchar()
  15.   endwhile
  16.  
  17.   Echo Off
  18. endproc
  19.  
  20. WriteLib AppLib HelpKey
  21. Release Procs HelpKey
  22.  
  23.  
  24. proc ToggleForm(formToggle, frm, QEdit)
  25.  
  26.   if (formToggle) then
  27.     if (inFormView) then
  28.       FormKey
  29.  
  30.       if (QEdit) then
  31.         ; die zu editierende Tabelle muss die erste auf der Arbeitsfläche sein
  32.         FirstShow
  33.       endif
  34.     else
  35.       PickForm frm
  36.     endif
  37.  
  38.     inFormView = (not inFormView)    ; Wert der Variablen InFormView ändern
  39.   else
  40.     Beep
  41.   endif
  42. endproc
  43.  
  44. WriteLib AppLib ToggleForm
  45. Release Procs ToggleForm
  46.  
  47.  
  48. ; Prozedur, die einen Wert vom Typ dt akzeptiert.
  49. ;    Vorgabewert ist dv. Der Anwenderprompt ist prmpt.
  50. ;    Der Wert wird in Zeile l akzeptiert.
  51.  
  52. proc EnterVal(prmpt, dt, dv, l)
  53. private x, t
  54.  
  55.   Style Attribute SysColor(0)                ; prmpt ausgeben
  56.   @ 0, 0 ?? prmpt
  57.   Style Attribute SysColor(2)
  58.   if (l = 1) then
  59.     @ 1, 0
  60.   endif
  61.  
  62.   x = ""                ; akzeptiert einen Wert vom Anwender
  63.   t = type(dv)
  64.   Cursor Normal
  65.   if (t = dt or (t = "N" and (dt = "$" or dt = "S"))) then
  66.     Accept dt Default dv To x
  67.   else
  68.     Accept dt To x
  69.   endif
  70.   EscEnter = not retval
  71.   Cursor Off
  72.  
  73.   Style Attribute SysColor(0)             ; löscht den Prompt und die Eingabe vom Bildschirm
  74.   @ 0, 0
  75.   Clear
  76.  
  77.   return x
  78. endproc
  79.  
  80. WriteLib AppLib EnterVal
  81. Release Procs EnterVal
  82.  
  83.  
  84. proc QueryDoIt()
  85. Private Qord
  86.  
  87.   Message "Abfrage wird durchgeführt"
  88.  
  89.   Qord = QueryOrder()                ; aktuelle Abfrage-Ordnung speichern
  90.   SetQueryOrder TableOrder           ; Tabellen-Ordnung zuweisen
  91.  
  92.   Do_It!        ; Abfrage ausführen für die Operation
  93.   if (Qord = "TableOrder") then     ; auf frühere Ordnung zurücksetzen
  94.     SetQueryOrder TableOrder
  95.   else
  96.     SetQueryOrder ImageOrder
  97.   endif
  98.  
  99.   msg = window()
  100.   tbl = table()
  101.   ClearAll
  102.   Clear
  103.  
  104.   if (ApplicErrorRetVal) then        ; Strukturen passen nicht?
  105.     return FALSE
  106.   endif
  107.  
  108.   if (msg <> "") then
  109.     Message msg
  110.     Sleep 2000
  111.     Clear
  112.   endif
  113.     
  114.   if (tbl <> "Antwort") then
  115.     return FALSE
  116.   endif
  117.  
  118.   return TRUE
  119. endproc
  120.  
  121. WriteLib AppLib QueryDoIt
  122. Release Procs QueryDoIt
  123.  
  124.  
  125. proc ReportTable(rptTbl, sourceTbl, rpt, dest, destFile)
  126.  
  127.   ; nach leerer Tabelle suchen, keinen Report ausgeben, wenn sie leer ist
  128.   if (isempty(rptTbl)) then
  129.    Message "Es gibt keine Records für den Report"
  130.    Sleep 3000
  131.    return FALSE
  132.   endif
  133.  
  134.   if (upper(sourceTbl) <> upper(rptTbl)) then
  135.     ; nur kopieren, wenn es nicht dieselbe Tabelle ist
  136.     CopyReport sourceTbl rpt rptTbl rpt
  137.  
  138.     ; Strukturen passen nicht?
  139.     if (ApplicErrorRetVal) then
  140.       return FALSE
  141.     endif
  142.   endif
  143.  
  144.   Menu {Report} {Druck}
  145.   Select rptTbl
  146.  
  147.   if (ApplicErrorRetVal) then    ; Tabelle existiert nicht?
  148.     Menu Esc
  149.     return FALSE
  150.   endif
  151.  
  152.   if (menuchoice() = "") then
  153.     Menu Esc
  154.     Message rptTbl, " Tabelle ist paßwortgeschützt"
  155.     return FALSE                 ; fragte nach Paßwort
  156.   endif
  157.  
  158.   Select rpt                     ; Report existiert nicht?
  159.   if (ApplicErrorRetVal) then
  160.     Menu Esc
  161.     return FALSE
  162.   endif
  163.  
  164.   switch
  165.     case dest = "Printer":
  166.       Message "Überprüfen, ob der Drucker bereit ist..."
  167.  
  168.       retval = printerstatus()
  169.       if (not retval) then
  170.         Message "Schalten Sie bitte den Drucker ein. Drücken Sie anschließend eine Taste."
  171.     retval = getchar()
  172.  
  173.     retval = printerstatus()
  174.       endif
  175.  
  176.       if (not retval) then
  177.         Message "Drucker nicht bereit. Reportausgabe abgebrochen."
  178.         Menu Esc
  179.       else
  180.         Message "Report wird am Drucker ausgegeben..."
  181.         {Drucker}
  182.       endif
  183.  
  184.     case dest = "Screen":
  185.       {Bildschirm}
  186.  
  187.     case dest = "File":
  188.       Message "Report wird in die Datei " + destFile + " ausgegeben..."
  189.       {Textdatei}
  190.       Select destFile
  191.  
  192.       if (menuchoice() = "Abbruch") then
  193.         {Ersetzen}
  194.       endif
  195.   endswitch
  196.  
  197.   Clear
  198.   Menu Esc
  199.  
  200.   return not ApplicErrorRetVal
  201. endproc
  202.  
  203. WriteLib AppLib ReportTable
  204. Release Procs ReportTable
  205.  
  206.  
  207. ; Prozedur benennt Tabelle um und verwendet angegebenen Präfix
  208.  
  209. proc RenamePre(oldName, pre, n, putMsg)
  210. private name
  211.  
  212.   while (TRUE)
  213.     name = pre + strval(n)
  214.  
  215.     if (not istable(name)) then
  216.       Rename oldName name
  217.     
  218.       if (putMsg) then
  219.         Message oldName, " Tabelle umbenannt in ", name,
  220.                 "; mit beliebiger Taste fortfahren"
  221.  
  222.         Beep Beep
  223.         c = getchar()
  224.       endif
  225.  
  226.       return n + 1
  227.     endif
  228.  
  229.     n = n + 1
  230.   endwhile
  231. endproc
  232.  
  233. WriteLib AppLib RenamePre
  234. Release Procs RenamePre
  235.  
  236.  
  237. ; Prozedur benennt alle Tabellen AltPrä* in NeuPrä## um
  238.  
  239. proc RenameSet(oldPre, newPre)
  240. private oldName, i, n
  241.  
  242.   oldName = oldPre
  243.   n = 1
  244.  
  245.   for i from 1
  246.     if (not istable(oldName)) then
  247.       QuitLoop
  248.     endif
  249.  
  250.     n = RenamePre(oldName, newPre, n, TRUE)
  251.  
  252.     oldName = oldPre + strval(i)
  253.   endfor
  254.  
  255. endproc
  256.  
  257. WriteLib AppLib RenameSet
  258. Release Procs RenameSet
  259.  
  260.  
  261. proc SaveList(tblPre)
  262. private i, renTbls, x
  263.  
  264.   Array renTbls[10]    ; maximale Anzahl von Tabellen zum umbenennen
  265.   ClearAll
  266.   Edit "LISTE"
  267.   CtrlHome   ; zum ersten Feld mit den Namen der umzubenennenden Tabellen
  268.   Right      
  269.  
  270.   i = 0
  271.   scan for [] <> ""                ; alle Eingabe/Indfehl-Tabellen umbenennen
  272.     i = i + 1                      ; Array-Index hochzählen
  273.     renTbls[i] = []                ; Namen der umzubenennenden Tabelle sichern
  274.     [] = tblPre + strval(i - 1)    ; neuen Namen in Tabelle ersetzen
  275.   endscan
  276.  
  277.   Do_It!
  278.   ClearAll
  279.  
  280.   for x from 1 to i
  281.     i = RenamePre(renTbls[x], tblPre, x, FALSE)
  282.   endfor
  283.  
  284.   Menu {Dienste} {Umstrukturieren} {Liste}    ; Hinzufügen des "Formular"-Feldes zur Tabelle
  285.   End
  286.   Down "Form" Right "A2"
  287.   Do_It!
  288.   ClearAll
  289.  
  290. endproc
  291.  
  292. WriteLib AppLib SaveList
  293. Release Procs SaveList
  294.  
  295.  
  296. proc CreateList(tbl, tblPre, sourceTbl)
  297. private i, newTbl, srcTbl
  298.  
  299.   ClearAll
  300.  
  301.   i = RenamePre(tbl, tblPre, 1, FALSE)    ; Eingabe/Indfehl-Tabelle umbenennen
  302.   newTbl = tblPre + strval(i - 1)
  303.   srcTbl = Directory() + sourceTbl
  304.  
  305.   Create "LISTE" upper(tbl) + " Tabelle" : "A" + strval(len(newTbl)),
  306.                 "BASE-Tabelle"          : "A" + strval(len(srcTbl)),
  307.                 "Form"                : "A2"
  308.  
  309.   View "LISTE"        ; Tabellennamen in Liste-Tabelle eintragen
  310.   EditKey
  311.   Right
  312.   [] = newTbl
  313.   Right
  314.   [] = srcTbl
  315.   Do_It!
  316.   ClearAll
  317.  
  318. endproc
  319.  
  320. WriteLib AppLib CreateList
  321. Release Procs CreateList
  322.  
  323.  
  324. proc PrintList(frm, listPre)
  325. private ans
  326.  
  327.   ; sagt dem benutzer, welches Formular verwendet wurde,
  328.   ;    damit er mit Dienste/FormZu die umbenannten Tabellen
  329.   ;    zu den Originalen kopieren kann
  330.  
  331.   View "LISTE"
  332.   EditKey
  333.   CtrlEnd
  334.   [] = frm
  335.   Do_It!
  336.   CtrlHome
  337.  
  338.   RenamePre("LISTE", listPre, 1, FALSE)
  339.   Echo Normal
  340.   Echo Off
  341.  
  342.   ShowMenu "Reportdruck" : "Kurzreport ausgeben von der Tabelle",
  343.            "Fortfahren" : "Fortfahren, ohne einen Kurzreport zu drucken"
  344.       To ans
  345.  
  346.   if (ans = "Reportdruck") then
  347.     ApplicErrorRetVal = FALSE
  348.     InstantReport
  349.  
  350.     if (ApplicErrorRetVal) then
  351.       Message "Bitte Drucker einschalten; anschließend eine beliebige Taste drücken"
  352.       c = getchar()
  353.  
  354.       ApplicErrorRetVal = FALSE
  355.       InstantReport
  356.  
  357.       if (ApplicErrorRetVal) then
  358.         Message "Kurzreport abbrechen"
  359.         Sleep 2000
  360.       endif
  361.     endif
  362.   endif
  363. endproc
  364.  
  365. WriteLib AppLib PrintList
  366. Release Procs PrintList
  367.  
  368.  
  369. ; diese Prozedur benennt die Tabelle INDFEHL um, falls sie vor
  370. ;   Dateneingabe oder nach Edit oder Dateneingabe existiert
  371.  
  372. proc KECheck(beforeDE, renEntry, sourceTbl, frm)
  373. private renList, tblPre, listPre, oldList, tmp, tbl, ans
  374.  
  375.   if (beforeDE) then
  376.     ClearAll
  377.  
  378.     listPre = "KL"
  379.     oldList = "LISTE"
  380.  
  381.     RenameSet("EINGABE", "EN")        ; alle Eingabe-Tabellen umbenennen
  382.     RenameSet("IndFehl", "KV")      ; alle Indfehl-Tabellen umbenennen
  383.  
  384.     if (istable("LISTE")) then
  385.       RenamePre("LISTE", listPre, 1, TRUE)
  386.     endif
  387.   else
  388.     if (renEntry) then
  389.       ; kompletten Pfad der neuen Tabellennamen halten, weil in
  390.       ;    der Liste-Tabelle ebenfalls der volle Pfad steht
  391.       tbl = "EINGABE"
  392.       tblPre = Directory() + "EN"
  393.  
  394.       listPre = "EL"
  395.       oldList = "Sichern"
  396.     else
  397.       ; kompletten Pfad der neuen Tabellennamen halten, weil in
  398.       ;    der Liste-Tabelle ebenfalls der volle Pfad steht
  399.       tbl = "IndFehl"
  400.       tblPre = Directory() + "KV"
  401.  
  402.       listPre = "KL"
  403.       oldList = "Indfehl-Liste"
  404.     endif
  405.  
  406.     if (nimages() > 0 and table() = "LISTE") then
  407.       SaveList(tblPre)
  408.       PrintList(frm, listPre)
  409.     else
  410.       if (istable(tbl)) then
  411.         CreateList(tbl, tblPre, sourceTbl)
  412.         PrintList(frm, listPre)
  413.       endif
  414.     endif
  415.   endif
  416.  
  417.   ClearAll
  418.   Clear
  419. endproc
  420.  
  421. WriteLib AppLib KECheck
  422. Release Procs KECheck
  423.  
  424.  
  425. proc EdFldView(prompt1, prompt2)
  426. private s
  427.  
  428.   while (TRUE)
  429.     FieldView
  430.  
  431.     Wait Field
  432.         Prompt prompt1, prompt2
  433.         Until "F2", "Enter", "CtrlBackspace", "F1"
  434.  
  435.     switch
  436.       case retval = "F1":
  437.         HelpKey()
  438.  
  439.       otherwise:
  440.         if (retval = "CtrlBackspace") then
  441.           CtrlBackspace
  442.         endif
  443.  
  444.         QuitLoop
  445.  
  446.     endswitch
  447.   endwhile
  448.  
  449. endproc
  450.  
  451. WriteLib AppLib EdFldView
  452. Release Procs EdFldView
  453.  
  454.  
  455. proc EntryDoIt(sourceTbl, frm)
  456.  
  457.   Message "Neue Records eintragen"
  458.   Do_It!
  459.  
  460.                       ; Indfehl/Eingabe-tabellen sichern
  461.   KECheck(FALSE, ApplicErrorRetVal, sourceTbl, frm)
  462.   ApplicErrorRetVal = FALSE            ; auf FALSE setzen, wenn Fehler aufgetreten ist
  463.  
  464.   ClearAll
  465.   if (istable("EINGABE")) then    ; sicherstellen, dass Eingabe-Tabelle nach Beendigung gelöscht wird
  466.     Delete "EINGABE"
  467.   endif
  468.  
  469.   Clear
  470. endproc
  471.  
  472. WriteLib AppLib EntryDoIt
  473. Release Procs EntryDoIt
  474.  
  475.  
  476. proc EntryCancel()
  477. private ans
  478.  
  479.   ShowMenu "Nein": "Dateneingabe nicht abbrechen.",
  480.            "Ja" : "Dateneingabe abbrechen."
  481.      To ans
  482.  
  483.   if (ans = "Ja") then
  484.     Message "Dateneingabe abbrechen"
  485.     Sleep 2000
  486.     CancelEdit
  487.  
  488.     ClearAll
  489.     Clear
  490.     return TRUE
  491.   endif
  492.  
  493.   return FALSE
  494. endproc
  495.  
  496. WriteLib AppLib EntryCancel
  497. Release Procs EntryCancel
  498.  
  499.  
  500. proc EntryTable(sourceTbl, mapTbl, frm, formToggle)
  501. private inFormView, inMultiForm, prmpt1, prmpt2
  502.  
  503.   KECheck(TRUE, TRUE, sourceTbl, frm)
  504.  
  505.   Menu {Dienste}
  506.  
  507.   if (mapTbl = "") then            ; Einzeltabellen-Dateneingabe
  508.     {Dateneingabe}
  509.     Select sourceTbl
  510.   else                    ; Multitabellen-Dateneingabe
  511.     {Multieingabe} {Eingabe}
  512.     Select sourceTbl
  513.     Select mapTbl
  514.   endif
  515.  
  516.   if (ApplicErrorRetVal) then
  517.     Menu Esc
  518.     return FALSE
  519.   endif
  520.  
  521.   if (menuchoice() <> "Error") then
  522.     Menu Esc
  523.     Message sourceTbl, " Tabelle ist paßwortgeschützt"
  524.     Sleep 2000
  525.     return FALSE
  526.   endif
  527.  
  528.   if (frm = "") then
  529.     inFormView = FALSE
  530.     inMultiForm = FALSE
  531.   else
  532.     RequiredCheck Off
  533.     PickForm frm
  534.     RequiredCheck On
  535.  
  536.     if (ApplicErrorRetVal) then    ; Verwendung vom Formular sicherstellen
  537.       CancelEdit
  538.       ClearAll
  539.       return FALSE
  540.     endif
  541.  
  542.     inMultiForm = IsMultiForm(sourceTbl, frm)
  543.  
  544.     inFormView = TRUE
  545.   endif
  546.  
  547.   prmpt = "[F2] - Dateneingabe abschließen, [Esc] - Abbrechen, [Ctrl][U] - Widerrufen"
  548.  
  549.   while (TRUE)
  550.     Wait Table
  551.        Prompt prmpt
  552.        Until "F7", "FieldView", "F35", "F2", "Esc", "F1", "F3", "F4"
  553.  
  554.     switch
  555.       case retval = "F7":
  556.         ToggleForm(formToggle, frm, FALSE)
  557.  
  558.       case retval = "FieldView" or retval = "F35":
  559.         EdFldView(prmpt, "")
  560.  
  561.       case retval = "F1":
  562.         HelpKey()
  563.  
  564.       case retval = "Esc":
  565.         if (EntryCancel()) then
  566.           return FALSE
  567.         endif
  568.  
  569.       case retval = "F3":
  570.         if (inMultiForm and inFormView) then
  571.           UpImage
  572.         else
  573.           Beep
  574.         endif
  575.  
  576.       case retval = "F4":
  577.         if (inMultiForm and inFormView) then
  578.           DownImage
  579.         else
  580.           Beep
  581.         endif
  582.  
  583.       otherwise:
  584.         EntryDoIt(sourceTbl, frm)
  585.         return TRUE
  586.     endswitch
  587.   endwhile
  588. endproc
  589.  
  590. WriteLib AppLib EntryTable
  591. Release Procs EntryTable
  592.  
  593.  
  594. proc EditCancel(useDelTable)
  595. private ans
  596.  
  597.   ShowMenu "Nein": "Editieren nicht abbrechen." ,
  598.            "Ja" : "Editieren abbrechen."
  599.      To ans
  600.  
  601.   if (ans = "Ja") then
  602.     Message "Editieren abbrechen"
  603.     Sleep 2000
  604.     CancelEdit
  605.  
  606.     if (useDelTable) then
  607.       Delete "ENTFERNT"
  608.     endif
  609.  
  610.     ClearAll
  611.     Clear
  612.     return TRUE
  613.   endif
  614.  
  615.   return FALSE
  616. endproc
  617.  
  618. WriteLib AppLib EditCancel
  619. Release Procs EditCancel
  620.  
  621.  
  622. ; führt Ok! für eine Einzeltabellen-Sitzung aus
  623.  
  624. proc SEditDoIt()
  625.  
  626.   Do_It!
  627.  
  628.   ClearAll
  629.   Clear
  630. endproc
  631.  
  632. WriteLib AppLib SEditDoIt
  633. Release Procs SEditDoIt
  634.  
  635.  
  636. proc SEditDelIns()
  637.  
  638.   Del
  639. endproc
  640.  
  641. WriteLib AppLib SEditDelIns
  642. Release Procs SEditDelIns
  643.  
  644.  
  645. proc EditTable(edTbl, sourceTbl, mapTbl, frm, formToggle,
  646.            doitProc, delProc, prmpt2, update, useDelTable, QEdit)
  647. private inFormView, inMultiForm, edImage, delImage
  648.  
  649.   if (frm <> "" and upper(edTbl) <> upper(sourceTbl)) then
  650.     ; nur kopieren, wenn Form. gebraucht wird und die Tabellen nicht gleich sind
  651.  
  652.     Menu {Tools} {Kopie} {NurFamilie}
  653.         Select sourceTbl 
  654.         Select edTbl
  655.     {Ersetzen}
  656.  
  657.     ; Strukturen passen nicht?
  658.     if (ApplicErrorRetVal) then
  659.       return FALSE
  660.     endif
  661.   endif
  662.  
  663.   Edit edTbl
  664.   if (ApplicErrorRetVal) then
  665.     return FALSE
  666.   endif
  667.  
  668.   if (useDelTable) then
  669.     edImage = imageno()            
  670.  
  671.     RequiredCheck Off
  672.     MoveTo "ENTFERNT"            
  673.     delImage = imageno()
  674.     MoveTo edImage            
  675.     RequiredCheck On
  676.   endif
  677.  
  678.   if (frm = "") then
  679.     inFormView = FALSE
  680.     inMultiForm = FALSE
  681.   else
  682.     RequiredCheck Off
  683.     PickForm frm
  684.     RequiredCheck On
  685.  
  686.     if (ApplicErrorRetVal) then    ; Verwendung vom Formular sicherstellen
  687.       CancelEdit
  688.       ClearAll
  689.       return FALSE
  690.     endif
  691.  
  692.     inMultiForm = IsMultiForm(sourceTbl, frm)
  693.  
  694.     inFormView = TRUE
  695.   endif
  696.  
  697.   if (update) then
  698.     ImageRights Update
  699.   endif
  700.  
  701.   if (useDelTable) then
  702.     if (formToggle or frm = "") then
  703.       FirstShow
  704.     endif
  705.   endif
  706.  
  707.   prmpt1 = "[F2] - Editieren abschließen, [Esc] - Abbrechen, [Ctrl][U] - Widerrufen"
  708.  
  709.    while (TRUE)
  710.      Wait Table
  711.          Prompt prmpt1, prmpt2
  712.          Until  "Del", "F7", "FieldView", "F35", "F2", "Esc", "F1", "F3", "F4"
  713.  
  714.      switch
  715.        case retval = "Del":
  716.          if (delProc = "") then
  717.           Message "Kann Record nicht löschen"
  718.           Sleep 2000
  719.          else
  720.            ExecProc delProc
  721.          endif
  722.  
  723.        case retval = "F7":
  724.          ToggleForm(formToggle, frm, QEdit)
  725.  
  726.        case retval = "FieldView" or retval = "F35":
  727.          EdFldView (prmpt1, prmpt2)
  728.  
  729.        case retval = "F1":
  730.          HelpKey()
  731.  
  732.        case retval = "F2":
  733.          ExecProc doitProc    ; einige Doit-Prozeduren benötigen initialisierte globale Variable
  734.          return TRUE
  735.  
  736.        case retval = "Esc":
  737.          if (EditCancel(useDelTable)) then
  738.            return FALSE
  739.          endif
  740.  
  741.        case retval = "F3":
  742.          if (inMultiForm and inFormView) then
  743.            UpImage
  744.          else
  745.            Beep
  746.          endif
  747.  
  748.        case retval = "F4":
  749.          if (inMultiForm and inFormView) then
  750.            DownImage
  751.          else
  752.            Beep
  753.          endif
  754.  
  755.     endswitch
  756.   endwhile
  757.  
  758. endproc
  759.  
  760. WriteLib AppLib EditTable
  761. Release Procs EditTable
  762.  
  763.  
  764. proc ApplicErrorProc()
  765. private err, ErrorProc, eMsg, msg, b
  766.  
  767.   err = ErrorCode()
  768.   ApplicErrorRetVal = TRUE
  769.  
  770.   if ((err = 3 or err = 4) and sysmode() = "Dateneingabe") then
  771.     Menu {Sichern}          ; in Eingabe-Tabelle(n) speichern
  772.   else
  773.     eMsg = ErrorMessage()
  774.     if (not match(eMsg, "..Laufzeitfehler: ..", b, msg)) then
  775.       if (not match(eMsg, "..Syntaxfehler: ..", b, msg)) then
  776.         msg = eMsg
  777.       endif
  778.     endif
  779.  
  780.     Message msg
  781.     Sleep 2000
  782.   endif
  783.     
  784.   return 1                    ; Skip-Befehl, der Fehler verursacht
  785. endproc
  786.  
  787. WriteLib AppLib ApplicErrorProc
  788. Release Procs ApplicErrorProc
  789.  
  790.  
  791.