|
Тема
|
въпрос за програмен код на VB
|
|
Автор |
mixi (непознат
) |
Публикувано | 03.06.06 13:22 |
|
искам да попитам нещо,ако някой може да ми помогне,имам задача -трябва да напиша програмен код на бутон ,който трябва да превръща въведени арабски числа в римски,ако все пак някой ми обърне внимание благодаря много за което...
Редактирано от mixi на 03.06.06 13:26.
| |
Тема
|
Решение на VBScript.
[re: mixi]
|
|
Автор |
Учeщ (скромен тип) |
Публикувано | 03.06.06 15:47 |
|
Не съм сигурен че това ще ти свърши работа защото чист 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>
От неизбежното се възмущава само този, който е неразумен.
| |
Тема
|
Re: Решение на VBScript.
[re: Учeщ]
|
|
Автор | Пeтko (Нерегистриран) |
Публикувано | 03.06.06 22:23 |
|
Така като те гледам и римска бройна система никога не си ползвал...
| |
Тема
|
Re: Решение на VBScript.
[re: Пeтko]
|
|
Автор |
Учeщ (скромен тип) |
Публикувано | 04.06.06 12:03 |
|
Не съм ползвал, вярно е. Ако не броим номерацията на етажите в блока в който живея. Хвърлих един поглед специално по случая. Ако имаш
по-добро решение би било добре да го споделиш да научим нещо. Функцията е ламерска явно но работи (уж).
От неизбежното се възмущава само този, който е неразумен.Редактирано от Учeщ на 04.06.06 12:04.
| |
Тема
|
Re: въпрос за програмен код на VB
[re: mixi]
|
|
Автор |
eфp. Лyk (*) |
Публикувано | 05.06.06 20:21 |
|
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 жители"?
| |
Тема
|
Re: въпрос за програмен код на VB
[re: mixi]
|
|
Автор | commercial (Нерегистриран) |
Публикувано | 05.06.06 20:30 |
|
Това решение е на 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.
| |
Тема
|
Re: въпрос за програмен код на VB
[re: mixi]
|
|
Автор |
fiffy () |
Публикувано | 06.06.06 22:03 |
|
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
| |
|
|
|
|