Advertisement
Guest User

Untitled

a guest
Oct 16th, 2018
74
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Pascal 1.45 KB | None | 0 0
  1. program LilPip;
  2.  
  3. {$APPTYPE CONSOLE}
  4.  
  5. uses
  6.   SysUtils,
  7.   Math;
  8.  
  9. var
  10.     Thousands, Hundreds, Decades, Units, a, i: Integer;
  11.  
  12. const
  13.     TEN = 10;
  14.     HUNDRED = 100;
  15.     THOUSAND = 1000;
  16.  
  17. procedure Zero(var a,b,c,d: Integer);
  18. begin
  19.     a := 0;
  20.     b := 0;
  21.     c := 0;
  22.     d := 0;
  23. end;
  24.  
  25. // Below procedure monitors rank overflows.
  26. procedure RankStep(var PrevRank,ProcessingRank,Counter: Integer;
  27.         const CheckRank: integer);
  28. begin
  29.     if Counter mod CheckRank = 0 then
  30.         begin
  31.             ProcessingRank := ProcessingRank + 1;
  32.             PrevRank := PrevRank - 10;
  33.         end;
  34. end;
  35.  
  36. begin
  37.     Zero(Thousands, Hundreds, Decades, Units);
  38.     a := 1;
  39.     write ('Hello, this program will find number of all car numbers,');
  40.     writeln (' that have 3 same digits');
  41.     for i := 1 to 9999 do
  42.     begin
  43.         Units := Units + 1;
  44.         RankStep(Units, Decades, i, TEN);
  45.         RankStep(Decades, Hundreds, i, HUNDRED);
  46.         RankStep(Hundreds, Thousands, i, THOUSAND);
  47.         if ((Thousands = Hundreds) and (Hundreds = Decades))
  48.             or ((Hundreds = Decades) and (Hundreds = Units))
  49.             or ((Thousands = Decades) and (Thousands = Units))
  50.             or ((Thousands = Hundreds) and (Thousands = Units)) then
  51.         begin
  52.             writeln (Thousands, Hundreds, Decades, Units);
  53.             inc (a);
  54.         end;
  55.     end;
  56.     write ('Number of car numbers: ');
  57.     writeln (a + 1);
  58.     readln;
  59. end.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement