Delphi - база знаний


Число украинской строкой


Число украинской строкой




unitUkrRecog;
{копирайт непомню чей. Был для русских циферок, а я переделал под
украинские}

{если кто что найдет пришлите

}

{by Andrew Tkachenko, proektwo@netcity.ru, Ukraine,

}

interface

const

  UkrMonthString: array[1..12] of string[9] = (
    'січня', 'лютого', 'березня', 'квiтня', 'травня',
    'червня', 'липня', 'серпня', 'вересня', 'жовтня',
    'листопада', 'грудня');

function UkrRecognizeAmount(Amount: real;
  CurrName, CurrSubname: string): string;

implementation
uses Sysutils;

function UkrRecognizeAmount(Amount: real;
  CurrName, CurrSubname: string): string;
{* CurrName in [грн.]

CurrSubName in [коп.]
Распознается число <= 999 999 999 999.99*}

const suffBL: string = ' ';

  suffDCT: string = 'дцять';
  suffNA: string = 'надцять ';
  suffDCM: string = 'десят';
  suffMZ: string = 'ь';
  sot: string = 'сот';
  st: string = 'ст';
  aa: string = 'а';
  ee: string = 'и'; {e}
  ii: string = 'і'; {и}
  oo: string = 'о';
  ov: string = 'ів'; {ов}
  C2: string = 'дв';
  C3: string = 'тpи';
  C4: string = 'чотир';
  C5: string = 'п''ят';
  C6: string = 'шіст';
  C7: string = 'сім';
  C8: string = 'вісім';
  C9: string = 'дев''ят';
var

  i: byte;
  sAmount, sdInt, sdDec: string;
  IsMln, IsTha {,IsDcm}, IsRange1019: boolean;
  currNum, endMlx, sResult: string;
begin

  if (amount <= 0) or (amount > 999999999999.99) then
    begin
      Result := '<<<< Ошибка в диапазоне >>>>';
      Exit;
    end;
  STR(Amount: 16: 2, sAmount);
  sdInt := Copy(sAmount, 1, 13);
  sdDec := Copy(sAmount, 15, 2);
  IsMln := false;
