home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 18 REXX / 18-REXX.zip / kzr_0899.zip / x2d.CMD < prev   
OS/2 REXX Batch file  |  1998-07-31  |  9KB  |  301 lines
  1. /* REXX-Programm X2D.CMD                                   */
  2. /* X2D.CMD wandelt dezimale Zahlen in hexadezimale Zahlen. */
  3.    Call RxFuncAdd 'SysLoadFuncs', RexxUtil, 'SysLoadFuncs'
  4.    Call SysLoadFuncs
  5.    Signal on syntax name X2DMsg  
  6.  
  7.    /* Die Dateien "kzr.INF" und "krz.CMD   */
  8.    /* befinden sich im selben Verzeichnis. */
  9.    Pfd=SysSearchPath("PATH", "kzr.cmd")
  10.    lp=LastPos("\", Pfd)
  11.    Pfd=DelStr(Pfd, 1+lp)
  12.  
  13.    parse UPPER arg strstr
  14.    stE=strstr
  15.    /* Zwischenräume aus dem String  strstr  entfernen */
  16.    do forever
  17.      lzw=Pos(" ", strstr)
  18.      if lzw = 0 then leave
  19.      strstr=DelStr(strstr,lzw,1)
  20.    end
  21.  
  22.    if (length(strstr)= 0) then
  23.    do
  24.      "start view.exe" Pfd||"KZR.INF X2D"
  25.      EXIT
  26.    end
  27.  
  28.    ll=length(strstr)
  29.    ND=2*ll+200
  30.    Numeric Digits ND
  31.  
  32.    if Pos(".", strstr)>0 & Pos(",", strstr)==0 then Call kommav
  33.  
  34.    /* Im Eingabestring strstr gibt es weder Komma noch Punkt. */
  35.    if Pos(",", strstr)==0 & Pos(".", strstr)==0 then
  36.    do
  37.    /* Der Eingabestring strstr wird gleich str. */
  38.      stA=strstr 
  39.      stV=strstr
  40.      stN=""
  41.      if DataType(stV, 'X')<>1 then Call EingStr stV
  42.      Signal WW
  43.    end
  44.  
  45.    /* Im Eingabestring gibt es ein Komma, aber keinen Punkt */
  46.    if Pos(",", strstr)>0 & Pos(".", strstr)=0 then
  47.    do
  48.      parse UPPER value strstr with NM ',' str
  49.      stA=str
  50.      stV=str
  51.      stN=""
  52.      if DataType(NM , 'W')<>1 then Call FalschNum NM
  53.      if DataType(NM , 'W')=1 & NM<2 then Call FalschNum NM
  54.      if DataType(stV, 'X')<>1 then Call EingStr stV
  55.      Signal WW
  56.    end
  57.  
  58.    /* Im Eingabestring gibt es sowohl ein Komma als auch einen Punkt */
  59.    if Pos(",", strstr)>0 & Pos(".", strstr)>0 then
  60.    do
  61.      parse UPPER value strstr with NM ',' stV '.' stN
  62.      stA=stV||'.'||stN
  63.      if DataType(NM , 'W')<>1 then Call FalschNum NM
  64.      if DataType(NM , 'W')=1 & NM<2 then Call FalschNum NM
  65.      if length(strip(stV))=0 & length(strip(stN)) =0 then Call Nichts  
  66.      if length(strip(stV))>0 & DataType(stV, 'X')<>1 then Call EingStr stV
  67.      if length(strip(stN))>0 & DataType(stN, 'X')<>1 then Call EingStr stN
  68.    end
  69.  
  70. WW:
  71.    /* Die für die Berechnung einer Mantisse gewünschte Anzahl     */
  72.    /* der Dezimalstellen wird mit der Variablen  NM  eingestellt. */
  73.    NM=strip(NM)
  74.    if NM=="" then NM=20    
  75.  
  76.    stV=strip(stV) 
  77.    if length(stV)>0 then 
  78.    do
  79.      stV=X2D(stV)
  80.    end
  81.  
  82.    stN=strip(stN) 
  83.    if length(stN)>0 then
  84.    do
  85.      stN=X2DMant(stN, NM)
  86.      stN=SubStr(stN, 2)
  87.    end
  88.   
  89.    stG=stV||stN
  90.  
  91.    /* Anfang der Ausgabe-Anweisungen */
  92.    say
  93.    Call Color 1,White
  94.    Call Charout,"  Eingabe:"; say
  95.    Call Color 1,Red
  96.    Call Charout,"  Hexadezimal: "
  97.    Call Color 1,White
  98.    Call Charout,stA; say; say
  99.  
  100.  
  101.    if length(stN)>0 then
  102.    do
  103.    Call Color 0,White
  104.      Call Charout,"  Kann die Mantisse der gewünschten Dezimalzahl,"; say
  105.      Call Charout,"  wie es in den meisten Fällen der Fall ist,"; say
  106.      Call Charout,"  nur als "
  107.      Call Color 1,White
  108.      Call Charout,"Näherungs-Ergebnis"
  109.      Call Color 0,White
  110.      Call Charout," berechnet werden,"; say
  111.      Call Charout,"  so wird die Mantisse mit bis zu "
  112.      Call Color 1,White
  113.      Call Charout,NM
  114.      Call Color 0,White
  115.      Call Charout," Stellen ausgegeben."; say
  116.    end
  117.  
  118.    say
  119.    Call Color 1,White
  120.    Call Charout,"  Ausgabe:"; say
  121.    Call Color 1,green
  122.    Call Charout,"      Dezimal: "
  123.    Call Color 1,White
  124.    Call Charout,strip(stG); say
  125.    /* Ende der Ausgabe-Anweisungen */
  126.  
  127. PgmEnd:
  128.    say
  129.    Call Color 0,White
  130. EXIT
  131.  
  132.  
  133. X2DMant:
  134.    Procedure
  135.    parse upper arg str, NM
  136.    Numeric Digits NM+10
  137.    str=strip(str)
  138.    /* Der Zahlenwert  z.i  der einzelnen Stellen der Hexadezimalzahl  */
  139.    /* wird ermittelt und dann jeweils die Buchstaben A bis F in die   */
  140.    /* Zahlen 10 bis 15 umgewandelt.                                   */
  141.    i=0
  142.    do forever
  143.      z.i=SubStr(str, 1+i, 1)
  144.      z.i=DEZFil(z.i)
  145.      if z.i=" " then leave
  146.      i=i+1
  147.    end
  148.    /* Jede Stelle  z.i  wird mit 16**(-i-1) multipliziert und alle  */
  149.    /* Ergebnisse dann addiert.                                      */
  150.    i=0; DEZ=0
  151.    do forever
  152.      if z.i==" " | i>=NM then leave
  153.      DEZ=DEZ+(z.i)*(16**(-i-1))
  154.      i=i+1
  155.    end
  156.    /* Die Mantisse wird in ein der Zahl NM entsprechendes Format gebracht. */
  157.    Numeric Digits NM
  158.    DEZ=Format(DEZ,,,,)
  159.    /* Angehängte Ziffern '0' werden entfernt. */
  160.    /* Zunächst wird der String umgedreht.     */
  161.    DEZ=Reverse(DEZ)
  162.    /* Jetzt führende Ziffern '0' werden entfernt.   */
  163.    do forever
  164.      if SubStr(DEZ, 1, 1) >"0" then leave
  165.      if SubStr(DEZ, 1, 1)=="0" then
  166.      do
  167.        DEZ=SubStr(DEZ, 2)
  168.      end
  169.    end
  170.    /* Der String wird wieder umgedreht.        */
  171.    DEZ=Reverse(DEZ)
  172.    return(DEZ)
  173.  
  174. DEZFil:
  175.   Procedure
  176.   parse arg zz
  177.   select
  178.     when zz=='A' then zz=10
  179.     when zz=='B' then zz=11
  180.     when zz=='C' then zz=12
  181.     when zz=='D' then zz=13
  182.     when zz=='E' then zz=14
  183.     when zz=='F' then zz=15
  184.     otherwise NOP
  185.   end
  186.   return(zz)
  187.  
  188.  
  189. EingStr:
  190.   say
  191.   parse upper arg stst 
  192.   Call Color 1,White
  193.   Call Charout,"Sie haben in den String "
  194.   Call Color 1,Cyan
  195.   /* Für die Anzeige der aktuellen Berechnung sollen die von  b2d.CMD  */
  196.   /* in große Buchstaben umgewandelte kleinen Buchstaben wieder        */
  197.   /* in kleine Buchstaben umgewandelt werden.                          */
  198.   kl="abcdefghijklmnopqrstuvwxyzäöü";  gr="ABCDEFGHIJKLMNOPQRSTUVWXYZÄÖÜ"
  199.   stst=translate(stst, kl, gr)
  200.   Call Charout,stst; say
  201.   Call Color 1,White
  202.   Call Charout,"der Eingabe-Kette ein oder mehrere"; say
  203.   Call Charout,"für hexadezimale Darstellung "
  204.   Call Charout,"nicht erlaubte Zeichen eingegeben."; say
  205.   Beep(444, 200); Beep(628,300)
  206.   Signal PgmEnd
  207.  
  208.  
  209. Nichts:
  210.   say
  211.   Call Color 1,White
  212.   Call Charout,"Sie haben in die Eingabe-Kette"; say
  213.   Call Charout,"weder für den ganzzahligen Anteil noch für die Mantisse"; say
  214.   Call Charout,"eine Hexadezimalzahl eingegeben."; say
  215.   Beep(444, 200); Beep(628,300)
  216.   Signal PgmEnd
  217.  
  218.  
  219. FalschNum:
  220.   say
  221.   Call Color 1,White
  222.   Call Charout,"Sie haben in die Eingabe-Kette"; say
  223.   Call Charout,"für die Anzahl der intern zu verwendenden Stellen"; say
  224.   Call Charout,"keine positive ganze Zahl "
  225.   Call Color 1,Cyan
  226.   Call Charout,"> 1"
  227.   Call Color 1,White
  228.   Call Charout," eingegeben."; say
  229.   Beep(444, 200); Beep(628,300)
  230.   Signal PgmEnd
  231.  
  232. kommav:
  233.   say
  234.   Call Color 1,white
  235.   Call Charout,"Soll eine nicht ganzzahlige "
  236.   Call Color 1,Red
  237.   Call Charout,"Hexadezimalzahl"
  238.   Call Color 1,white
  239.   Call Charout," in eine "
  240.   Call Color 1,green
  241.   Call Charout,"Dezimalzahl"; say
  242.   Call Color 1,white
  243.   Call Charout,"umgewandelt werden, so muß in der Eingabe-Kette nach dem"; say
  244.   Call Charout,"String  "
  245.   Call Color 1,cyan
  246.   Call Charout,"x2d"
  247.   Call Color 1,white
  248.   Call Charout,"  mindestens  "
  249.   Call Color 1,green
  250.   Call Charout,"1"
  251.   Call Color 1,white
  252.   Call Charout,"  Leerzeichen enthalten sein."; say; say
  253.   Call Charout,"Darauf muß, bevor die in eine "
  254.   Call Color 1,Green
  255.   Call Charout,"Dezimalzahl"
  256.   Call Color 1,white
  257.   Call Charout," umzuwandelnde "; say
  258.   Call Charout,"nicht ganzzahlige "
  259.   Call Color 1,Red
  260.   Call Charout,"Hexadezimalzahl"
  261.   Call Color 1,white
  262.   Call Charout," eingegeben werden kann,"; say
  263.   Call Charout,"eine "
  264.   Call Color 1,cyan
  265.   Call Charout,"ganze Zahl > 1"
  266.   Call Color 1,white
  267.   Call Charout,", gefolgt von einem "
  268.   Call Color 1,cyan
  269.   Call Charout,"einzelnen Komma"
  270.   Call Color 1,white;  say
  271.   Call Charout,"eingegeben werden."; say; say
  272.   Call Charout,"Näheres ist in der "
  273.   Call Color 1,Green
  274.   Call Charout,"kzr.INF"
  275.   Call Color 1,white
  276.   Call Charout," zu finden."
  277.   say
  278.   Beep(444, 200); Beep(628,300)
  279.   Signal PgmEnd
  280.           
  281.   
  282. X2DMsg:
  283.    say
  284.    Call Color 1,White
  285.    Call Charout,"Sie haben bei der Eingabe der Umwandlungs-Aufgabe"; say
  286.    Call Charout,"eines oder mehrere für hexadezinale Darstellung nicht erlaubte ",
  287.    Call Charout,"Zeichen eingegeben."; say
  288.    Beep(444, 200); Beep(628,300)
  289.    Signal PgmEnd
  290.  
  291. /***************************** ANSI-Prozeduren ******************************/
  292.  
  293. Color:     /* Call Color <Attr>,<ForeGround>,<BackGround>                */  
  294. Procedure  /* Attr=1 -> HIGH;  Attr=0 -> LOW; Attr only for ForeGround ! */
  295. arg A,F,B   
  296. CLRS = "BLACK RED GREEN YELLOW BLUE MAGENTA CYAN WHITE"
  297. A=strip(A); if length(A)==0 then A=0    
  298. F=strip(F); if length(F)==0 then F=WHITE
  299. B=strip(B); if length(B)==0 then B=BLACK
  300. return CHAROUT(,D2C(27)||"["A";"WORDPOS(F,CLRS)+29";"WORDPOS(B,CLRS)+39"m")
  301.