Új hozzászólás Aktív témák

• #1272 Tangerine senior tag

  Új Válasz 2006-05-22 14:48:41 #1272

  Új hozzászólás

  Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra

  Privát üzenet küldése

  

  Tangerine

  senior tag

  {$N+} {8086-os numerikus tarsprocesszor bekapcsolasa}
  program hazifeladat;
  
  uses crt;
  
  const
  enter: char = #13;
  esc : char = #27;
  
  var
  c: char;
  k: array[1..60] of char;
  aa, bb, error: integer;
  kod10, szorzo:string;
  
  function fval(ss:string):integer;
  var
  er, hiba:integer;
  begin
  val(ss,er,hiba);
  fval := er;
  end;
  
  function fstr(ii: integer):string;
  var
  er:string;
  begin
  str(ii,er);
  fstr := er;
  end;
  
  function max(x, y: string):integer;
  begin
  if length(x) > length(y) then
  max := length(x)
  else
  max := length(y);
  end;
  
  
  function osszead(x,y:string):string;
  var
  sossz:string;
  ossz,resz,mar,ii,hh:integer;
  begin
  sossz:='';
  ossz := 0;
  resz := 0;
  mar := 0;
  hh := max(x,y) + 1;
  while length(x) < hh do x:= '0' + x;
  while length(y) < hh do y:= '0' + y;
  for ii := hh downto 1 do
  begin
  ossz := fval(x[ii]) + fval(y[ii]) + mar;
  mar := ossz div 10 ;
  sossz:= fstr(ossz mod 10) + sossz;
  end;
  while (sossz[1] = '0') and (sossz <> '0') do delete(sossz,1,1);
  osszead := sossz;
  end;
  
  function szoroz(x,y:string):string;
  var
  cc,er:string;
  begin
  er := '0';
  cc := '0';
  if (x='0') or (y='0') then
  szoroz := '0'
  else
  repeat
  cc := osszead(cc,'1');
  er := osszead(er,x);
  until cc = y;
  
  szoroz := er;
  end;
  
  
  begin
  
  clrscr;
  writeln('Kerem a 6-os szamrendszerbeli szamot, max 60 karakter!');
  aa := 0;
  szorzo :='1';
  
  repeat
  
  repeat
  c:=readkey;
  until c in ['0'..'5',enter];
  
  if c <> enter then
  begin
  write(c);
  inc(aa);
  k[aa] := c ;
  end;
  
  until (c = enter) or (aa = 60);
  
  
  kod10 := '0';
  
  for bb := aa downto 1 do
  begin
  kod10 := osszead(kod10 ,szoroz(szorzo,k[bb]));
  szorzo := szoroz(szorzo,'6');
  end;
  
  writeln;
  writeln(kod10);
  writeln;
  
  writeln('Kilepes: ESC');
  
  repeat
  c := readkey;
  until c = esc;
  
  end.

Új hozzászólás Aktív témák