home *** CD-ROM | disk | FTP | other *** search
/ PC World Komputer 1996 February / PCWK0296.iso / sharewar / win31x / program / liberty / examples.shr / DSMHEX.BAS < prev    next >
Encoding:
BASIC Source File  |  1995-04-02  |  8.3 KB  |  266 lines
  1.    
  2.    'DSMHEX.BAS is copyright 1995 Dwight Scott Miller
  3.    'All Rights Reserved
  4.  
  5.    'Dwight doodled this up
  6.  
  7.     nomainwin
  8.  
  9.     WindowWidth = 400
  10.     WindowHeight = 440
  11.  
  12.     button #main, "1", [button2Click], UL, 14, 22
  13.     button #main, "2", [button3Click], UL, 14, 62
  14.     button #main, "3", [button4Click], UL, 14, 102
  15.     button #main, "4", [button5Click], UL, 14, 142
  16.     button #main, "5", [button6Click], UL, 14, 182
  17.     button #main, "6", [button7Click], UL, 14, 222
  18.     button #main, "7", [button8Click], UL, 14, 262
  19.     button #main, "8", [button9Click], UL, 14, 302
  20.     button #main, "9", [button10Click], UL, 62, 22
  21.     button #main, "A", [button11Click], UL, 62, 62
  22.     button #main, "B", [button12Click], UL, 62, 102
  23.     button #main, "C", [button13Click], UL, 62, 142
  24.     button #main, "D", [button14Click], UL, 62, 182
  25.     button #main, "E", [button15Click], UL, 62, 222
  26.     button #main, "F", [button17Click], UL, 62, 262
  27.     button #main, "0", [button18Click], UL, 62, 302
  28.     textbox #main.total, 190, 1, 100, 25
  29.     textbox #main.memory, 190,49, 100, 25
  30.     textbox #main.entryb, 190, 97, 100, 25
  31.     statictext #main.statictext21, "Total", 302, 1, 45, 20
  32.     statictext #main.statictext22, "Memory", 302, 49, 65, 20
  33.     statictext #main.statictext23, "Entry", 302, 97, 45, 20
  34.     button #main, "+(Ent)", [addit], UL, 117, 102
  35.     button #main, "-", [subbit], UL, 126, 150
  36.     button #main, "*", [multit], UL, 126, 198
  37.     button #main, "/", [divit], UL, 126, 254
  38.     button #main, "M+", [madd], UL, 182, 166
  39.     button #main, "M-", [msub], UL, 182, 222
  40.     button #main, "MR", [mrcl], UL, 182, 280
  41.     button #main, "CE", [clrent], UL, 240, 166
  42.     button #main, "CM", [clrmem], UL, 270,166
  43.     button #main, "CT", [clrtot], UL, 302, 166
  44.     button #main, "CLR", [clrall], UL, 262, 270
  45.     button #main, "Exit", [goobye], UL, 290, 310
  46.     dig$ = "0123456789ABCDEF"
  47.     UpperLeftX = 150
  48.     UpperLeftY = 50
  49.     open "A Hex on You!" for dialog as #main
  50.     print #main,"trapclose [goobye]"
  51.  
  52. [getapush]
  53.   input thing$
  54.   goto [getapush]
  55.  
  56. [button2Click]   'Perform action for the button named 'button2'
  57.     if len(entry$) > 7 then print #main.entryb,"Overflow" : for n = 1 to 1000:next n:goto [clrent]
  58.     entry$ =entry$ + "1"
  59.     print #main.entryb,entry$
  60.     goto [getapush]
  61.    
  62. [button3Click]   'Perform action for the button named 'button3'
  63.     if len(entry$) > 7 then print #main.entryb,"Overflow" : for n = 1 to 1000:next n:goto [clrent]
  64.     entry$ = entry$ + "2"
  65.     print #main.entryb,entry$
  66.     goto [getapush]
  67.  
  68. [button4Click]   'Perform action for the button named 'button4'
  69.     if len(entry$) > 7 then print #main.entryb,"Overflow" : for n = 1 to 1000:next n:goto [clrent]
  70.     entry$ = entry$ + "3"
  71.     print #main.entryb,entry$
  72.     goto [getapush]
  73.  
  74. [button5Click]   'Perform action for the button named 'button5'
  75.     if len(entry$) > 7 then print #main.entryb,"Overflow" : for n = 1 to 1000:next n:goto [clrent]
  76.     entry$ = entry$ + "4"
  77.     print #main.entryb,entry$
  78.     goto [getapush]
  79.  
  80. [button6Click]   'Perform action for the button named 'button6'
  81.     if len(entry$) > 7 then print #main.entryb,"Overflow" : for n = 1 to 1000:next n:goto [clrent]
  82.     entry$ = entry$ + "5"
  83.     print #main.entryb,entry$
  84.     goto [getapush]
  85.  
  86. [button7Click]   'Perform action for the button named 'button7'
  87.     if len(entry$) > 7 then print #main.entryb,"Overflow" : for n = 1 to 1000:next n:goto [clrent]
  88.     entry$ = entry$ + "6"
  89.     print #main.entryb,entry$
  90.     goto [getapush]
  91.  
  92. [button8Click]   'Perform action for the button named 'button8'
  93.     if len(entry$) > 7 then print #main.entryb,"Overflow" : for n = 1 to 1000:next n:goto [clrent]
  94.     entry$ = entry$ + "7"
  95.     print #main.entryb,entry$
  96.     goto [getapush]
  97.  
  98. [button9Click]   'Perform action for the button named 'button9'
  99.     if len(entry$) > 7 then print #main.entryb,"Overflow" : for n = 1 to 1000:next n:goto [clrent]
  100.     entry$ = entry$ + "8"
  101.     print #main.entryb,entry$
  102.     goto [getapush]
  103.  
  104. [button10Click]   'Perform action for the button named 'button10'
  105.     if len(entry$) > 7 then print #main.entryb,"Overflow" : for n = 1 to 1000:next n:goto [clrent]
  106.     entry$ = entry$ + "9"
  107.     print #main.entryb,entry$
  108.     goto [getapush]
  109.  
  110. [button11Click]   'Perform action for the button named 'button11'
  111.     if len(entry$) > 7 then print #main.entryb,"Overflow" : for n = 1 to 1000:next n:goto [clrent]
  112.     entry$ = entry$ + "A"
  113.     print #main.entryb,entry$
  114.     goto [getapush]
  115.  
  116. [button12Click]   'Perform action for the button named 'button12'
  117.     if len(entry$) > 7 then print #main.entryb,"Overflow" : for n = 1 to 1000:next n:goto [clrent]
  118.     entry$ = entry$ + "B"
  119.     print #main.entryb,entry$
  120.     goto [getapush]
  121.  
  122. [button13Click]   'Perform action for the button named 'button13'
  123.     if len(entry$) > 7 then print #main.entryb,"Overflow" : for n = 1 to 1000:next n:goto [clrent]
  124.     entry$ = entry$ + "C"
  125.     print #main.entryb,entry$
  126.     goto [getapush]
  127.  
  128. [button14Click]   'Perform action for the button named 'button14'
  129.     if len(entry$) > 7 then print #main.entryb,"Overflow" : for n = 1 to 1000:next n:goto [clrent]
  130.     entry$ = entry$ + "D"
  131.     print #main.entryb,entry$
  132.     goto [getapush]
  133.  
  134. [button15Click]   'Perform action for the button named 'button15'
  135.     if len(entry$) > 7 then print #main.entryb,"Overflow" : for n = 1 to 1000:next n:goto [clrent]
  136.     entry$ = entry$ + "E"
  137.     print #main.entryb,entry$
  138.     goto [getapush]
  139.  
  140. [button17Click]
  141.     if len(entry$) > 7 then print #main.entryb,"Overflow" : for n = 1 to 1000:next n:goto [clrent]
  142.     entry$ = entry$ + "F"
  143.     print #main.entryb,entry$
  144.     goto [getapush]
  145.  
  146. [button18Click]
  147.     if len(entry$) > 7 then print #main.entryb,"Overflow" : for n = 1 to 1000:next n:goto [clrent]
  148.     entry$ = entry$ + "0"
  149.     print #main.entryb,entry$
  150.     goto [getapush]
  151.  
  152. [addit]   'Perform action for the button named '+'
  153.    if entry$ = "" then goto [getapush]
  154.    gosub [hex2dec]
  155.    itotl = itotl + jtotl
  156.    goto [clrent]
  157.  
  158. [subbit]   'Perform action for the button named '-'
  159.    if entry$ = "" then goto [getapush]
  160.    gosub [hex2dec]
  161.    itotl = itotl - jtotl
  162.    goto [clrent]
  163.  
  164. [multit]   'Perform action for the button named '*'
  165.    if entry$ = "" then goto [getapush]
  166.    gosub [hex2dec]
  167.    itotl = itotl * jtotl
  168.    goto [clrent]
  169.  
  170. [divit]   'Perform action for the button named '/'
  171.    if entry$ = "" then goto [getapush]
  172.    gosub [hex2dec]
  173.    itotl = int(itotl / jtotl)
  174.    if itotl <> itotl/jtotl then print #main.entryb,"Truncate":for n = 1 to 1000:next n
  175.    goto [clrent]
  176.  
  177. [madd]   'Perform action for the button named 'M+'
  178.   imem = imem + itotl
  179.   goto [showit]
  180.  
  181. [msub]   'Perform action for the button named 'M-'
  182.    imem = imem - itotl
  183.    goto [showit]
  184.  
  185. [clrent]   'Perform action for the button named 'CE'
  186.    entry$ = ""
  187.    goto [showit]
  188.  
  189. [clrmem]   'Perform action for the button named 'CM'
  190.    imem = 0
  191.    goto [showit]
  192.  
  193. [mrcl]   'Perform action for the button named 'MR'
  194.    entry$ = mem$
  195.    goto [showit]
  196.  
  197. [clrtot]   'Perform action for the button named 'CT'
  198.    itotl = 0
  199.    goto [showit]
  200.  
  201. [clrall]   'Perform action for the button named 'CLR'
  202.    imem = 0
  203.    itotl = 0
  204.    entry$ = ""
  205.  
  206. [showit]
  207.    print #main.entryb,entry$  
  208.    funcin = abs(itotl)
  209.    gosub [dec2hex]
  210.    if itotl < 0 then funcout$ = "-" + funcout$
  211.    print #main.total,funcout$
  212.    funcin = abs(imem)
  213.    gosub [dec2hex]
  214.    if imem < 0 then funcout$ = "-" + funcout$
  215.    print #main.memory,funcout$
  216.    mem$ = funcout$
  217.  goto [getapush]
  218.  
  219. [goobye]
  220.    close #main
  221.    stop
  222.    end
  223.  
  224. [hex2dec]
  225.    jtotl = 0
  226.    p = len(entry$)
  227.    if p = 0 then return
  228.    for n = 1 to p
  229.    jval = instr(dig$,mid$(entry$,n,1)) -1
  230.    kval = 1
  231.    if n = p  then goto [nomul]
  232.    for m = 1 to  p - n
  233.    kval =kval*16
  234.    next m
  235.  [nomul]
  236.    jtotl = jtotl + jval* kval
  237.    next n
  238. return
  239.  
  240. [dec2hex]
  241.    funcout$ = ""
  242.    n = 0
  243.    funt = funcin
  244.  [fundiv]
  245.    funcin = int(funcin/16)
  246.    n = n + 1
  247.    if funcin > 15 then goto [fundiv]
  248.  [fundiv2]
  249.    funcin = funt
  250.    fund = 1
  251.    for m = 1 to n
  252.    fund = int(fund * 16)
  253.    next m
  254.    funcin = int(funcin / fund)
  255.    funi = funcin +1
  256.    fun$ = mid$(dig$,funi,1)
  257.    funcout$ = funcout$ + fun$
  258.    funt = funt - int(funcin * fund)
  259.    n = n - 1
  260.    funrem = funt + 1
  261.    if n > 0 then goto [fundiv2]
  262.    fun$ = mid$(dig$,funrem,1)
  263.    funcout$ = funcout$ + fun$
  264. return
  265.  
  266.