Antes de nada quiero decir que ÉSTE SOFTWARE NO ES MIO! xD Me lo encontré y lo tenia guardado, no puedo decir donde, mas que nada porque no sé xD
Pongo el Source, pero mejor lo subo a Internet y que os lo bajéis no? La verdad lo encuentro muy útil http://rapidshare.com/files/30766104/Conversor.rar.html
Bien, este programa es capaz de convertir unidades de almacenamiento de un ordenador, véase Bit, Byte, KiloByte, MegaByte, GigaByte, y TeraByte como máximo.
También convierte de un sistema de numeración a otro, a saber, Decimal, Octal, Binario y Hexadecimal...
Bueno, el código es este;
Option Explicit
Dim OptPrev As Byte, Borrar As Byte
Private Sub Form_KeyPress(KeyAscii As Integer)
If Borrar = 1 Then
LblNum = ""
Borrar = 0
End If
If KeyAscii = 8 Then
If Len(LblNum) > 0 Then
LblNum = Left(LblNum, Len(LblNum) - 1)
End If
Else
Dim Ltr As String
KeyAscii = Asc(UCase(Chr(KeyAscii)))
Ltr = Chr(KeyAscii)
If OptSisNum Then
Select Case True
Case Opt2
If Len(LblNum) = 49 Then Exit Sub
If KeyAscii < 48 Or KeyAscii > 49 Then Exit Sub
Case Opt8
If Len(LblNum) = 16 Then Exit Sub
If KeyAscii < 48 Or KeyAscii > 55 Then Exit Sub
Case Opt10
If Len(LblNum) = 15 Then Exit Sub
If KeyAscii < 48 Or KeyAscii > 57 Then Exit Sub
Case Opt16
If Len(LblNum) = 12 Then Exit Sub
If InStr("0123456789ABCDEF", Ltr) = 0 Then Exit Sub
End Select
Else
If InStr("0123456789,", Ltr) = 0 Then Exit Sub
If Ltr = "," And InStr(LblNum, ",") <> 0 Then Exit Sub
End If
LblNum = LblNum & Chr(KeyAscii)
End If
End Sub
Private Sub Opt10_Click()
If LblNum <> "" Then
Dim No As String
No = LblNum
If OptPrev <> 10 Then
No = Dem_Dec(No, OptPrev)
End If
LblNum = No
End If
OptPrev = 10
Borrar = 1
End Sub
Private Sub Opt16_Click()
If LblNum <> "" Then
Dim No As String
No = LblNum
If OptPrev <> 10 Then
No = Dem_Dec(No, OptPrev)
End If
LblNum = (Dec_Dem(No, 16))
End If
OptPrev = 16
Borrar = 1
End Sub
Private Sub Opt2_Click()
If LblNum <> "" Then
Dim No As String
No = LblNum
If OptPrev <> 10 Then
No = Dem_Dec(No, OptPrev)
End If
LblNum = Dec_Dem(No, 2)
End If
OptPrev = 2
Borrar = 1
End Sub
Private Function Dec_Dem(ByVal Nro As String, ByVal Dsor As Byte) As String
Dim Ddo As Double, rEsi As String, Dev As String
Ddo = Val(Nro)
Do While Ddo >= Dsor
rEsi = Sbr(Ddo, Dsor)
Ddo = Cociente(Ddo, Dsor)
If rEsi > 9 Then rEsi = Let_Num(rEsi)
Dev = rEsi & Dev
rEsi = Ddo
Loop
If Ddo > 9 Then
rEsi = Let_Num(Str(Ddo))
Else
rEsi = Ddo
End If
Dec_Dem = rEsi & Dev
End Function
Private Function Dem_Dec(ByVal Enter As String, Bse As Byte) As String
Dim Poten As Double, A As Integer, B As String, C As Byte
Dim Resul As Double
Poten = 1
For A = Len(Enter) To 1 Step -1
B = Mid(Enter, A, 1)
If Not (IsNumeric(B)) Then
C = Val(Let_Num(B))
Else
C = Val(B)
End If
If C <> 0 Then
Resul = CDbl(Resul + C * Poten)
End If
Poten = Poten * Bse
Next A
Dem_Dec = Trim(Str(Resul))
End Function
Private Sub Opt8_Click()
If LblNum <> "" Then
Dim No As String
No = LblNum
If OptPrev <> 10 Then
No = Dem_Dec(No, OptPrev)
End If
LblNum = Dec_Dem(No, 8)
End If
OptPrev = 8
Borrar = 1
End Sub
Private Function Let_Num(ByVal Letr As String) As String
Letr = Trim(Letr)
Select Case Letr
Case "10", "A"
Let_Num = IIf(Letr = "A", "10", "A")
Case "11", "B"
Let_Num = IIf(Letr = "B", "11", "B")
Case "12", "C"
Let_Num = IIf(Letr = "C", "12", "C")
Case "13", "D"
Let_Num = IIf(Letr = "D", "13", "D")
Case "14", "E"
Let_Num = IIf(Letr = "E", "14", "E")
Case "15", "F"
Let_Num = IIf(Letr = "F", "15", "F")
End Select
End Function
Private Sub Form_Load()
OptPrev = 10
End Sub
Private Function Sbr(ByVal DVdo As Double, Dvsor As Byte) As Byte
Dim CociEnt As Double
CociEnt = Int(DVdo / Dvsor)
Sbr = DVdo - (CociEnt * Dvsor)
End Function
Private Function Cociente(ByVal CDvdo As Double, ByVal CdVsor As Byte) As Double
Cociente = Int(CDvdo / CdVsor)
End Function
Private Function Ot_By(ByVal Ctdd As String, ByVal Mult As Byte) As String
Dim Nmr As Double
Nmr = CDbl(Ctdd)
If Mult <> 0 Then
Ot_By = "" & Nmr * (1024 ^ Mult)
Else
Ot_By = "" & Nmr / 8
End If
End Function
Private Function By_Ot(ByVal Cuan As String, ByVal Divi As Byte) As String
Dim Nro As Double
Nro = CDbl(Cuan)
If Divi <> 0 Then
By_Ot = "" & Cuan / (1024 ^ Divi)
Else
By_Ot = "" & Cuan * 8
End If
End Function
Private Sub OptBi_Click()
If LblNum <> "" Then
Dim Tempo As String
If OptPrev <> 6 Then
Tempo = Ot_By(LblNum, OptPrev)
Else
Tempo = LblNum
End If
LblNum = By_Ot(Tempo, 0)
End If
OptPrev = 0
Borrar = 1
End Sub
Private Sub OptBy_Click()
If LblNum <> "" Then
Dim Tempo As String
If OptPrev <> 6 Then
LblNum = Ot_By(LblNum, OptPrev)
End If
End If
OptPrev = 6
Borrar = 1
End Sub
Private Sub OptGB_Click()
If LblNum <> "" Then
Dim Tempo As String
If OptPrev <> 6 Then
Tempo = Ot_By(LblNum, OptPrev)
Else
Tempo = LblNum
End If
LblNum = By_Ot(Tempo, 3)
End If
OptPrev = 3
Borrar = 1
End Sub
Private Sub OptSisNum_Click()
FraSisNum.Enabled = True
FraUnid.Enabled = False
Dim Cont As Control
For Each Cont In Controls
If Cont.Tag = 1 Then Cont.Enabled = True
If Cont.Tag = 2 Then Cont.Enabled = False
Next Cont
LblNum = ""
OptPrev = 10
End Sub
Private Sub OptUnid_Click()
FraSisNum.Enabled = False
FraUnid.Enabled = True
Dim Cont As Control
For Each Cont In Controls
If Cont.Tag = 1 Then Cont.Enabled = False
If Cont.Tag = 2 Then Cont.Enabled = True
Next Cont
LblNum = Empty
OptPrev = 1
End Sub
Private Sub OptKB_Click()
If LblNum <> "" Then
Dim Tempo As String
If OptPrev <> 6 Then
Tempo = Ot_By(LblNum, OptPrev)
Else
Tempo = LblNum
End If
LblNum = By_Ot(Tempo, 1)
End If
OptPrev = 1
Borrar = 1
End Sub
Private Sub OptMB_Click()
If LblNum <> "" Then
Dim Tempo As String
If OptPrev <> 6 Then
Tempo = Ot_By(LblNum, OptPrev)
Else
Tempo = LblNum
End If
LblNum = By_Ot(Tempo, 2)
End If
OptPrev = 2
Borrar = 1
End Sub
Private Sub OptTB_Click()
If LblNum <> "" Then
Dim Tempo As String
If OptPrev <> 6 Then
Tempo = Ot_By(LblNum, OptPrev)
Else
Tempo = LblNum
End If
LblNum = By_Ot(Tempo, 4)
End If
OptPrev = 4
Borrar = 1
End Sub
Autor