Qbasicnews.com
June 23, 2018, 05:27:34 AM *
Welcome, Guest. Please login or register.

Login with username, password and session length
News: Back to Qbasicnews.com | QB Online Help | FAQ | Chat | All Basic Code | QB Knowledge Base
 
   Home   Help Search Login Register  
Pages: [1]
  Print  
Author Topic: Power of number Limitless  (Read 4312 times)
lrcvs
Member
*
Posts: 56


« on: June 09, 2008, 06:24:43 AM »

declare sub b.store (cad$, n$)
declare sub c.pizarra ()
declare sub d.encabezados (a$, b$)
declare sub e.multiplicacion (a$, b$)
declare sub g.suma ()
declare function f.invcad$ (cad$)

'this program, calculates the power of a number
'without limit, with results accurate.
'if the number is greater than 100 will slow.
'the result is displayed.

cls
input "numero a elevar a una potencia = "; a$
z$ = a$
input "potencia = "; v
b$ = a$
cls
for n = 2 to v
a$ = z$
locate 1, 1: print n
call b.store(a$, "a")
call b.store(b$, "b")
call c.pizarra
call d.encabezados(a$, b$)
call e.multiplicacion(a$, b$)
call g.suma
open "i", #3, "r"
10 :
if eof(3) then goto 20
input #3, r$
goto 10
20 :
close (3)


'aqui limpiamos el resultado
'we clean the result
b$ = ""
lr = len(r$)
gg = 0
for qq = 1 to lr
ss$ = mid$(r$, qq, 1)
if val(ss$) > 0 then gg = 1
if gg = 1 then b$ = b$ + mid$(r$, qq, 1)
next qq
next n

cls
print z$; " e"; v; " = "
print b$
print
print "long = "; len(b$)

end

sub b.store (cad$, n$)
'aqui guardamos los datos en un fichero
'here we keep the data in a file
open "o", #1, n$
for m = len(cad$) to 1 step -1
write #1, mid$(cad$, m, 1)
next m
close (1)
end sub

sub c.pizarra
'iniciamos la pizzara
'init the blackboard
open "a", #3, "r"
write #3, ""
close (3)
kill "r"
end sub

sub d.encabezados (a$, b$)
'aqui escribimos los datos en el fichero final
'write data in the end file
'variables
'lt :num,longitud total del multiplicando + multiplicador
'l$ :tex, cadena patron
lt = 0
lt = len(a$) + len(b$) + 1
'escribimos el multiplicando
l$ = string$(lt, " ")
open "a", #3, "r"
mid$(l$, lt - len(a$) + 1) = a$
write #3, l$
close (3)
'escribimos el multiplicador
l$ = string$(lt, " ")
open "a", #3, "r"
mid$(l$, lt - len(b$) - 1) = "x " + b$
write #3, l$
close (3)
end sub

sub e.multiplicacion (a$, b$)
'aqui hacemos la multiplicacion
'do the multiplication
'variables
'lt : num, longitud total del multiplicando + multiplicador
'rp : num, resultado parcial
'acum$ : tex, acumulador de las multiplicaciones
'ls : tex, cadena patron
'c$ : tex, cadena de texto del resultado parcial
'd$ : tex, valor de las unidades
'e$ : tex, valor de lo que nos llevamos
lt = 0
lt = len(a$) + len(b$) + 1
l$ = string$(lt, " ")
c$ = ""
d$ = ""
e$ = ""
ct1 = 1
acum$ = ""
open "i", #2, "b"
while eof(2) <> -1
input #2, b$
open "i", #1, "a"
while eof(1) <> -1
input #1, a$
c$ = ltrim$(str$((val(a$) * val(b$)) + val(acum$)))
if eof(1) <> -1 then d$ = d$ + right$(c$, 1)
if eof(1) = -1 then d$ = d$ + f.invcad$(c$)
acum$ = ltrim$(str$(val(left$(c$, len(c$) - 1))))
wend
close (1)
mid$(l$, lt - ct1 - len(d$) + 2) = f.invcad$(d$)
open "a", #3, "r"
write #3, l$
close (3)
l$ = string$(lt, " ")
acum$ = ""
c$ = ""
d$ = ""
e$ = ""
ct1 = ct1 + 1
wend
close (2)
end sub

function f.invcad$ (cad$)
'aqui invertimos una cadena de texto
'reversing a string
'variables
'lcad : num, longitud cadena entrante
'cadtem$ : tex, acumulador cadena temporal
lcad = len(cad$)
cadtem$ = ""
for cad = lcad to 1 step -1
cadtem$ = cadtem$ + mid$(cad$, cad, 1)
next cad
f.invcad$ = cadtem$
end function

sub g.suma
'aqui sumamos la multiplicacion
'do the addition
'variables
'cf: num, contador del numero de filas
'an: num, longitud del registro
'st: num, resultado parcial
'acus$: tex, acumulador de las que nos llevamos
'k: num, contador de filas
'w$: tex, resultado final
'r$: tex, registro

'aqui calculamos el ancho del registro
'we estimate the width of record
cf = 0
open "i", #3, "r"
while eof(3) <> -1
input #3, r$
cf = cf + 1
an = len(r$)
wend
cf = cf - 2
close (3)

w$ = ""
st = 0
acus$ = ""
for p = 1 to an
k = 0
open "i", #3, "r"
while eof(3) <> -1
input #3, r$
k = k + 1
if k > 2 then st = st + val(mid$(r$, an - p + 1, 1))
if k > 2 then m$ = ltrim$(str$(st + val(acus$)))
wend
w$ = w$ + right$(m$, 1)
acus$ = ltrim$(str$(val(left$(m$, len(m$) - 1))))
close (3)
st = 0
next p

'aqui escribimos el resultado en el fichero
'we write the result in the end file
open "a", #3, "r"
write #3, " " + right$(f.invcad(w$), an - 1)
close (3)
end sub

Logged
NilmTyNc73
New Member

Posts: 6


WWW
« Reply #1 on: October 25, 2009, 01:57:49 PM »

It was specially registered at a forum to tell to you thanks for the help in this question how I can thank you?
Logged
lrcvs
Member
*
Posts: 56


« Reply #2 on: October 26, 2009, 03:20:44 AM »

I am happy that this program will serve to help you.

Thanks !
Logged
Pages: [1]
  Print  
 
Jump to:  

Powered by MySQL Powered by PHP Powered by SMF 1.1.21 | SMF © 2015, Simple Machines Valid XHTML 1.0! Valid CSS!