//IsDcm:=false;
  IsTha := false;
  IsRange1019 := false;
  sResult := '';

  for i := 1 to 13 do
    begin
      currNum := Copy(sdInt, i, 1);

      if currNum <> suffBL then
        begin
          case i of
            5, 6, 7: if currNum <> '0' then IsMln := true;
            8, 9, 10: if currNum <> '0' then IsTha := true;
          end;

          if i in [2, 5, 8, 11] then {сотни}
            begin
              if currNum = '1' then sResult := sResult + st + oo + suffBL;
              if currNum = '2' then sResult := sResult + C2 + ii + st + ii + suffBL;
              if currNum = '3' then sResult := sResult + C3 + st + aa + suffBL;
              if currNum = '4' then sResult := sResult + C4 + ee + st + aa + suffBL;
              if currNum = '5' then sResult := sResult + C5 + sot + suffBL;
              if currNum = '6' then sResult := sResult + C6 + sot + suffBL;
              if currNum = '7' then sResult := sResult + C7 + sot + suffBL;
              if currNum = '8' then sResult := sResult + C8 + sot + suffBL;
              if currNum = '9' then sResult := sResult + C9 + sot + suffBL;
            end;
          if i in [3, 6, 9, 12] then {десятки}
            begin
              if currNum = '1' then IsRange1019 := true;
              if currNum = '2' then sResult := sResult + C2 + aa + suffDCT + suffBL;
              if currNum = '3' then sResult := sResult + C3 + suffDCT + suffBL;
              if currNum = '4' then sResult := sResult + 'соpок ';
              if currNum = '5' then
                sResult := sResult + C5 + suffMZ + suffDCM + suffBL;

              if currNum = '6' then
                sResult := sResult + C6 + suffMZ + suffDCM + suffBL;

              if currNum = '7' then
                sResult := sResult + C7 + suffMZ + suffDCM + suffBL;

              if currNum = '8' then
                sResult := sResult + C8 + suffMZ + suffDCM + suffBL;

              if currNum = '9' then
                sResult := sResult + 'дев''ян' + oo + st + oo + suffBL;

            end;
          if i in [4, 7, 10, 13] then {единицы}
            begin
              if (currNum = '0') then
                if IsRange1019 then sResult := sResult + suffDCM + suffMZ + suffBL;
              if (currNum = '1') then
                begin
                  if (i = 13) and (not IsRange1019) then
                    sResult := sResult + 'одна '
                  else
                    begin
                      if (i = 10) and (IsRange1019) then
                        sResult := sResult + 'оди'
                      else if (i = 10) and (not IsRange1019) then
                        sResult := sResult + 'одна '
                      else
                        sResult := sResult + 'один' {ин};

                      if IsRange1019 and (i = 13) then
                        sResult := sResult + 'адцять' + suffBL

                      else if IsRange1019 then
                        sResult := sResult + suffNA
                      else
                        sResult := sResult + suffBL;
                    end;
                end;
              if (currNum = '2') then
                begin
                  sResult := sResult + C2;
                  if (i = 10) and (IsRange1019 = False) then
                    sResult := sResult + ii
                  else if (i = 10) or (IsRange1019) then
                    sResult := sResult + aa
                  else
                    sResult := sResult + {aa} ii;
                  if IsRange1019 then
                    sResult := sResult + suffNA
                  else
                    sResult := sResult + suffBL;
                end;
              if (currNum = '3') then
                begin
                  sResult := sResult + C3;
                  if IsRange1019 then
                    sResult := sResult + suffNA
                  else
                    sResult := sResult + suffBL;
                end;
              if (currNum = '4') then
                begin
                  sResult := sResult + C4;
                  if IsRange1019 then
                    sResult := sResult + suffNA
                  else
                    sResult := sResult + ee + suffBL;
                end;
              if (currNum = '5') then
                begin
                  sResult := sResult + C5;
                  if IsRange1019 then
                    sResult := sResult + suffNA
                  else
                    sResult := sResult + suffMZ + suffBL;
                end;
              if (currNum = '6') then
                begin
                  sResult := sResult + C6;
                  if IsRange1019 then
                    sResult := sResult + suffNA
                  else
                    sResult := sResult + suffMZ + suffBL;
                end;
              if (currNum = '7') then
                begin
                  sResult := sResult + C7;
                  if IsRange1019 then
                    sResult := sResult + suffNA
                  else
                    sResult := sResult + suffBL;
                end;
              if (currNum = '8') then
                begin
                  sResult := sResult + C8;
                  if IsRange1019 then
                    sResult := sResult + suffNA
                  else
                    sResult := sResult + suffBL;
                end;
              if (currNum = '9') then
                begin
                  sResult := sResult + C9;
                  if IsRange1019 then
                    sResult := sResult + suffNA
                  else
                    sResult := sResult + suffMZ + suffBL;
                end;
            end;

          endMlx := '';
          case i of
            4:
              begin
                if IsRange1019 then
                  endMlx := ov + suffBL
                else if currNum = '1' then
                  endMlx := suffBL
                else if (currNum = '2') or (currNum = '3') or (currNum = '4') then
                  endMlx := aa + suffBL
                else
                  endMlx := ov + suffBL;
                sResult := sResult + 'мiльярд' + endMlx;
              end;
            7: if IsMln then
                begin
                  if IsRange1019 then
                    endMlx := ov + suffBL
                  else if currNum = '1' then
                    endMlx := suffBL
                  else if (currNum = '2') or (currNum = '3') or (currNum = '4') then
                    endMlx := aa + suffBL
                  else
                    endMlx := ov + suffBL;
                  sResult := sResult + 'мiльйон' + endMlx;
                end;
            10: if IsTha then
                begin
                  if IsRange1019 then
                    endMlx := suffBL
                  else if currNum = '1' then
                    endMlx := aa + suffBL
                  else if (currNum = '2') or (currNum = '3') or (currNum = '4') then
                    endMlx := ii + suffBL
                  else
                    endMlx := suffBL;
                  sResult := sResult + 'тисяч' + endMlx;
                end;
          end{case}
          if i in [4, 7, 10, 13] then IsRange1019 := false;
        end{IF}
    end{FOR}

  sResult := sResult + CurrName + ',' + suffBL + sdDec + suffBL + CurrSubname;
  sResult := AnsiUpperCase(sResult[1]) + Copy(sResult, 2, length(sResult) - 1);
  Result := sResult;
end;

end.

С уважением,

Andrew Tkachenko

ООО "Проект ВО"
Украина, г.Харьков

Взято из

Советов по Delphi от


Сборник Kuliba





Начало  Назад  Вперед