Böse 7 (Quersumme, Teilbarkeit)

[Philipp Ungan]

Hallo Leute,

ich bin noch in den TurboPascal Anfängen.
Möchte aber folgendes Problem lösen:
Ich gebe eine Zahl ein und möchte untersuchen ob die Quersumme 7 ist oder
die Quersumme durch 7 teilbar ist oder die eingegebene Zahl durch 7 teilbar
ist. Für jeden dieser 3 Untersuchungen würde ich gerne eine einzelne
Prozedur opfern. Für die Aufgabe, ob eine 7 in der eingegebenen Zahl
vorhanden ist, habe ich schon eine Lösung gefunden:

PROGRAM sieben;
USES crt;
VAR z :integer;

PROCEDURE untersuch_auf_ziffer_7 (z :integer);
VAR b :boolean;
BEGIN
clrscr;
b:=false;
REPEAT
IF z MOD 10 = 7
THEN BEGIN write('Die Ziffer 7 ist in der Zahl enthalten'); b:=true
END;
z:= z DIV 10
UNTIL (z=0) OR b
END;

BEGIN
z:=177;
untersuch_auf_ziffer_7(z);

END.

Ich wäre sehr dankbar wenn ihr mir helfen könnt!

MfG

Philipp

[@mS]

{
Hi, hier ist ein kleines Listing, das deiner Aufgabe entspricht.
Ich habe noch die Procedure hinzugefuegt, dass ueberprueft wird, ob die
Zahl die Ziffer 7 enthaelt (enthalten;). Laueft bei mir mit Turbo Pascal 6.

CU!
@mS (ad...@gmx.net)
}

{$N+}
program sieben;
var zahl : extended;
procedure teilbar;
BEGIN
if (zahl/7=trunc(zahl/7)) then writeln('Durch sieben teilbar.')
else writeln('Nicht durch sieben teilbar.');
END;

procedure quersumme;
var loop : byte;
srg : string;
num : array [1..255] of byte;
dummy, qs : integer;
BEGIN
str(trunc(zahl), srg);
for loop := 1 to length(srg) do val(srg[loop], num[loop], dummy);
qs := 0;
for loop := 1 to length(srg) do qs := qs + num[loop];
if (qs/7=trunc(qs/7)) then writeln('Quersumme durch sieben teilbar.')
else writeln('Quersumme nicht durch sieben teilbar.');
END;

procedure quersummeIst7;
var loop : byte;
srg : string;
num : array [1..255] of byte;
dummy, qs : integer;
BEGIN
str(trunc(zahl), srg);
for loop := 1 to length(srg) do val(srg[loop], num[loop], dummy);
qs := 0;
for loop := 1 to length(srg) do qs := qs + num[loop];
if (qs=7) then writeln('Quersumme hat den Wert sieben.') else
writeln('Quersumme hat nicht den Wert sieben.');
END;

procedure enthalten;
var loop : byte;
srg : string;
dummy : integer;
checker : boolean;
num : array [1..255] of byte;
BEGIN
checker := False;
str(trunc(zahl), srg);
for loop := 1 to length(srg) do val(srg[loop], num[loop], dummy);
for loop := 1 to length(srg) do if (num[loop] = 7) then checker := True;
if checker then writeln('In der Zahl ist sieben enthalten.') else
writeln('In der Zahl ist sieben nicht enthalten.');
END;

BEGIN
writeln;
Write('Enter value :',#32);
Readln(zahl);
teilbar;
quersumme;
quersummeIst7;
enthalten;
END.