Перевод целых неотрицательных чисел в различных системах счисления

Министерство образования Республики Таджикистан

Таджикский Технический Университет им. ак. М.С. Осими

кафедра АСОИиУ

Лабораторная работа №4

«Перевод целых неотрицательных чисел в различных системах счисления»

Выполнил:

Принял:

-Душанбе 2009-

Программа Enhanced Converter

Publicx0, x, i, j, zAsDoubleПроцедура инициализации приложения

Public y As String

Private Sub clr_Click()

inp.Text = "" Процедура очистки текстовых полей

out.Text = ""

EndSub

Внешний вид окна приложения с введёнными данными

Private Sub Form_KeyPress(KeyAscii As Integer)

Dim val As String

val = Chr(KeyAscii)

Select Case cmb.ListIndex

Case 0

Select Case val

Case "0"

inp.Text = inp.Text & "0"

Case "1"

inp.Text = inp.Text & "1"

End Select

Case 1

If val >= "0" And val <= "9" Then

If val >= "8" And val <= "9" And inp.Text = "" Then

Exit Sub

Else

End If

inp.Text = inp.Text & CStr(val)

Else

End If

Case 2

If (val >= "0" And val <= "9") Or (val >= "a" And val <= "f") Or (val >= "A" And val <= "F") Then

inp.Text = inp.Text & CStr(val)

Else

End If

Case 3, 4, 5

If val >= "0" And val <= "9" Then

inp.Text = inp.Text & CStr(val)

Else

End If

End Select

End Sub

Private Sub inp_KeyDown(KeyCode As Integer, Shift As Integer)

On Error GoTo err:

If (KeyCode = vbKeyBack) Then

inp.Text = Left(inp.Text, Len(inp.Text) - 1)

ElseIf (KeyCode = vbKeyDelete) Then

inp.Text = ""

Else

End If

Exit Sub

err:

Beep

End Sub

Private Sub Form_Load()

inp.Text = ""

End Sub

Private Sub inp_Change()

Dim d(100) As Double

Dim ds(100) As String

Select Case cmb.ListIndex

Case 0

inp.MaxLength = 40

If inp.Text = "" Then

out.Text = ""

Exit Sub

Else

i = (Len(inp.Text))

x = 0

j = 0

Do

x = x + (val(Mid(inp.Text, i, 1)) * (2 ^ j))

i = i - 1

j = j + 1

Loop Until i = 0

out.Text = x

End If

Case 1

inp.MaxLength = 40

If inp.Text = "" Then

out.Text = ""

Exit Sub

Else

i = (Len(inp.Text))

x = 0

j = 0

Do

x = x + (val(Mid(inp.Text, i, 1)) * (8 ^ j))

i = i - 1

j = j + 1

Loop Until i = 0

out.Text = x

End If

Case 2

inp.MaxLength = 40

z = 0

If inp.Text = "" Then

out.Text = ""

Exit Sub

Else

i = (Len(inp.Text))

x = 0

j = 0

Do

Select Case Mid(inp.Text, i, 1)

Case "A", "a"

z = 10

Case "B", "b"

z = 11

Case "C", "c"

z = 12

Case "D", "d"

z = 13

Case "E", "e"

z = 14

Case "F", "f"

z = 15

Case "0", "1", "2", "3", "4", "5", "6", "7", "8", "9"

z = val(Mid(inp.Text, i, 1))

End Select

x = x + z * (16 ^ j)

i = i - 1

j = j + 1

Loop Until i = 0

out.Text = x

End If

Case 3

inp.MaxLength = 15

On Error GoTo err:

If inp.Text = "" Then

out.Text = ""

Exit Sub

ElseIf val(inp.Text) = 0 Or val(inp.Text) = 1 Then

out.Text = inp.Text

Exit Sub

Else

i = 1

x0 = val(inp.Text)

Do

d(i) = val(x0 - (val(x0 / 2) * 2))

x = Round((x0 / 2) - 0.3, 0)

i = i + 1

x0 = x

Loop Until x = 1

d(i) = x

out.Text = ""

Do

out.Text = out.Text & val(d(i))

i = i - 1

Loop Until i = 0

End If

Case 4

inp.MaxLength = 15

On Error GoTo err:

If inp.Text = "" Then

out.Text = ""

Exit Sub

Else

i = 1

x0 = val(inp.Text)

If x0 >= 0 And x0 <= 7 Then

out.Text = inp.Text

Exit Sub

Else

Do

d(i) = val(x0 - (val(x0 / 8) * 8))

x = val(x0 / 8)

If x >= 0 And x <= 7 Then

i = i + 1

d(i) = x

Exit Do

Else

i = i + 1

x0 = x

End If

Loop Until x = 1

out.Text = ""

Do

out.Text = val(out.Text) & val(d(i))

i = i - 1

Loop Until i = 0

End If

End If

Case 5

inp.MaxLength = 15

z = 0

If inp.Text = "" Then

out.Text = ""

Exit Sub

Else

i = 1

x0 = val(inp.Text)

If val(inp.Text) >= 0 And val(inp.Text) <= 15 Then

Select Case val(inp.Text)

Case 10

y = "A"

Case 11

y = "B"

Case 12

y = "C"

Case 13

y = "D"

Case 14

y = "E"

Case 15

y = "F"

Case 0, 1, 2, 3, 4, 5, 6, 7, 8, 9

y = inp.Text

End Select

out.Text = y

Exit Sub

Else

Do

z = val(x0 - (val(x0 / 16) * 16))

Select Case z

Case 10

y = "A"

Case 11

y = "B"

Case 12

y = "C"

Case 13

y = "D"

Case 14

y = "E"

Case 15

y = "F"

Case 0, 1, 2, 3, 4, 5, 6, 7, 8, 9

y = CStr(z)

End Select

ds(i) = y

x = val(x0 / 16)

If x <= 0 Then Exit Do

i = i + 1

x0 = x

Loop Until x = 1

out.Text = ""

Do

out.Text = out.Text & ds(i)

i = i - 1

Loop Until i = 0

End If

End If

End Select

ExitSub

err:

MsgBox "Введены неверные значения или значения не являются корректными", , "=VaMp1r3=™"

Call clr_Click

End Sub

Private Sub cmb_Click()

Call clr_Click

End Sub

Private Sub ext_Click()

End

End Sub

Private Sub cop_Click()

MsgBox "=VaMp1r3=™. Все права защищены. По всем вопросам а также с претензиями обращаться в гр. 6546 Б2 к Столову Юрию.", , "=VaMp1r3=™"

End Sub