Недавно добавленные исходники

•  3D Designer  129

•  Sik Screen Capture  103

•  Patch Maker  91

•  Айболит (remote control)  110

•  ListBox Drag & Drop  85

•  Доска для игры Реверси  1 528

•  Графические эффекты  100

•  Рисование по маске  75

•  Перетаскивание изображений  79

•  Canvas Drawing  82

•  Рисование Луны  151

•  Поворот изображения  64

•  Рисование стержней  55

•  Paint on Shape  50

•  Генератор кроссвордов  60

•  Головоломка Paletto  75

•  Теорема Монжа об окружностях  113

•  Пазл Numbrix  56

•  Заборы и коммивояжеры  87

•  Игра HIP  65

•  Игра Go (Го)  51

•  Симулятор лифта  55

•  Программа укладки плитки  56

•  Генератор лабиринта  97

•  Проверка числового ввода  45

•  HEX View  101

•  Физический маятник  102

•  Задача коммивояжера  129

•  Автомобильная пробка  52

•  Квадратные сетки из слов  46

 
скрыть


Delphi FAQ - Часто задаваемые вопросы

| Базы данных | Графика и Игры | Интернет и Сети | Компоненты и Классы | Мультимедиа |
| ОС и Железо | Программа и Интерфейс | Рабочий стол | Синтаксис | Технологии | Файловая система |



Сумма прописью - Способ 3




unit sumstr;

interface

uses
  SysUtils, StrUtils;

function SumToString(Value: string): string;

implementation
const

a: array[0..8,0..9] of string=(
('','один ','два ','три ','четыре ','пять ','шесть ','семь ','восемь ','девять '),
('','','двадцать ','тридцать ','сорок ','пятьдесят ','шестьдесят ','семьдесят ','восемьдесят ','девяносто '),
('','сто ','двести ','триста ','четыреста ','пятьсот ','шестьсот ','семьсот ','восемьсот ','девятьсот '),
('тысяч ','тысяча ','две тысячи ','три тысячи ','четыре тысячи ','пять тысячь ','шесть тысячь ','семь тысячь ',
'восемь тысячь ','девять тысячь '),
('','','двадцать ','тридцать ','сорок ','пятьдесят ','шестьдесят ','семьдесят ','восемьдесят ','девяносто '),
('','сто ','двести ','триста ','четыреста ','пятьсот ','шестьсот ','семьсот ','восемьсот ','девятьсот '),
('миллионов ','один миллион ','два миллиона ','три миллиона ','четыре миллиона ','пять миллионов ',
'шесть миллионов ','семь миллионов ','восемь миллионов ','девять миллионов '),
('','','двадцать ','тридцать ','сорок ','пятьдесят ','шестьдесят ','семьдесят ','восемьдесят ','девяносто '),
('','сто ','двести ','триста ','четыреста ','пятьсот ','шестьсот ','семьсот ','восемьсот ','девятьсот '));

b: array[0..9] of string=
('десять ','одинадцать ','двенадцать ','тринадцать ','четырнадцать ','пятьнадцать ','шестьнадцать ',
'семьнадцать ','восемьнадцать ','девятьнадцать ');

function SumToStrin(Value: string): string;
var
  s, t: string;
  p, pp, i, k: integer;
begin
  s:=value;
  if s='0' then
    t:='Ноль '
  else
  begin
    p:=length(s);
    pp:=p;
    if p>1 then
      if (s[p-1]='1') and (s[p]>'0') then
      begin
        t:=b[strtoint(s[p])];
        pp:=pp-2;
      end;
    i:=pp;
    while i>0 do
    begin
      if (i=p-3) and (p>4) then
        if s[p-4]='1' then
        begin
          t:=b[strtoint(s[p-3])]+'тысяч '+t;
          i:=i-2;
        end;
      if (i=p-6) and (p>7) then
        if s[p-7]='1' then
        begin
          t:=b[strtoint(s[p-6])]+'миллионов '+t;
          i:=i-2;
        end;
      if i>0 then
      begin
        k:=strtoint(s[i]);
        t:=a[p-i,k]+t;
        i:=i-1;
      end;
    end;
  end;
  result:=t;
end;

procedure get2str(value: string; var hi, lo: string);
var
  p: integer;
begin
  p:=pos(',', value);
  lo:='';
  hi:='';
  if p=0 then
    p:=pos('.', value);
  if p<>0 then
    delete(value,p,1);
  if p=0 then
  begin
    hi:=value;
    lo:='00';
  end;
  if p>length(value) then
  begin
    hi:=value;
    lo:='00';
  end;
  if p=1 then
  begin
    hi:='0';
    lo:=value;
  end;
  if (p>1) and (p then
  begin
    hi:=copy(value,1,p-1);
    lo:=copy(value,p,length(value));
  end;
end;

function sumtostring(value: string): string;
var
  hi, lo: string;
  pr, er: integer;
begin
  get2str(value,hi,lo);
  if (hi='') or (lo='') then
  begin
    result:='';
    exit;
  end;
  val(hi,pr,er);
  if er<>0 then
  begin
    result:='';
    exit;
  end;
  hi:=sumtostrin(inttostr(pr))+'руб. ';
  if lo<>'00' then
  begin
    val(lo,pr,er);
    if er<>0 then
    begin
      result:='';
      exit;
    end;
    lo:=inttostr(pr);
  end;
  lo:=lo+' коп. ';
  hi[1]:=AnsiUpperCase(hi[1])[1];
  result:=hi+lo;
end;

end.





Похожие по теме исходники

Сумма прописью




Copyright © 2004-2021 "Delphi Sources" by BrokenByte Software. Delphi World FAQ

Группа ВКонтакте   Facebook   Ссылка на Twitter