Advertisement
Guest User

Untitled

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