въпрос за програмен код на VB

искам да попитам нещо,ако някой може да ми помогне,имам задача -трябва да напиша програмен код на бутон ,който трябва да превръща въведени арабски числа в римски,ако все пак някой ми обърне внимание благодаря много за което...

Не съм сигурен че това ще ти свърши работа защото чист VB никога не съм ползвал ако не се брой VBScript и VBA с аксес. Понеже римската бройна система
не е позиционна не може да се направи готино решение според мен. Може би и като изпълнение не е много готино. Първо си го написах на JavaScript а после
го "преразказвах". Сигурно ще се наложи да го променяш за да тръгне под VB.
Успех !

<script type="text/vbscript">

        '*********************************************************

        '  Function to convert an arabic number (aNumber) 

        '  to a roman numeral. aNumber must be between 

        '  0 and 9999.                          

        '                                       03.03.2006

        '*********************************************************

		Function arabianToRoman(aNumber)

			Dim r_ones, r_tens,  r_hund, r_thou, ones, tens, hund , thou, rnum 

		    r_ones = Array("I","II","III","IV","V","VI","VII", "VIII","IX")

			r_tens = Array("X","XX","XXX","XL","L","LX","LXX","LXXX","XC")

			r_hund = Array( "C","CC","CCC","CD","D","DC","DCC", "DCCC","CM")

			r_thou = Array("M","MM","MMM", "MMMM","MMMMM","MMMMMM","MMMMMMM","MMMMMMMM","MMMMMMMMM")

			IF aNumber < 0 OR aNumber > 9999 Then

				arabianToRoman = -1

			End IF

			rnum=""

			ones = aNumber Mod 10

			tens = (aNumber - ones) Mod 100

			hundreds = (aNumber - tens - ones) Mod 1000

			thou = (aNumber - hundreds - tens - ones) Mod 10000

			tens = tens / 10

			hundreds = hundreds / 100

			thou = thou / 1000

			IF  thou > 0 Then 

    			rnum = rnum &  r_thou(thou-1)

			End IF

			IF hundreds > 0  Then 

    			rnum = rnum & r_hund(hundreds-1)

			End IF

			IF tens > 0 Then 

    			rnum = rnum &  r_tens(tens-1)

			End IF

			IF ones > 0  Then

    			rnum = rnum &  r_ones(ones-1)

			End IF

			arabianToRoman=rnum

        End Function

        alert(arabianToRoman(10))

	</script>

От неизбежното се възмущава само този, който е неразумен.

Така като те гледам и римска бройна система никога не си ползвал...

Не съм ползвал, вярно е. Ако не броим номерацията на етажите в блока в който живея. Хвърлих един поглед специално по случая. Ако имаш
по-добро решение би било добре да го споделиш да научим нещо. Функцията е ламерска явно но работи (уж).

От неизбежното се възмущава само този, който е неразумен.

VB не ми е интересен. Ето на Python:

roman_map = {'':0, 'I':1, 'IV':4, 'V':5, 'IX':9, 'X':10, 'XL':40, 'L':50, 

                'XC':90, 'C':100, 'CD':400, 'D':500, 'CM':900, 'M':1000}



romans_sorted = [r for (r,a) in sorted( roman_map.items(), 

                                        cmp = lambda (r1,a1),(r2,a2): a2-a1 )]



def arabic (r):

    if len(r) <= 1:

        return roman_map[r]

    k = (1,2)[ roman_map.has_key( r[:2] )]

    return roman_map[ r[:k] ] + arabic( r[k:] )



def roman( a, s=""):

    for r in romans_sorted:

        rest = a - roman_map[r]

        if  rest >=0 and a>0:

            return roman(rest, s + r)

    return s

    

                

assert roman ( 1888 ) == 'MDCCCLXXXVIII'

assert arabic ( roman ( 1280 ) ) == 1280 #citizens



assert roman ( 1999 )  == 'MCMXCIX'

assert arabic ( roman ( 1999 ) ) == 1999 

Някой помни ли книгата "1280 жители"?

Това решение е на Pascal, но е изключително лесно да се обърне на VB, пък и е добре малко да се напънеш:

{ program to translate Arabian To Roman }

{ by Krylov Dmitriy, krylov@mail.primorye.ru }

program TranslateArabianToRoman;



const

  TransTable: array[1..13] of record

    AN: word;

    RN: string[2];

  end = ((AN: 1000; RN:'M'),  (AN: 900; RN: 'CM'), (AN: 500; RN: 'D'),

         (AN: 400; RN: 'CD'), (AN: 100; RN: 'C'),  (AN: 90; RN: 'XC'),

         (AN: 50; RN: 'L'),   (AN: 40; RN: 'XL'),  (AN: 10; RN: 'X'),

         (AN: 9; RN: 'IX'),   (AN: 5; RN: 'V'),    (AN: 4; RN: 'IV'),

         (AN: 1; RN: 'I'));





var

  RomanNumber: string;

  ArabianNumber: longint;



  CurNum: byte;



  CurSymb: string[2];

  CurVal: word;

begin

  Write('Input Arabian Number: ');

  ReadLn(ArabianNumber);



  {--- Translate ---------}

  RomanNumber := '';

  CurNum := 1;

  repeat

    CurSymb := TransTable[CurNum].RN;

    CurVal := TransTable[CurNum].AN;



    while CurVal <= ArabianNumber do

    begin

      RomanNumber := RomanNumber + CurSymb;

      Dec(ArabianNumber, CurVal);

    end;



    Inc(CurNum);

  until ArabianNumber <= 0;

  {--- End of translate ---------}



  WriteLn('Roman Number: ', RomanNumber);

end.

Google: visual basic roman to arabic
Result: [линк]

Text:
Private Function RomanToArabic(ByVal roman As String) As _
Long
Dim i As Integer
Dim ch As String
Dim result As Long
Dim new_value As Long
Dim old_value As Long

roman = UCase$(roman)
old_value = 1000

For i = 1 To Len(roman)
' See what the next character is worth.
ch = Mid$(roman, i, 1)
Select Case ch
Case "I"
new_value = 1
Case "V"
new_value = 5
Case "X"
new_value = 10
Case "L"
new_value = 50
Case "C"
new_value = 100
Case "D"
new_value = 500
Case "M"
new_value = 1000
End Select

' See if this character is bigger
' than the previous one.
If new_value > old_value Then
' The new value > the previous one.
' Add this value to the result
' and subtract the previous one twice.
result = result + new_value - 2 * old_value
Else
' The new value <= the previous one.
' Add it to the result.
result = result + new_value
End If

old_value = new_value
Next i

RomanToArabic = result
End Function