| Форумы
ЧАТ |
Орешник |
|
| Форумы -» | Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG |
|
| ||
|
|
Новости |
Поиск |
FAQ |
Статьи |
Книги |
Новости VCL
| | Форумы ЧАТ |
Орешник |
|
| |||
| |||
| |||
« предыдущая ветвь | форум | следующая ветвь »
Помогите перевести на Delphi [D7, Win2k, WinXP]
Rostislav Rotaru © (2004-09-27 10:02:00)Здравствуйте. В Basic-е есть функция для получения числа строкой для румынского языка. Пытался перевести на паскал самостоятельно, но не получается. Вот код:
Function SummStr (SC)
Dim adec As Variant
Dim rez As String, k As String, Kop As String, a1 As String, A As String
Dim pz As Integer, ad As Integer, ae As Integer
ReDim zeci(90) As String, sut(9) As String, o(5, 2) As String
ReDim m(4) As Double, Z(4) As Double, s(4) As Double
Dim sn$
zeci(1) = "un"
zeci(2) = "doi"
zeci(3) = "trei"
zeci(4) = "patru"
zeci(5) = "cinci"
zeci(6) = "sase"
zeci(7) = "sapte"
zeci(8) = "opt"
zeci(9) = "noua"
zeci(10) = "zece"
zeci(11) = "unsprezece"
zeci(12) = "doisprezece"
zeci(13) = "treisprezece"
zeci(14) = "patrusprezece"
zeci(15) = "cincisprezece"
zeci(16) = "sasesprezece"
zeci(17) = "saptesprezece"
zeci(18) = "optsprezece"
zeci(19) = "nouasprezece"
zeci(20) = "douazeci"
zeci(30) = "treizeci"
zeci(40) = "patruzeci"
zeci(50) = "cincizeci"
zeci(60) = "sasezeci"
zeci(70) = "saptezeci"
zeci(80) = "optzeci"
zeci(90) = "nouazeci"
sut(1) = "una suta"
sut(2) = "doua sute"
sut(3) = "trei sute"
sut(4) = "patru sute"
sut(5) = "cinci sute"
sut(6) = "sase sute"
sut(7) = "sapte sute"
sut(8) = "opt sute"
sut(9) = "noua sute"
o(1, 1) = "miliarde"
o(1, 2) = "miliard"
o(2, 1) = "milioane"
o(2, 2) = "milion"
o(3, 1) = "mii"
o(3, 2) = "mie"
o(4, 1) = "lei"
o(4, 2) = "leu"
If SC < 0 Then
sn = "-"
SC = -1 * SC
Else
sn = ""
End If
adec = 100000000000000# + (SC * 100)
a1 = adec
A = Mid(a1, 2)
m(1) = Mid(A, 1, 3)
Z(1) = Mid(A, 2, 2)
s(1) = Mid(A, 1, 1)
m(2) = Mid(A, 4, 3)
Z(2) = Mid(A, 5, 2)
s(2) = Mid(A, 4, 1)
m(3) = Mid(A, 7, 3)
Z(3) = Mid(A, 8, 2)
s(3) = Mid(A, 7, 1)
m(4) = Mid(A, 10, 3)
Z(4) = Mid(A, 11, 2)
s(4) = Mid(A, 10, 1)
k = Mid(A, 13, 2)
rez = " "
For pz = 1 To 4
If m(pz) > 1 Then
zeci(1) = "unu"
ElseIf pz = 3 Then
zeci(1) = "una"
End If
If pz < 4 Then
zeci(2) = "doua"
End If
If s(pz) > 0 Then
rez = rez & sut(s(pz)) & " "
End If
If Z(pz) > 0 Then
If Z(pz) < 20 Then
rez = rez & zeci(Z(pz)) & " "
Else
ae = Z(pz) Mod 10
ad = Z(pz) - ae
rez = rez & zeci(ad) & " "
If ae > 0 Then
rez = rez & "si " & Trim(zeci(ae)) & " "
End If
End If
End If
If m(pz) > 0 Then
If m(pz) = 1 Then
rez = rez & Trim(o(pz, 2)) & " "
Else
rez = rez & Trim(o(pz, 1)) & " "
End If
End If
zeci(1) = "un"
zeci(2) = "doi"
Next
If m(1) + m(2) + m(3) + m(4) = 0 Then
rez = rez & "zero lei "
Else
If m(4) = 0 Then
rez = rez & "lei "
End If
End If
SC = Mid(rez, 2) & k & " " & "bani"
Suma_Litere = sn & UCase(Left(SC, 1)) & Mid(SC, 2, Len(SC))
Exit_SummStr:
Exit Function
End Function
Помогите пожалуйста
Спасибо
alless (2004-09-27 19:28:00) [1]2 msguns (27.09.04 15:42) [23]
вот и для таких целей и сделан. Для людей и для удобвство
Rostislav Rotaru (2004-09-27 16:28:00) [2]Спасибо всем кто откликнулся, вроде функция работает, пока остановлюсь на этой. Тема закрыта.
msguns (2004-09-27 15:42:00) [3]Извмняюсь, если не прав, но..
Зачем же ради одной-разъединственной (и далеко не концептуальной, на минуточку !), траблы внедрять целый компонент, да еще неизвестено от кого и как полученный. А если дальше надо будет по-румынски написать дату ? Или на иврите ? И каждый раз будем искать компоненты ? А мы-то сами чтО могем ? Тем более что для решения данной проблемы особого знания не требуется,- просто немного терпения..
Если что, извиняюсь - никого не хотелось обидеть
Rostislav Rotaru (2004-09-27 15:23:00) [4]
> alless (27.09.04 13:34) [21]
Спасибо, посмотрю
alless (2004-09-27 13:34:00) [5]ia otpravil tebe na e-mail komponent. On predstovelaet odin edit, a daniie on pishet v label.
alless (2004-09-27 13:29:00) [6]U menea esti gotovii komponent napisanii uje. Ia iz Moldovi, esli cto. Scaji kak vstretitsea, otdam komponent
msguns (2004-09-27 13:22:00) [7]Типа этого делай:
Const
UkrNumber_10: array[1..9] of string = ('один','два','три','чотири','п`ять','шість','сім','вісім','дев`ять');
UkrNumber_100: array[1..9] of string = ('','двадцять','тридцять','сорок','п`ятдесят','шістдесят','сімдесят','вісімдесят','дев`яносто');
UkrNumber_1000: array[1..9] of string = ('сто','двісті','триста','чотириста','п`ятьсот','шістьсот','сімсот','вісімсот','дев`ятсот');
UkrNumber_20: array[0..9] of string = ('десять','одинадцять','дванадцять','тринадцять','чотирнадцять','п`ятнадцять','шістнадцять','сімнадцять','вісімнадцять', 'дев`ятнадцять');
UkrNumber_Ezp: array[0..5] of string = ('','тисяча','мільон','мільярд','трильйон','квадрильйон');
...
function Ms_ConvertSummaUkr(Vl,VlD: string; VlSex: boolean; Sum: extended): string;
// Функция конвертирования суммы-числа в строку на украинском языке
// Vl - название валюты, VlD - название копеек валюты, VlSex - род валюты: true-муж, false-жен
var
i,n,t: integer;
s: string;
function CompTriada(Numb: integer): string;
// функция получения текстового фрагмента числа от 1 до 999
var
e: integer;
function ConcatString(Const AllLine, Line: string): string;
// процедура присоединения к строке нового фрагмента
begin
result := AllLine;
if Line>'' then
begin
if result>'' then result := result+' ';
result := result+Line;
end;
end;
begin
result := '';
e := Numb mod 100; // Число в сотне (0-99)
result := UkrNumber_1000[Numb div 100]; // Сотни
if e<10 then result := ConcatString(result,UkrNumber_10[e]);
if e in [10..19] then result := ConcatString(result,UkrNumber_20[e-10]);
if e>19 then
begin
result := ConcatString(result,UkrNumber_100[e div 10]) ; // Десятки
result := ConcatString(result,UkrNumber_10[e mod 10]) ; // Единицы
end;
end;
begin
result := '';
n := Round(Sum); // Рубли
i := 0;
while n>0 do // Выделение триад и их конвертация в строку
begin
t := n mod 1000; // Выделение числа-триады
s := CompTriada(t);
if s>'' then
begin
if (i=1) or ((i=0) and (Not VlSex)) then
begin
if (Length(s)>5) and (Copy(s,Length(s)-3,4)='один') then
s := Copy(s,1,Length(s)-4)+'одна';
if (Length(s)>5) and (Copy(s,Length(s)-2,3)='два') then
s := Copy(s,1,Length(s)-3)+'две';
end;
s := s+' '+UkrNumber_Ezp[i];
if i=1 then
begin
if t mod 100 in [10..19] then
s := Copy(s,1,Length(s)-1)
else
begin
s := Copy(s,1,Length(s)-1)+UkrNumber_Tht[t mod 10];
end;
end;
if i>1 then
begin
if t mod 100 in [10..19] then
s := s+'ів'
else
s := s+UkrNumber_Mln[t mod 10];
end;
result := s+' '+result;
end;
n := n div 1000;
inc(i);
end;
if result>'' then
result := AnsiUpperCase(Copy(result,1,1))+Copy(result,2,Length(result)-1)+Vl+' ';
// Обработка копеек
s := IntToStr(Round(Sum*100) Mod 100);
if Length(s)=1 then s := '0'+s; // nn копеек
result := result+s+' '+VlD;
end;
PVOzerski (2004-09-27 13:04:00) [8]Я б, пожалуй, завел бы константный массив с названиями (и разрешил бы переприсвоение констант через {$J+}). Судя по беглому взгляду на код, в ходе выполнения меняются только 1-е 2 элемента этого массива, зачем же дополнительные тормоза?
TUser (2004-09-27 13:01:00) [9]
> надо ли что-то менять?
Ты же перевел все точно с Бейсика. Все должно работать. А насчет менять - здесь не все знакомы с русмынским языком.
Rostislav Rotaru (2004-09-27 12:55:00) [10]Перевел, вроде работает. Выставляю на всеобщее обозрение:
function Summstr(SC: extended): string;
var
zeci: array [1..90] of string;
sut: array [1..9] of string;
o: array [1..4, 1..2] of string;
sn, a1, A, k, rez: string;
adec: Extended;
pz, ae, ad: integer;
var m:array [1..4] of string;
var z:array [1..4] of string;
var s:array [1..4] of string;
begin
zeci[1]:='un';
zeci[2] := 'doi';
zeci[3] := 'trei';
zeci[4] := 'patru';
zeci[5] := 'cinci';
zeci[6] := 'sase';
zeci[7] := 'sapte';
zeci[8] := 'opt';
zeci[9] := 'noua';
zeci[10] := 'zece';
zeci[11] := 'unsprezece';
zeci[12] := 'doisprezece';
zeci[13] := 'treisprezece';
zeci[14] := 'patrusprezece';
zeci[15] := 'cincisprezece';
zeci[16] := 'sasesprezece';
zeci[17] := 'saptesprezece';
zeci[18] := 'optsprezece';
zeci[19] := 'nouasprezece';
zeci[20] := 'douazeci';
zeci[30] := 'treizeci';
zeci[40] := 'patruzeci';
zeci[50] := 'cincizeci';
zeci[60] := 'sasezeci';
zeci[70] := 'saptezeci';
zeci[80] := 'optzeci';
zeci[90] := 'nouazeci';
sut[1] := 'una suta';
sut[2] := 'doua sute';
sut[3] := 'trei sute';
sut[4] := 'patru sute';
sut[5] := 'cinci sute';
sut[6] := 'sase sute';
sut[7] := 'sapte sute';
sut[8] := 'opt sute';
sut[9] := 'noua sute';
o[1, 1] := 'miliarde';
o[1, 2] := 'miliard';
o[2, 1] := 'milioane';
o[2, 2] := 'milion';
o[3, 1] := 'mii';
o[3, 2] := 'mie';
o[4, 1] := 'lei';
o[4, 2] := 'leu';
if SC < 0 then
begin
sn := '-';
SC := -1 * SC
end
else
sn := '';
adec := 100000000000000 + (SC * 100);
a1 := FloatToStr(adec);
A := copy(a1, 2, length(a1));
m[1]:=copy(A, 1, 3);
z[1]:=copy(A, 2, 2);
s[1]:=copy(A, 1, 1);
m[2]:=copy(A, 4, 3);
z[2]:=copy(A, 5, 2);
s[2]:=copy(A, 4, 1);
m[3]:=copy(A, 7, 3);
z[3]:=copy(A, 8, 2);
s[3]:=copy(A, 7, 1);
m[4]:=copy(A, 10, 3);
z[4]:=copy(A, 11, 2);
s[4]:=copy(A, 10, 1);
k := copy(A, 13, 2);
rez:=' ';
for pz := 1 to 4 do
begin
if strtoint(m[pz]) > 1 then
zeci[1]:= 'unu'
else if pz = 3 then
zeci[1]:= 'una';
if pz < 4 then
zeci[2] := 'doua';
if strtoint(s[pz]) > 0 then
rez := rez + sut[strtoint(s[pz])] + ' ';
if strtoint(Z[pz]) > 0 then
begin
if strtoint(Z[pz]) < 20 then
rez := rez + zeci[strtoint(Z[pz])] + ' '
else
begin
ae := strtoint(Z[pz]) mod 10;
ad := strtoint(Z[pz]) - ae;
rez := rez + zeci[ad] + ' ';
if ae > 0 then
rez := rez + 'si ' + trim(zeci[ae]) + ' ';
end;
end;
if strtoint(m[pz]) > 0 then
begin
if strtoint(m[pz]) = 1 then
rez := rez + trim(o[pz, 2]) + ' '
else
rez := rez + trim(o[pz, 1]) + ' '
end;
zeci[1] := 'un';
zeci[2] := 'doi';
end;
if strtoint(m[1]) + strtoint(m[2]) + strtoint(m[3]) + strtoint(m[4]) = 0 then
rez := rez + 'zero lei '
else
begin
if strtoint(m[4]) = 0 then
rez := rez + 'lei '
end;
SummStr :=copy(rez, 2, length(rez)) + k + ' ' + 'bani';
end;
Посмотрите, нет ли ничего лишнего, надо ли что-то менять?
Layner (2004-09-27 11:25:00) [11]Поищи файл в инете Kuliba1000.chm, там есть 3 варианта перевода числа в строку.
Digitman (2004-09-27 11:24:00) [12]
> Как объявить m(1), Z(1), s(1)....?
никак их не надо объявлять
это - элементы массивов, которые следует объявить ранее как array[1..4] of Integer (зачем в ориг.коде они объявлены как Double, хотя работа с их элементами далее идет как с Integer - ума не приложу, это вероятно просто блажь разработчика, желающего поиметь грабли с инициализацией и сравнением чисел разной точности представления)
Sandman25 (2004-09-27 11:24:00) [13]m - это массив
TUser (2004-09-27 11:23:00) [14]
> Как объявить m(1), Z(1), s(1)....?
var m:array [1..?] of string;
m[1]:=copy();
и т.д.
Rostislav Rotaru (2004-09-27 11:21:00) [15]Вот весь кусок что получился:
function Summstr(SC: extended): string;
const
zeci: array [1..90] of string=
('un','doi','trei','patru','cinci','sase','sapte','opt','noua',
'zece','unsprezece','doisprezece','treisprezece','patrusprezece','cincisprezece','saisprezece','spatesprezece','optsprez ece','nouasprezece',
'douazeci','','','','','','','','','',
'treizeci','','','','','','','','','',
'patruzeci','','','','','','','','','',
'cincizeci','','','','','','','','','',
'sasezeci','','','','','','','','','',
'saptezeci','','','','','','','','','',
'optzeci','','','','','','','','','',
'nouazeci');
sut: array [1..9] of string =
('una suta', 'doua sute','trei sute','patru sute','cinci sute', 'sase sute', 'sapte sute', 'opt sute','noa sute');
o: array [1..4, 1..2] of string =
(('miliarde', 'miliard'), ('milioane','milion'),('mii','mie'),('lei','leu'));
var
sn, a1, A: string;
adec: Extended;
begin
if SC < 0 then
begin
sn := '-';
SC := -1 * SC
end
else
sn := '';
adec := 100000000000000 + (SC * 100);
a1 := FloatToStr(adec);
A := copy(a1, 2, length(a1));
//??????????
end;
Rostislav Rotaru (2004-09-27 11:10:00) [16]Как объявить m(1), Z(1), s(1)....?
TUser (2004-09-27 11:08:00) [17]Там еще бывает Right и Left - может быть в этом коде они тоже встречаются. Это тоже Copy.
Digitman (2004-09-27 11:01:00) [18]
> Rostislav Rotaru © (27.09.04 10:58) [7]
да, так
Rostislav Rotaru (2004-09-27 10:58:00) [19]Кладовка закрыта, а инете не нашел...
Насколько понял, Mid(A, 10, 1) это Copy(A, 10, 1). Так ли это?
TUser (2004-09-27 10:58:00) [20]Значек # ознаает там число двойной точности. В Delphi пиши Extended.
| |
Страницы: 