Tema: Re: suma zodziasi PascalScript kalba
Autorius: Leon
Data: 2009-11-12 15:45:00
gaudyki!

function Perveda(intsk: Integer): String;
const
  mvien : Array[1..9] of String = 
('vienas','du','trys','keturi','penki','?e?i',
    'septyni','a?tuoni','devyni');
  mdesim : Array[1..9] of String = 
('de?imt','dvide?imt','trisde?imt','keturiasde?imt',
  'penkiasde?imt','?e?iasde?imt','septyniasde?imt','a?tuoniasde?imt','devyniasde?imt');
  mniol : Array[1..9] of String = 
('vienuolika','dvylika','trylika','keturiolika',
    'penkiolika','?e?iolika','septyniolika','a?tuoniolika','devyniolika');
var
  n1,n2,n3,n4,n5,n6 : Integer;
  formav : Integer;
  strss,strvv : String;
begin
  Result := '';
  strss := '';
  formav := intsk;
  n6 := Trunc(formav/100000);
  formav := formav - n6*100000;
  n5 := Trunc(formav/10000);
  formav := formav - n5*10000;
  n4 := Trunc(formav/1000);
  formav := formav - n4*1000;
  n3 := Trunc(formav/100);
  formav := formav - n3*100;
  n2 := Trunc(formav/10);
  formav := formav - n2*10;
  n1 := Trunc(formav);
//************************************
  if (n6 > 0) then
  begin
    if (n6 > 1) then
      strss := mvien[n6]+' '+'?imtai'
    else
      strss := 'vienas ?imtas';
  end;
  if ((n6 > 0) and (n5 = 0) and (n4 = 0)) then
  begin
    strss := strss+' '+'t?kstan?iø';
  end;
//************************************
  if ((n5 = 1) and (n4 > 0)) then
  begin
    if (n5 = 1) then
      strss := strss+' '+mniol[n4]+' '+'t?kstan?iø';
  end
  else
    if (n5 >= 0) then
    begin
      if (n5 >= 2) then
       strss := strss+' '+ mdesim[n5];
      if (n4 = 1) then
        strss := strss+' '+mvien[n4]+' '+'t?kstantis';
      if ((n5 > 0) and (n4 = 0)) then
        strss := strss + mdesim[n5]+ ' '+ 't?kstan?iø';
//        strss := strss+' '+'t?kstan?iø';
      if (n4 > 1) then
        strss := strss+' '+mvien[n4]+' '+'t?kstan?iai';
    end;
//************************************
  if (n3 > 0) then
  begin
    if (n3 > 1) then
      strss := strss+' '+mvien[n3]+' '+'?imtai'
    else
      strss := strss+' '+'vienas ?imtas';
  end;
//************************************
  if ((n2 = 1) and (n1 > 0)) then
  begin
    if (n2 = 1) then
      strss := strss+' '+mniol[n1];
  end
  else
    if (n2 >= 0) then
    begin
      if (n2 >= 2) then
       strss := strss+' '+ mdesim[n2];
      if (n1 = 1) then
        strss := strss+' '+mvien[n1];
      if ((n2 = 1) and (n1 = 0)) then
        strss := strss+' '+mdesim[n2];
      if (n1 > 1) then
        strss := strss+' '+mvien[n1];
    end;
//************************************
  if (Trim(strss) = '') then
    strss := 'nulis'
  else
    strss := Trim(strss);
  strvv := Copy(AnsiUpperCase(strss),1,1);
  strss[1] := strvv[1];
  Result := strss;
end;