Разное
Последние книги
Самое популярное
Все бесплатно
Все ссылки на файлы, расположенные на страницах сайта, добавлены пользователями и доступны для бесплатного скачивания. За содержание этих файлов администрация сайта ответственности не несет.
Навигация
Вопросы
Вытащить значение поля в выделенных строках
Категория: Базы данных
Категория: Базы данных
Подсчет времени какого-либо события
Категория: Математика
Категория: Математика
Упаковать TinyDB
Категория: Базы данных
Категория: Базы данных
Программно скрыть MainMenu
Категория: Компоненты
Категория: Компоненты
Сохраняем Bitmap в поле dbase
Категория: Базы данных
Категория: Базы данных
Получить первую и последнюю видимую строку в TRichEdit
Категория: Текст и строки
Категория: Текст и строки
Узнать установлена ли BDE
Категория: Базы данных
Категория: Базы данных
Удалить свой же exe-шник
Категория: Приложение
Категория: Приложение
Объект экрана — Screen
Категория: Компоненты
Категория: Компоненты
BDE. Расположение БД по псевдониму
Категория: Базы данных
Категория: Базы данных
Delphi - База Знаний: Преобразовать Римские символы в Арабские и наоборот
function IntToRoman(num: Cardinal): string; {returns num in capital roman digits}
const
Nvals = 13;
vals: array[1..Nvals] of word = (1, 4, 5, 9, 10, 40, 50, 90, 100, 400, 500,
900, 1000);
roms: array[1..Nvals] of string[2] = ('I', 'IV', 'V', 'IX', 'X', 'XL', 'L',
'XC', 'C', 'CD', 'D', 'CM', 'M');
var
b: 1..Nvals;
begin
result := '';
b := Nvals;
while num > 0 do
begin
while vals[b] > num do
dec(b);
dec(num, vals[b]);
result := result + roms[b]
end;
end;
//или
const
R: array[1..13] of string[2] =
('I', 'IV', 'V', 'IX', 'X', 'XL', 'L', 'XC', 'C', 'CD', 'D', 'CM', 'M');
A: array[1..13] of Integer =
(1, 4, 5, 9, 10, 40, 50, 90, 100, 400, 500, 900, 1000);
..............
function ArabicToRoman(N: Integer): string; //Арабские в римские
var
i: Integer;
begin
Result := '';
i := 13;
while N > 0 do
begin
while A[i] > N do
Dec(i);
Result := Result + R[i];
Dec(N, A[i]);
end;
end;
function RomanToArabic(S: string): Integer; //Римские в арабские
var
i, p: Integer;
begin
Result := 0;
i := 13;
p := 1;
while p <= Length(S) do
begin
while Copy(S, p, Length(R[i])) <> R[i] do
begin
Dec(i);
if i = 0 then
Exit;
end;
Result := Result + A[i];
p := p + Length(R[i]);
end;
end;