Клубове Дир.бг
powered by diri.bg
търси в Клубове diri.bg Разширено търсене

Вход
Име
Парола

Клубове
Dir.bg
Взаимопомощ
Горещи теми
Компютри и Интернет
Контакти
Култура и изкуство
Мнения
Наука
Политика, Свят
Спорт
Техника
Градове
Религия и мистика
Фен клубове
Хоби, Развлечения
Общества
Я, архивите са живи
Клубове Дирене Регистрация Кой е тук Въпроси Списък Купувам / Продавам 22:26 05.07.25 
Компютри и Интернет
   >> Програмисти
*Кратък преглед

Тема въпрос за програмен код на 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




*Кратък преглед
Клуб :  


Clubs.dir.bg е форум за дискусии. Dir.bg не носи отговорност за съдържанието и достоверността на публикуваните в дискусиите материали.

Никаква част от съдържанието на тази страница не може да бъде репродуцирана, записвана или предавана под каквато и да е форма или по какъвто и да е повод без писменото съгласие на Dir.bg
За Забележки, коментари и предложения ползвайте формата за Обратна връзка | Мобилна версия | Потребителско споразумение
© 2006-2025 Dir.bg Всички права запазени.