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

Редактирано от mixi на 03.06.06 13:26.

Не съм сигурен че това ще ти свърши работа защото чист 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>

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

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

Съдържаниет е скрито
Влезте за да го видите

Съдържаниет е скрито
Влезте за да го видите

Редактирано от Учeщ на 04.06.06 12:04.

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 

Това решение е на 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: http://www.vb-helper.com/howto_roman_arabic.html

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