Определить, равен ли квадрат заданного трехзначного числа кубу суммы цифр этого числа

program Project2;
 
{$APPTYPE CONSOLE}
 
uses
  SysUtils;
 
var
  a,b,c,d,t,x:longint;
 
begin
while 1=1
do begin
write('Enter number:  ');readln(x);
If (x<100) or (x>999)then writeln('Ti noob, nado trehznak pisat'' suda')
else
begin
a:=sqr(x);
b:=x div 10;
c:=b div 10;
d:=b div 10;
t:=(b+c+d)*(b+c+d)*(b+c+d);
writeln('kvadrat 4isla=  ', a, '  Kub summi zifr=  ', t);
if a=t then writeln('kvadrat chisla  ', x, '  ne raven kubu summi ego chisel')
else writeln('kvadrat chisla  ', x, '  ne raven kubu summi ego chisel');
writeln;
end;
end;
end.

program StupidProga;   {Комменты начались}
 
{$APPTYPE CONSOLE}
 
uses
  SysUtils;
 
var
   slovo:array[0..29] of string;    {массив для заполнения его словами}
   stroka:string;                       {строка, которую мы считаем, в которых они будут}
   NewString:string;                  {строка, в которую пойдут искомые слова}
   i,k,m,lol:integer;                 {всякие левые переменные, например для заполнения массивов, короч потом расскажу} 
 
function IsOk(a:string):boolean;    {Функция..хмм...не надеюсь даже, что ты знаешь, вообщем удобная штука, может слышала мельком на Алгебре}
      var i:integer;                          {так вот это нечто похожее, сверху, мы видим, что функция ИзОк зависит от строки а}
      begin                                      {и принимает значения либа истина либо ложь}
           IsOk:=true;
              For i:=0 to length(a)-1 do        {Сначала в функции стоит выключатель на истину, но если вдруг мы находим такую букву, которая по }
                   begin                                 {выше буквы, которая стоит перед ней, то сразу выключатель ставим на ложь}
                     If a[i]>a[i+1] then IsOk:=false;
                   end;
      end;
 
begin                                           {начало}
  while 1=1 do begin                          {этот цикл дает возможность повторно вводить слова}
 
     writeln('Enter words(not more than 30):  ');             {комп просит ввмести не более 30 слов}
         readln(stroka);                                              {считываем набор слов}
 
     For i:=1 to length(stroka) do                    {Теперь чтобы было удобнее убираем что после точки стоит, и ставим вместо точки пробел}
        begin
          if stroka[i]='.' then                         {Если буква равна точке то}
             begin                                      
                 insert(' ',stroka,i); delete(stroka,i+1,length(stroka)-i+1);      {вставляем в строку перед точкой пробел, а потом удаляем все что после точки}
             end;                                                                                   {ко всем чертям}
        end;
 
     For i:=0 to length(stroka) do            {Заценим количество пробелов теперь, потом понадобится}
          begin
              if (stroka[i]=' ') then m:=m+1;       {заценили, если пробел, то счетчик увеличиваем на единицу}
          end;
 
     For k:=0 to m-1 do        
         begin
             For i:=1 to length(stroka) do     {теперь еще хуже}
                 If (stroka[i]<>' ')  then       {если символ - не пробел, то}
                      begin
                          insert(stroka[i], slovo[k], i);      {записываем этот символ в итый элемент массива со словам}
                               lol:=i;                               {а потом по циклу еще к нему добавляем символов, ЛОЛ - это  счетчик, потом понадобится}
                      end
                 else
                     begin                                 {А когда символ станет пробелом, то тогда удалим из строки начиная с первого элемента lol-1элементов}
                        delete(stroka, 1, lol+1);     {Т.К. по моему i не сохранится, хотя хз, то записываем i в lol}
                        break;                            {и принимаемся за следущее число, выходя из цикла}
                     end;
         end;
 
      For k:=0 to m do             {А теперь тупо берем из массива чисел}
          begin                              {каждое число, и если оно удоветворяет заданному(что типа) по алфавиту, то добавляем его в строку, которую}
               If IsOk(slovo[k])=true then NewString:=NewString+Slovo[k]+' ';
          end;
 
 
     writeln(NewString); readln; {выводим на экран и ждем чтоб нажали ентер}
end;                                   {после этого цикл повторяется, начиная с того момента, как мы вводим слова}
end.                        {Programm Terminated}

while 1=1 do begin
...
end;

j:=1;
while j<31 do begin
...
inc(j)
end;

program LoLWords;
 
{$APPTYPE CONSOLE}
 
uses
  SysUtils;
 
 
var
   slovo:array[0..29] of string;
   stroka:string;
   NewString:string;
   i,k,m,lol,n:integer;
   call:boolean;
   exit:char;
 
 
function IsOk(a:string):boolean;
      var i:integer;
      begin
           IsOk:=true;
              For i:=0 to length(a)-1 do
                   begin
                     If a[i]>a[i+1] then IsOk:=false;
                   end;
      end;
{end of IsOk}
function IsFraza(a:string):boolean;
       var i:integer;
       begin
           IsFraza:=True;
              For i:=0 to length(a)-1 do
                 begin
                  If  ((ord(a[i])>0) and (ord(a[i])<32)) or
                   ((ord(a[i])>32) and (ord(a[i])<65)) or
                   ((ord(a[i])>90) and (ord(a[i])<97)) or
                   ((ord(a[i])>122) and (ord(a[i])<255))
                   then
                   IsFraza:=false;
              end;
       end;
{End of IsFraza}
 
{Nachalo}
begin
     call:=true;
      while call=true do
          begin
            writeln;
               writeln('Enter words(not more than 30):  ');
               readln(stroka);
{s4itali stroku}          
              For i:=1 to length(stroka) do
                 begin
                     if stroka[i]='.' then
                         begin
                             insert(' ',stroka,i); delete(stroka,i+1,length(stroka)-i+1);
                         end;
                 end;
{udalili vse posle '.' zamenili ee na probel}
 
                  if  isfraza(stroka)=true then
                    begin
                       For i:=0 to length(stroka) do
                           begin
                               if (stroka[i]=' ') and (stroka[i]<>stroka[i+1]) then m:=m+1;
                           end;
 
                         If m>30 then
                             begin
                               writeln('Blin, Nu Ti Noob! tebe skazali! ne bol''she 30 slov');break;
                             end
                                else
                                    begin
                                         For k:=0 to 29 do
                                             begin
                                                 For i:=1 to length(stroka) do
                                                     If (stroka[i]<>' ')  then
                                                         begin
                                                         insert(stroka[i], slovo[k], i);
                                                         lol:=i;
                                                          end
                                                     else
                                                          begin
                                                          delete(stroka, 1, lol+1);
                                                          lol:=0;
                                                          break;
                                                          end;
                                             end;
 
                                         For k:=0 to 29 do
                                         begin
                                             If IsOk(slovo[k])=true then NewString:=NewString+Slovo[k]+' ';
                                         end;
                                     Writeln;
                                     writeln('Slova, s bukvami, stoyashimi v alfavitnom poryadke.');write('    ');
 
                                     writeln(NewString);
                                     writeln('(esli na stro4ke vishe pusto, to takih slov net)');
                                 end;
              end
 
                     
                  else  begin writeln;writeln('   Nu Ti Noob, blin, Razve v slovah bivaet 4to-to krome bukv!');
                end;
                Writeln('Dlya vihoda nazmite y/n    ');readln(exit);
                If Exit='y' then call:=false;
                end;
end.

 Nu Ti Noob, blin, Razve v slovah bivaet 4to-to krome bukv!

program LOLwords;
 
{$APPTYPE CONSOLE}
 
uses
  SysUtils;
 
 
var
   slovo:array[0..29] of string;
   stroka:string;
   NewString:string;
   i,k,lol,m:shortint;
   call:boolean;
   exit:char;
 
 
function IsOk(a:string):boolean;
      var i:integer;
      begin
           IsOk:=true;
              For i:=0 to length(a)-1 do
                   begin
                     If a[i]>a[i+1] then IsOk:=false;
                   end;
      end;
{end of IsOk}
 
{Nachalo}
begin
     call:=true;
      while call=true do
          begin
            writeln;
               writeln('Enter words(not more than 30):  ');
               readln(stroka);
{s4itali stroku}
              For i:=1 to length(stroka) do
                 begin
                     if stroka[i]='.' then
                         begin
                             insert(' ',stroka,i); delete(stroka,i+1,length(stroka)-i+1);
                         end;
                 end;
{udalili vse posle '.' zamenili ee na probel}
 
 
                       For i:=0 to length(stroka) do
                           begin
                               if (stroka[i]=' ') and (stroka[i]<>stroka[i+1]) then m:=m+1;
                           end;
 
 
 
 
          For k:=0 to m-1 do
               begin
                 For i:=1 to length(stroka) do
                    If (stroka[i]<>' ')  then
                       begin
                           insert(stroka[i], slovo[k], i);
                           lol:=i;
                       end
                    else
                       begin
                         delete(stroka, 1, lol+1);
                         lol:=0;
                         break;
                       end;
                 end;
 
    writeln('Slova, s bukvami, stoyashimi v alfavitnom poryadke.');
           For k:=0 to 29 do
 
                If IsOk(slovo[k])=true then  write(Slovo[k],' ');
 
 
          writeln; writeln;
   Writeln('Dlya vihoda nazmite y/n    ');readln(exit);
    If Exit='y' then call:=false;
    end;
end.