Помогите перевести на Delphi

← →
Rostislav Rotaru © (2004-09-27 10:02) [0]

Здравствуйте. В 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

Помогите пожалуйста
Спасибо

← →
Digitman © (2004-09-27 10:44) [1]

> не получается

что не получается-то ?

← →
TUser © (2004-09-27 10:45) [2]

В кладовке есть и на Delphi. Или еще где-то. Но точно есть. А так - синтаксис у Васика, почти такой же как на Delphi. Dim - это там так массивы определяют. Скажи конкретно, какая конструкция тебе не понятна, а то переводить столько текста все захотят.

← →
Gero © (2004-09-27 10:46) [3]

> Скажи конкретно, какая конструкция тебе не понятна

Наверное, не понятна функция SummStr.

← →
Rostislav Rotaru © (2004-09-27 10:48) [4]

определил "zeci" как const zeci: array [1..90] of string=
("un", "doi", "trei"......). То же самое с "sut" и "о"
Остановился на этом куске:
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)
Как их объявить?

← →
Digitman © (2004-09-27 10:55) [5]

adec: Extended;
a1: String;

a1 := FloatToStr(adec);

← →
TUser © (2004-09-27 10:58) [6]

Значек # ознаает там число двойной точности. В Delphi пиши Extended.

← →
Rostislav Rotaru © (2004-09-27 10:58) [7]

Кладовка закрыта, а инете не нашел...
Насколько понял, Mid(A, 10, 1) это Copy(A, 10, 1). Так ли это?

← →
Digitman © (2004-09-27 11:01) [8]

> Rostislav Rotaru © (27.09.04 10:58) [7]

да, так

← →
TUser © (2004-09-27 11:08) [9]

Там еще бывает Right и Left - может быть в этом коде они тоже встречаются. Это тоже Copy.

← →
Rostislav Rotaru © (2004-09-27 11:10) [10]

Как объявить m(1), Z(1), s(1)....?

← →
Rostislav Rotaru © (2004-09-27 11:21) [11]

Вот весь кусок что получился:
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;

← →
TUser © (2004-09-27 11:23) [12]

> Как объявить m(1), Z(1), s(1)....?

var m:array [1..?] of string;

m[1]:=copy();
и т.д.

← →
Digitman © (2004-09-27 11:24) [13]

> Как объявить m(1), Z(1), s(1)....?

никак их не надо объявлять
это - элементы массивов, которые следует объявить ранее как array[1..4] of Integer (зачем в ориг.коде они объявлены как Double, хотя работа с их элементами далее идет как с Integer - ума не приложу, это вероятно просто блажь разработчика, желающего поиметь грабли с инициализацией и сравнением чисел разной точности представления)

← →
Sandman25 © (2004-09-27 11:24) [14]

m - это массив

← →
Layner © (2004-09-27 11:25) [15]

Поищи файл в инете Kuliba1000.chm, там есть 3 варианта перевода числа в строку.

← →
Rostislav Rotaru © (2004-09-27 12:55) [16]

Перевел, вроде работает. Выставляю на всеобщее обозрение:

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;

Посмотрите, нет ли ничего лишнего, надо ли что-то менять?

← →
TUser © (2004-09-27 13:01) [17]

> надо ли что-то менять?

Ты же перевел все точно с Бейсика. Все должно работать. А насчет менять - здесь не все знакомы с русмынским языком.

Я б, пожалуй, завел бы константный массив с названиями (и разрешил бы переприсвоение констант через {$J+}). Судя по беглому взгляду на код, в ходе выполнения меняются только 1-е 2 элемента этого массива, зачем же дополнительные тормоза?

← →
msguns (2004-09-27 13:22) [19]

Типа этого делай:

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;

← →
alless (2004-09-27 13:29) [20]

U menea esti gotovii komponent napisanii uje. Ia iz Moldovi, esli cto. Scaji kak vstretitsea, otdam komponent

← →
alless (2004-09-27 13:34) [21]

ia otpravil tebe na e-mail komponent. On predstovelaet odin edit, a daniie on pishet v label.

> alless (27.09.04 13:34) [21]

Спасибо, посмотрю

← →
msguns (2004-09-27 15:42) [23]

Извмняюсь, если не прав, но..

Зачем же ради одной-разъединственной (и далеко не концептуальной, на минуточку !), траблы внедрять целый компонент, да еще неизвестено от кого и как полученный. А если дальше надо будет по-румынски написать дату ? Или на иврите ? И каждый раз будем искать компоненты ? А мы-то сами чтО могем ? Тем более что для решения данной проблемы особого знания не требуется,- просто немного терпения..

Если что, извиняюсь - никого не хотелось обидеть

Спасибо всем кто откликнулся, вроде функция работает, пока остановлюсь на этой. Тема закрыта.

← →
alless (2004-09-27 19:28) [25]

2 msguns (27.09.04 15:42) [23]
вот и для таких целей и сделан. Для людей и для удобвство

Помогите перевести на Delphi Найти похожие ветки