home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 18 REXX / 18-REXX.zip / addeg.zip / addg.cmd < prev    next >
OS/2 REXX Batch file  |  1996-11-07  |  20KB  |  488 lines
  1. /* OS/2-REXX-Programm Addg.CMD, 06.11.1996                           */
  2. Call RxFuncAdd 'SysLoadFuncs', RexxUtil, 'SysLoadFuncs'
  3. Call SysLoadFuncs
  4. "@ echo off"
  5. numeric digits 16
  6. Call SysCls
  7. say
  8. Call CsrAttrib "High";   Call Color "YELLOW","BLACK"
  9. Call Charout,"  Einfache Additions-Routine für Rechnungsbeträge oder irgendwelche Summanden,"; say
  10. Call Charout,"  ============================================================================"; say
  11. Call CsrAttrib "Normal"
  12. Call Charout,"        deren "
  13. Call CsrAttrib "High";     Call Color "magenta"
  14. Call Charout,"absolute Beträge"
  15. Call CsrAttrib "Normal"
  16. Call Charout," größer als 1,0E-6 und kleiner als 1,0E+6"; say
  17. Call Charout,"                          oder exakt gleich Null sind."; say; say
  18. Call Charout,"Geben Sie zunächst die Bezeichnung des Beleges"; say
  19. Call Charout,"-- mit nicht mehr als 40 Characters -- ein und drücken Sie die Eingabetaste."; say; say
  20. Call Charout,"Geben Sie sodann den Betrag des Beleges"; say
  21. Call Charout,"-- wenn er ein Dezimalbruch ist, mit Dezimalkomma oder Dezimalpunkt -- "; say
  22. Call Charout,"ein und drücken Sie die Eingabetaste."; say; say
  23. Call Charout,"Ein zweimaliges Drücken der Eingabetaste ohne vorherige Eingabe einer";say
  24. Call Charout,"Beleg-Bezeichnung und eines Beleg-Betrages beendet die Additions-Routine.";say;say;say
  25. Call Charout,"                                                                     Werte     ";say
  26. Call Charout,"Bezeichnung                                       Wert                der      ";say
  27. Call Charout,"    des                                            des              Zwischen-  ";say
  28. Call Charout,"  Beleges                                        Beleges             Summen    ";say
  29. Call Charout,"========================================║======================================"
  30. say
  31.  
  32. "del" Summe.DAT "1>NUL 2>NUL"
  33.  
  34. /* Kopfleiste in der Datei Summe.DAT schreiben. */
  35. ret=LineOut(Summe.DAT, "                                                                    Werte      ")
  36. ret=LineOut(Summe.DAT, "Bezeichnung                                     Wert                 der       ")
  37. ret=LineOut(Summe.DAT, "    des                                          des               Zwischen-   ")
  38. ret=LineOut(Summe.DAT, "  Beleges                                      Beleges              Summen     ")
  39. ret=LineOut(Summe.DAT, "========================================║======================================")
  40. ret=LineOut(Summe.DAT, "" )
  41.  
  42. n=1; x.1=0; x.0=0; s.0=0; p=0;
  43.  
  44. wieder:
  45. ret=SysCurState("ON")
  46.   Call Charout,"                                                                              "
  47.   Call CsrLeft 78
  48.   parse pull txt
  49.   /* Warnung bei Eingabe zu vieler Buchstaben */
  50.   if length(txt) > 40 then signal AnzTXT
  51. weiter:
  52.   ret=SysCurState("ON")
  53.   pull x
  54.  
  55.   /* Sofern x mit einem Dezimalkomma eingegeben wurde. */
  56.   /* wird die Position des Dezimalkomma's ermittelt,     */
  57.   sop = Pos(",", x)
  58.  
  59.   /* Wenn in  x  kein Dezimalkomma vorhanden ist, ist  sop = 0. */
  60.   /* In diesem Fall ist  x  eine ganze Zahl                     */
  61.   /* oder  x  enthält bereits einen Dezimal-Punkt);             */
  62.   /* die Variable  x  bleibt unverändert.                       */
  63.   /* Wenn Wenn jedoch in  x  ein Dezimalkomma vorhanden ist, */
  64.   /* ist  sop <> 0.  In diesem Falle wird anstelle des         */
  65.   /* Dezimalkomma's ein Dezimalpunkt eingefügt.                */
  66.   if sop <> 0 then x = OverLay(".", x, sop)
  67.  
  68.   /* Eingabetaste ohne vorherige Eingabe beendet die Additions-Routine */
  69.   if length(x) == 0 then signal AnzErg
  70.   /* Warnung bei Eingabe eines Strings, der keine REXX-Zahl ist */
  71.   if datatype(x) == CHAR then signal Anz1
  72.   /* Warnung bei Eingabe zu vieler Ziffern */
  73.   if length(x) > 13 then signal Anz2
  74.   /* Warnung bei Eingabe einer Zahl, deren Betrag größer als 1.0E+0006 ist  */
  75.   if abs(x) > 1.0E+0006 then signal Anz3
  76.   /* Der Wert 0 darf eingegeben werden */
  77.   if x = 0 then signal www
  78.   /* Warnung bei Eingabe einer Zahl,                               */
  79.   /* deren Betrag zwar kleiner als 1.0E-0006 aber größer als 0 ist */
  80.   if abs(x) < 1.0E-0006 then signal Anz4
  81.   www:
  82.   s.n = s.p + x
  83.  
  84.   if abs(s.n) >= 1.0E0007 then Call Zuviel
  85.   /* Anzeige */
  86.   Call CsrUp 2
  87.   Call Charout,txt
  88.   ll1=44-length(txt)
  89.   i=1
  90.   zw1=""; zw0=" ";
  91.   do while i < ll1
  92.     zw1=zw1||zw0
  93.     i=i+1
  94.   end
  95.  
  96.   Call Charout,zw1; Call Charout,format(x, 8)
  97.   /* Erzeugung eines Strings  zw,  dessen Länge von der Anzahl         */
  98.   /* der Ziffern der eingegebenen Zahl einschließlich des Vorzeichens  */
  99.   /* und eines Dezimalkomma's oder eines Dezimalpunktes anhängig ist.  */
  100.   lz = length(format(x, 8, 7)) - length(format(x, 8))
  101.   ll = 8+lz
  102.   i=1
  103.   zw=""; zw0=" ";
  104.   do while i < ll
  105.     zw=zw||zw0
  106.     i=i+1
  107.   end
  108.  
  109.   /* noch Anzeige */
  110.   Call CsrAttrib "High";     Call Color "white"
  111.   Call Charout,zw;       Call Charout,format(s.n, 8, 2);
  112.   Call CsrAttrib "Normal";
  113.   say
  114.  
  115.   ll2=43-length(txt)
  116.   i=1
  117.   zw2=""; zw0=" ";
  118.   do while i < ll2
  119.     zw2=zw2||zw0
  120.     i=i+1
  121.   end
  122.  
  123.   ll3=8+lz
  124.   i=1
  125.   zw3=""; zw0=" ";
  126.   do while i < ll3
  127.     zw3=zw3||zw0
  128.     i=i+1
  129.   end
  130.  
  131.   str=txt||zw2||format(x, 8)||zw3||format(s.n, 8, 2)
  132.   ret1=LineOut(Summe.DAT, str)
  133.   n=n+1; p=n-1
  134.   signal wieder
  135.  
  136.  
  137. ende:
  138. /* Der Befehl "call charout(Summe.DAT)" ist erforderlich, */
  139. /* weil Summe.DAT und somit auch die Datei Summe.DAT      */
  140. /* nicht gelöscht werden kann.                            */
  141. call charout(Summe.DAT)
  142. "del" Summe.DAT "1>NUL 2>NUL"
  143. Call SysCls
  144. EXIT
  145.  
  146. /*************************** eigene Prozeduren ******************************/
  147.  
  148. AnzTXT:
  149.   say
  150.   ret=SysCurState("OFF")
  151.   Call CsrAttrib "High";   Call Color "white"
  152.   Call Charout,"Es sind zu viele Symbole oder Leerzeichen eingegeben worden !"; say; say
  153.   Call CsrAttrib "Normal"
  154.   Call Charout,"Nach Betätigung der Eingabetaste"; say
  155.   Call Charout,"ist die erneute Eingabe der Bezeichnung eines Beleges möglich."; say
  156.   Call Charout,"Bitte aber nicht mehr als 40 Symbole einschließlich der Leerzeichen eingeben."; say
  157.   Beep(444, 200); Beep(628,300)
  158.   pull
  159.   Call CsrUp 6
  160.   Call Charout,"                                                                              ";say
  161.   Call Charout,"                                                                              ";say
  162.   Call Charout,"                                                                              ";say
  163.   Call Charout,"                                                                              ";say
  164.   Call Charout,"                                                                              ";say
  165.   Call Charout,"                                                                              ";say
  166.   Call CsrUp 8
  167.   Call Charout,"                                                                              "
  168.   Call CsrLeft 78
  169.   signal wieder
  170.  
  171. Anz1:
  172.   say
  173.   ret=SysCurState("OFF")
  174.   Call CsrAttrib "High";   Call Color "white"
  175.   Call Charout,"Die Zahleneingabe hat ein falsches Format !"; say; say
  176.   Call CsrAttrib "Normal"
  177.   Call Charout,"Nach Betätigung der Eingabetaste ist die erneute Eingabe einer Zahl möglich."; say
  178.   Beep(444, 200); Beep(628,300)
  179.   pull
  180.   Call CsrUp 4
  181.   Call Charout,"                                                                             ";say
  182.   Call Charout,"                                                                             ";say
  183.   Call Charout,"                                                                             ";say
  184.   Call Charout,"                                                                             ";say
  185.   Call CsrUp 6
  186.   Call Charout,"                                                                              "
  187.   Call CsrLeft 78
  188.   signal weiter
  189.  
  190. Anz2:
  191.   say
  192.   ret=SysCurState("OFF")
  193.   Call CsrAttrib "High";   Call Color "white"
  194.   Call Charout,"Es sind zu viele Ziffern eingegeben worden !"; say; say
  195.   Call CsrAttrib "Normal"
  196.   Call Charout,"Nach Betätigung der Eingabetaste ist die erneute Eingabe einer Zahl möglich."; say
  197.   Beep(444, 200); Beep(628,300)
  198.   pull
  199.   Call CsrUp 4
  200.   Call Charout,"                                                                             ";say
  201.   Call Charout,"                                                                             ";say
  202.   Call Charout,"                                                                             ";say
  203.   Call Charout,"                                                                             ";say
  204.   Call CsrUp 6
  205.   Call Charout,"                                                                              "
  206.   Call CsrLeft 78
  207.   signal weiter
  208.  
  209. Anz3:
  210.   say
  211.   ret=SysCurState("OFF")
  212.   Call CsrAttrib "High";   Call Color "white"
  213.   Call Charout,"Der absolute Betrag der eingegebenen Zahl ist größer als "
  214.                            Call Color "CYAN"
  215.   Call Charout,"1,0E+6"
  216.                            Call Color "white"
  217.   Call Charout," !"; say
  218.   Call Charout,"Dieser Betrag kann in dieser Additions-Routine nicht verwendet werden."; say; say
  219.   Call CsrAttrib "Normal"
  220.   Call Charout,"Nach Betätigung der Eingabetaste ist die erneute Eingabe einer Zahl möglich."; say
  221.   Beep(444, 200); Beep(628,300)
  222.   pull
  223.   Call CsrUp 5
  224.   Call Charout,"                                                                             ";say
  225.   Call Charout,"                                                                             ";say
  226.   Call Charout,"                                                                             ";say
  227.   Call Charout,"                                                                             ";say
  228.   Call Charout,"                                                                             ";say
  229.   Call CsrUp 7
  230.   Call Charout,"                                                                              "
  231.   Call CsrLeft 78
  232.   signal weiter
  233.  
  234. Anz4:
  235.   say
  236.   ret=SysCurState("OFF")
  237.   Call CsrAttrib "High";   Call Color "white"
  238.   Call Charout,"Der absolute Betrag der eingegebenen Zahl"; say
  239.   Call Charout,"ist größer als "
  240.                            Call Color "CYAN"
  241.   Call Charout,"Null"
  242.                            Call Color "white"
  243.   Call Charout," und kleiner als "
  244.                            Call Color "CYAN"
  245.   Call Charout,"1,0E-6"
  246.                            Call Color "white"
  247.   Call Charout," !"; say
  248.   Call Charout,"Dieser Betrag kann in dieser Additions-Routine nicht verwendet werden."; say; say
  249.   Call CsrAttrib "Normal"
  250.   Call Charout,"Nach Betätigung der Eingabetaste ist die erneute Eingabe einer Zahl möglich."; say
  251.   Beep(444, 200); Beep(628,300)
  252.   pull
  253.   Call CsrUp 6
  254.   Call Charout,"                                                                              ";say
  255.   Call Charout,"                                                                              ";say
  256.   Call Charout,"                                                                              ";say
  257.   Call Charout,"                                                                              ";say
  258.   Call Charout,"                                                                              ";say
  259.   Call Charout,"                                                                              ";say
  260.   Call CsrUp 8
  261.   Call Charout,"                                                                              "
  262.   Call CsrLeft 78
  263.   signal weiter
  264.  
  265. Zuviel:
  266.   say
  267.   ret=SysCurState("OFF")
  268.   Call CsrAttrib "High";   Call Color "white"
  269.   Call Charout,"Der absolute Betrag der Endsumme wäre gleich oder größer als "
  270.                            Call Color "CYAN"
  271.   Call Charout,"1,0E+7"
  272.                            Call Color "white"
  273.   Call Charout," !"; say
  274.   Call Charout,"Hierfür ist diese einfache Additions-Routine nicht gedacht."; say; say
  275.   Call CsrAttrib "Normal"
  276.   Call Charout,"Nach Betätigung der Eingabetaste ist die erneute Eingabe einer Zahl möglich."; say
  277.   Beep(444, 200); Beep(628,300)
  278.   pull
  279.   Call CsrUp 5
  280.   Call Charout,"                                                                              ";say
  281.   Call Charout,"                                                                              ";say
  282.   Call Charout,"                                                                              ";say
  283.   Call Charout,"                                                                              ";say
  284.   Call Charout,"                                                                              ";say
  285.   Call CsrUp 7
  286.   Call Charout,"                                                                              "
  287.   Call CsrLeft 78
  288.   signal weiter
  289.  
  290. AnzErg:
  291.   say
  292.   Call CsrAttrib "High";   Call Color "white"
  293.   Call Charout,"Der Wert der Summe";say
  294.   Call Charout,"der "
  295.                            Call Color "green"
  296.   n=n-1
  297.   Call Charout,n
  298.                            Call Color "white"
  299.   Call Charout," eingegebenen Summanden ist: "
  300.                            Call Color "YELLOW"
  301.   Call Charout,s.n
  302.   Call CsrAttrib "Normal"; say
  303.  
  304.   strErg1="Der Wert der Summe"
  305.   strErg2="der eingegebenen Summanden ist              "||format(s.n, 8, 7)
  306.   strErg3="                                                                      "
  307.   strErg4="Endbetrag (auf ganze Pfennige aufgerundet): "||format(s.n, 8, 2)||" DM";
  308.  
  309.   ret=LineOut(Summe.DAT, "")
  310.   ret=LineOut(Summe.DAT, strErg1)
  311.   ret=LineOut(Summe.DAT, strErg2)
  312.   ret=LineOut(Summe.DAT, strErg3)
  313.   ret=LineOut(Summe.DAT, strErg4)
  314.   ret=LineOut(Summe.DAT, "")
  315.  
  316.   say
  317.   Call Charout,"Möchten Sie das Additionsergebnis zusammen mit den Werten der Zwischensummen"; say
  318.   Call Charout,"mit Hilfe des "
  319.   Call CsrAttrib "High";   Call Color "cyan"
  320.   Call Charout,"EPM-Editors"
  321.   Call CsrAttrib "Normal"
  322.   Call Charout," nochmals anschauen"; say
  323.   Call Charout,"und, wenn erforderlich, auch ausdrucken ? (j/*) "; pull x
  324.  
  325.   select
  326.   when x == 'J' then
  327.   do
  328.     Call SysCls
  329.     ret=SysCurState("OFF")
  330.     Call CsrAttrib "High";   Call Color "white","blue"
  331.     Call Locate  5,  2
  332.     Call Charout,"╔════════════════════════════════════════════════════════════════════════════╗"
  333.     Call Locate  6,  2
  334.     Call Charout,"║                                                                            ║"
  335.     Call Locate  7,  2
  336.     Call Charout,"║   In den "
  337.                              Call Color "yellow"
  338.     Call Charout,"Optionen"
  339.                              Call Color "white"
  340.     Call Charout," des "
  341.                              Call Color "cyan"
  342.     Call Charout,"EPM-Editors"
  343.                              Call Color "white"
  344.     Call Charout," sollte folgendes eingestellt sein:       ║"
  345.     Call Locate  8,  2
  346.     Call Charout,"║                                                                            ║"
  347.     Call Locate  9,  2
  348.     Call Charout,"║   Anpassung -> Einstellungen -> Schrift:                                   ║";
  349.     Call Locate 10,  2
  350.     Call Charout,"║                     "
  351.                              Call Color "yellow"
  352.     Call Charout,"                      Schriftart"
  353.                              Call Color "green"
  354.     Call Charout," Courier Bitmap 13*8"
  355.                              Call Color "white","blue"
  356.     Call Charout,"   ║"
  357.     Call Locate 11,  2
  358.     Call Charout,"║                                                                            ║"
  359.     Call Locate 12,  2
  360.     Call Charout,"║                                                                            ║"
  361.     Call Locate 13,  2
  362.     Call Charout,"║   Soll das Ergebnis ausgedruckt werden,                                    ║"
  363.     Call Locate 14,  2
  364.     Call Charout,"║   so sollte in dem Fenster "
  365.                              Call Color "yellow"
  366.     Call Charout," Drucken"
  367.                              Call Color "white","blue"
  368.     Call Charout,"                                        ║"
  369.     Call Locate 15,  2
  370.     Call Charout,"║                                                                            ║"
  371.     Call Locate 16,  2
  372.     Call Charout,"║   die Einstellung "
  373.                              Call Color "green","blue"
  374.     Call Charout,"Unformatierter ASCII-Text"
  375.                              Call Color "white","blue"
  376.     Call Charout," aktiviert sein.                ║"
  377.     Call Locate 17,  2
  378.     Call Charout,"║                                                                            ║"
  379.     Call Locate 18,  2
  380.     Call Charout,"║                                                                            ║"
  381.     Call Locate 19,  2
  382.     Call Charout,"║                         "
  383.                              Call Color "green","blue"
  384.     Call Charout,"Weiter mit der Eingabetaste"
  385.                              Call Color "white","blue"
  386.     Call Charout,"                        ║"
  387.     Call Locate 20,  2
  388.     Call Charout,"║                                                                            ║"
  389.     Call Locate 21,  2
  390.     Call Charout,"╚════════════════════════════════════════════════════════════════════════════╝"
  391.     Call CsrAttrib "Normal"
  392.     pull
  393.     Call SysCls
  394.     EPM Summe.DAT
  395.   end
  396.   otherwise NOP
  397.   end
  398.   signal ende
  399.  
  400. /***************************** ANSI-Prozeduren ******************************/
  401.  
  402. /* Ansi Procedures for moving the cursor */
  403. Locate: Procedure   /*  Call Locate Row,Col */
  404. Row = arg(1)
  405. Col = Arg(2)
  406. Rc = Charout(,D2C(27)"["Row";"col"H")
  407. return ""
  408.  
  409. CsrUp: Procedure  /* CsrUp(Rows) */
  410. Arg u
  411. Rc = Charout(,D2C(27)"["u"A")
  412. return ""
  413.  
  414. CsrDown: Procedure /* CsrDn(Rows) */
  415. Arg d
  416. Rc = Charout(,D2C(27)"["d"B")
  417. return ""
  418.  
  419. CsrRight: Procedure  /* CsrRight(Cols) */
  420. arg r
  421. Rc = Charout(,D2C(27)"["r"C")
  422. Return ""
  423.  
  424. CsrLeft: procedure  /* CsrLeft(Cols) */
  425. arg l
  426. Rc = Charout(,D2C(27)"["l"D")
  427. Return ""
  428.  
  429.  
  430. /*
  431. A------------------------------------------------------------:*
  432. SaveCsr and PutCsr are meant to be used together for saving  :*
  433. and restoring the cursor location. Do not confuse            :*
  434. with Locate, CsrRow, CsrCol, these are different routines.   :*
  435. SaveCsr Returns a string that PutCsr can use.                :*
  436. A:*/
  437. SaveCsr: procedure  /* cursor_location = SaveCsr() (for PutCsr(x))*/
  438. Rc = Charout(,D2C(27)"[6n")
  439. Pull Q
  440. Call CsrUp
  441. return Q
  442.  
  443. PutCsr: procedure  /* Call PutCsr <Previous_Location>  (From SaveCsr() ) */
  444. Where = arg(1)
  445. Rc = Charout(,substr(Where,1,7)"H")
  446. return ""
  447. /*
  448. A:*/
  449. /* clear screen :*/
  450. Cls: Procedure      /* cls() Call Cls */
  451. Rc = CharOut(,D2C(27)"[2J")
  452. return ""
  453.  
  454.     /* get cursors Line */
  455. CsrRow: Procedure      /* Row = CsrRow()*/
  456. Rc = Charout(,D2C(27)"[6n")
  457. Pull Q
  458. Return substr(Q,3,2)
  459.  
  460.    /* get cursors column */
  461. CsrCol: Procedure          /*  Col = CsrCol()  */
  462. Rc = Charout(,D2C(27)"[6n")
  463. Pull Q
  464. return Substr(Q,6,2)
  465.  
  466. /* procedure to color screen
  467. A:--------------------------------------------------------------*
  468. accepts colors: BLACK RED GREEN YELLOW BLUE MAGENTA CYAN WHITE  *
  469. */
  470. Color: Procedure /* Call Color <ForeGround>,<BackGround> */
  471. arg F,B
  472. Colors = "BLACK RED GREEN YELLOW BLUE MAGENTA CYAN WHITE"
  473. return CHAROUT(,D2C(27)"["WORDPOS(F,COLORS)+29";"WORDPOS(B,COLORS)+39";m")
  474.  
  475. /*  change screen attributes
  476. A:---------------------------------------------------------------*
  477. attributes: NORMAL HIGH LOW ITALIC UNDERLINE BLINK RAPID REVERSE *
  478. */
  479. CsrAttrib: Procedure  /* call CsrAttrib <Attrib> */
  480. Arg A
  481. attr = "NORMAL HIGH LOW ITALIC UNDERLINE BLINK RAPID REVERSE"
  482. return CHAROUT(,D2C(27)"["WORDPOS(A,ATTR) - 1";m")
  483.  
  484. EndAll:
  485. Call Color "White","Black"
  486. CALL CsrAttrib "Normal"
  487.  
  488.