Трябва ми програма, с която да се намери сумата на няколко числа кратни на 3. Пресмятането спира при въвеждане на първото число, което не е кратно на 3 и не участва в сумирането.

Благодаря предварително

program Suma;
var N, S : integer;
begin
S:= 0;
repeat
write('Input digit:');
readln(N);
If (N mod 3) = 0 then S := S + N;
until n mod 3 > 0;
writeln('Suma=',S);
end.

Program Kursova;
Type
klas=record
ime,familia:string[30];
izvineni,neizv:real;
end;
T=file of klas;
Var F:T;
S:klas;
k:integer;
Procedure readrec(S:klas);
begin
write('ime=');read(S.ime);
write('familia=');read(S.familia);
write('izvineni=');read(S.izvineni);
write('neizv=');read(S.neizv);
end;
procedure createfile(Var F:T);
begin
rewrite(F);readrec(S);
while not eof(f) do
begin
readln;
write(F,S);
readrec(S);
end;
Close(F);
end;
Procedure writerec(S:klas);
begin
write(S.ime,' ',S.Familia,' ',S.izvineni,' ',S.neizv);
end;
Procedure stipendia(F:T);
begin
Reset(F);
While not eof(F) do
begin
Read(F,S);
If S.neizv>10 then
writerec(S);
end;
close(F);
end;
Procedure izklucheni(F:T);
begin
Reset(F);
While not eof(F) do
begin
Read(F,S);
If S.neizv>15 then
writerec(S);
end;
close(F);
end;
Procedure individualenplan(F:T);
begin
Reset(F);
While not eof(F) do
begin
read(F,S);
If S.izvineni>150.00 then
writerec(S);
end;
close(F);
end;
Procedure writefile (F:T);
begin
Reset(F);
while not eof(F) do
begin
read(F,S);
writerec(S);
end;
close(F);
end;
begin
assign(F,'a.data');
repeat;
writeln('1:stipendiq');
writeln('2:izklucheni');
writeln('3: individualen plan');
writeln('4:izhod');
read(k);
else k of
1:stipendia(F);
2:izklucheni(F);
3:writefile(F);
4:exit;
end;
until (k=4);
end.

Ето я задачата,само че ми дава грешки като се опитам да я пусна.Някой може ли да я провери и да каже къде са ми грешките и евентуално как да ги поправя.Благодаря предварително

Редактирано 23 юни 200916 г. от hellfire15 (преглед на промените)

Спешно ми трябва решение на тази задача: ДСПК обслужва фирма за покупко-продажба на имоти: 1. създава файл, съдържащ следната информация за: вид на имота, квадратура, цена на квадратен метър, телефон на собственика; 2. прави справка за всички имоти от даден тип и под определена цена; 3. извежда телефона на собственика на имот от даден тип с най- висока цена; 4. сортира имотите по даден тип по поле цена; 5. да се извежда цялата информация от файла; 6. да съдържа меню за избор. Задачата е за утре. Благодаря предварително

Имам въпрос относно възможността за създаването на следната програма: Може ли да се създаде програма която преработва цифрите в букви(например А=1, Б=2, В=3 и като напиша 123 да ми излезе АБВ) и след това може ли да я направя .еxe и да бъде използвана?

Имам въпрос относно възможността за създаването на следната програма:

Може ли да се създаде програма която преработва цифрите в букви(например А=1, Б=2, В=3 и като напиша 123 да ми излезе АБВ) и след това може ли да я направя .еxe и да бъде използвана?

Да, като я компилираш ще получиш работещ изпълним файл.

Да, като я компилираш ще получиш работещ изпълним файл.

не въпроса ми е как точно да стане и след като се напишат числата без да се отделят може ли паскал да ги познае

Давам ти пример:

А=0311

Б=0312

В=0313

Ако напиша 031103120313 ще разпознае ли че страва въпрос за АБВ.Има ли опция която да му посочва да гледа през 4ри числа?

Превръщаш числото в стринг и го обработваш на части.

Превръщаш числото в стринг и го обработваш на части.

Извинявай но това не ми говори нищо. БИ ли ми дал кратък пример за да схвана какво точно имаш впредвид?

здравейте имам нужда от помощ ако някой има желание да ми помогне-как трябва да изглежда кода на ето тази задача примерно?преди да кажете че ме мързи започнал съм да го уча имам 2 книжки, но чета и все още не мога да разбера почти нищо, а скоро съм на изпит.тази задача е прекалено сложна за мен.

informatika_2009.pdf

Привет, малко е късничко да се готвиш тепърва за изпита ( ако е този за който си мисля - Понеделник). Всички КС задачи в ПУ са доста подобни или поне 1-ва точка от тях е винаги една и съща, а именно създаване и въвеждане на записи. Т.е. научи как се прави и въвежда запис в Паскал, след което можеш да научиш някое сортиране за точка 2 от задачата (примерно метод на мехурчето е най-лесния и най-често срещания). Това е което мога да ти кажа, не съм се занимавал от доста време с Паскал и няма как да ти съдействам с код за задачата

още едно въпросче пиша следния код:

program recordwxample1(output);
type
    employeerecord = record
                   name    :string[25];
                   address :string[40];
                   phone   :string[12];
                   rate    :real;
                   maritalstatus        :char;
                   end;
    var
    employeerec :employeerecord;
    begin
    employeerec.name :='diane j.bedford';
    employeerec.address :='20 carmen avenue, new orleans, LA 70112';
    employeerec.phone :='504-666';
    employeerec.rate :=28.5;
    employeerec.maritalstatus :='S';
    writeln('employee name : ',employeerec.name);
    writeln('adress: ',employeerec.address);
    writeln('telephone #: ',employeerec.phone);
    writeln('hourly rate: $',employeerec.rate:0:2);
    writeln('marital status: ',employeerec.maritalstatus )
    end.

и нищо не става, компилира го, но като дам run и няма никой как да го оправя? и съшо по тозио начин ако искам да въведа данните за задачата за всеки участник отделно ли тябва да го пиша?

Редактирано 8 юли 200916 г. от quattro^^ (преглед на промените)

Добре де, ако имаш 1000 участника, които трябва да въведеш, на всеки поотделно ли ще въвеждаш имената в сорс кода? Съвет: въвеждаш брой участници N с readln() след това правиш цикъл от 1 до N и с readln() въвеждаш информацията, която трябва да се въведе. Трябва да си направиш и масив от записи, като всеки елемент на масива ще съответства на един запис (данните за един човек). Извеждането става по същия начин: цикъл от 1 до N и с writeln() извеждаш каквото е необходимо.

аз ако можех нямаше да прибегна до тук...

Редактирано 8 юли 200916 г. от quattro^^ (преглед на промените)

още едно въпросче пиша следния код:

program recordwxample(out1put);
type
    employeerecord = record
                   name    :string[25];
                   address :string[40];
                   phone   :string[12];
                   rate    :real;
                   maritalstatus        :char;
                   end;
    var
    employeerec :employeerecord;
    begin
    employeerec.name :='diane j.bedford';
    employeerec.address :='20 carmen avenue, new orleans, LA 70112';
    employeerec.phone :='504-666';
    employeerec.rate :=28.5;
    employeerec.maritalstatus :='S';
    writeln('employee name : ',employeerec.name);
    writeln('adress: ',employeerec.address);
    writeln('telephone #: ',employeerec.phone);
    writeln('hourly rate: $',employeerec.rate:0:2);
    writeln('marital status: ',employeerec.maritalstatus )
    end.

и нищо не става, компилира го, но като дам run и няма никой как да го оправя? и съшо по тозио начин ако искам да въведа данните за задачата за всеки участник отделно ли тябва да го пиша?

На какво го компилираш? Ако е на turbo pascal махни това (out1put) от заглавния ред и ще тръгне

с оutput нищо не стана, просто сложих readln накрая и тръгна.но имам друга мистерия сега, намерих задача която се доближава малко до тази на изпитите в ПУ но не мога да я стартирам и да на търбо паскал пиша имам и делфи ама там нз как да работя с него.та ето сорс кода

program gleisq;
type
ime=record
inicial:char;
fime:string[15]
end;
student=record
facnom:1000..9999;
stime:array[1..10] of real
end;
var
st:array[1..40] of student;
i, j, n:integer;
s:array[1..40] of real;
procedure init;
begin
write('broi na studentite ot grupata:');readln(n);
for i:=1 to n do
with st, stime do
begin
writeln('danni za ',i,' - tiq student:');
write('fakulteten nomer:');readln(facnom);
write('inicial:');readln(inicial);
write('familiq:');readln(fime);
s:=0
for j:=1 to 10 do
begin
write('pcenka po ',j,'-ti predmet:'');
readln(uspeh[j]);
s:=s+uspeh[j]
end;
s:=s/10
end
end;
procedure writezap;
begin
for i:=1 to n do
with st, stime do
writeln(inicial:2, fime:16, s:6:2)
end;
bwgin
init;
writezap
end.

Редактирано 9 юли 200916 г. от quattro^^ (преглед на промените)

Давам ти решението на задачата от редовния изпит на ПУ 2008 година, дано да схванеш за какво става въпрос : )

program restorant;
 const 
	 N=500;
	 L=40;
 type
	 menu=record
		ime:string[L];
		gramaj:integer;
		cena:real;
		kod:string[10]
	 end;
	 Tasort=array[1..N] of menu;
 var
	 asort:Tasort;
	 br:integer;

  procedure inmenu(var a: menu);
  begin  write('vavedete ime na asortimenta:');
	 readln(a.ime);
	 write('vavedete gramaj/vmestimost: ');
	 readln(a.gramaj);
	 write('vavedete cena na asortimenta: ');
	 readln(a.cena);
	 write('vavedete 10 cifren kod:');{kod: Purvata dvoika cifri sa godina,
	 //vtorata- meseca, a tretata-denqt, do koito se predlaga asortimenta. Sedmata
	 //cifra e kod:1-predqstie,2-osnovno,3-desert,4-bezalkoholno,5-alkohol.
	 //Poslednite 3 cifri sa poreden nomer na asortimenta.}
	 readln(a.kod);
	end;

  procedure outmenu(a:menu);
  begin write(a.ime,', ');
   case a.kod[7] of
	 '1': write('predqstie, ');
	 '2': write('osnovno yastie, ');
	 '3': write('desert, ');
	 '4': write('bezalkoholno, ');
	 '5': write('alkohol, ')
	end;
	writeln(a.gramaj,', ',a.cena:0:2);
	end;

  procedure input(var a:Tasort; br:integer);
  var i,j:integer;
  begin
	 for i:=1 to br do
	  begin  writeln('Vyvedete danni za ',i,'-ia asortiment');
		 inmenu(a[i]);
		 for j:=1 to i-1 do
		   if a[i].kod=a[j].kod then
		   begin writeln('Dublirane na kodovete! Vuvedete pak!');
			dec(i); break;
		   end;
		end;
   end;

  procedure output(var a:Tasort; br:integer);
  var i:integer;
   begin
	 for i:=1 to br do outmenu(a[i])
   end;

  procedure sortime(var a:Tasort; br:integer);
  var i,j:integer;x:menu;
  begin
	for i:=2 to br do
	 for j:=br downto i do
	 if a[j-1].ime>a[j].ime then
	   begin x:=a[j-1]; a[j-1]:=a[j]; a[j]:=x;  end;
   end;

  procedure sortkod(var a:Tasort; br:integer);
  var i,j:integer;x:menu;
  begin
	for i:=2 to br do
	 for j:=br downto i do
	 if (a[j-1].kod[7]<a[j].kod[7]) or
		 (a[j-1].kod[7]=a[j].kod[7]) and
		 (a[j-1].cena>a[j].cena) then
	 begin x:=a[j-1]; a[j-1]:=a[j]; a[j]:=x; end;
   end;

procedure data(var a:Tasort; br:integer);
  var i:integer;
 begin
   for i:=1 to br do
   if copy(a[i].kod,1,6)>='080820' then {Vsichki yastia predlagani}
	  outmenu(a[i]); {do i sled 20.08.08 se vklyuchvat v menyuto za 20.08.08}
   end;

procedure srcena(var a:Tasort; br:integer);
var s:real; i,n:integer;
begin   s:=0; n:=0;
   for i:=1 to br do
	if(a[i].kod[7]='3') then
	  begin s:=s+a[i].cena; inc(n);  end;
	if (n=0) then begin writeln('Nyama deserti!');exit; end;
	s:=s/n;
	writeln('Sredna cena na desertite:',s:0:2);
	writeln('Spisuk na tezi deserti, chiqto cena e po-malka ot srednata:');
	for i:=1 to br do
	 if(a[i].kod[7]='3') and (a[i].cena<s) then outmenu(a[i]);
 end;

begin
	repeat
	write('vavedete broy asortimenti: ' ); readln(br);
	until(br>=5) and (br<=500);
	input(asort,br);
	writeln('spisyk na vsichki asortimenti:');
	sortime(asort,br); output(asort,br);
	writeln('spisyk na vsichki asortimenti, koito se predlagat na 20.08.2008:');
	sortkod(asort,br); data(asort,br);
	srcena(asort,br);
 end.

благодаря, днес написах програма за 1-ва точка от изпита и всчико точно ама нататък също трябва да го науча тея дни че няма време

spe6no mi trqbva re6enie na tazi zada4a na Pascal

pomo6t pls

За нуждите на градската библиотека трябва да се изгради информационна система, съдържаща информация за книгите във вида: заглавие, автор, година на издаване, цена. Напишете програма, която:

А) въвежда информация за 200 книги

Б) намира броя на книгите, издадени преди 2000 година.

В) отпечатва заглавието и автора на книгите с цена под 10 лева.

mersi predvaritelno

(неразбираем текст)

При положение, че дори те е мързяло да превключиш клавиатурната подредба, не смятам, че заслужаваш помощ. Никой не е тук, за да ти пише домашната. Поне се опитай донякъде.

Здравейте! Тази седмица ми се наложи да се сбъскам със една следната задача на паскал, но сресщам малко затруднения.

Да се създаде програма, която да чете текст от файл, да изпринтира всеки ред от файла на нов ред, предхождан от номера на реда, както е във файла. След това да се изпринтира списък от всички думи срещани във файла, подреден по азбучен ред. След всяка дума трябва да се изпринтира номера на редовете, в които се среща(ако една дума се среща повече от 1 път на ред, номера на реда трябва да бъде изписан само 1 път).

Имам кода на самата програма:

var f, log _linenums:0'>program Xrefs; {$apptype console} uses WordTrees; const defaultLogFileName = 'XRefLogFile.txt'; var f, log: Text; (* ‘output’ is standard output -- screen *) numWords, wordLen, lineNum, pos: integer; fileName: String[32]; line: String[255]; word: String[64]; wordTree: WordTrees.WordTree; function Alphabetic (ch: char): boolean; // checks whether ch is a letter character or not begin Alphabetic := ('a' <= ch) and (ch <= 'z') or ('A' <= ch) and (ch <= 'Z') end (* Alphabetic *); function AllowedInWord(ch: char): boolean; (* pre: true post: AllowedInWord(ch) is ch is a character allowed in a word, i.e. a letter or apostrophe or hyphen *) begin AllowedInWord := Alphabetic(ch) or (ch = '''') or (ch = '-') end (* AllowedInWord *); procedure SkipNonWord; begin while (pos <> Length(line) + 1) and not AllowedinWord(line[pos]) do pos := pos + 1 end (* SkipNonWord *); begin Write('Name of file (with suffix)? '); Readln(fileName); AssignFile(f, fileName); {$I-} Reset(F); {$I+} (* suspend abort on error, so that we can detect it with IOResult *) if IOResult <> 0 then writeln(fileName, ' does not exist or is not accessible ') else begin AssignFile(log, defaultLogFileName); Rewrite(log); writeln('output is also being written to ', defaultLogFileName); writeln(output, 'cross reference of ', fileName); writeln(log, 'cross reference of ', fileName); writeLn(log); writeln(output); WordTrees.CreateEmpty(wordTree); numWords := 0; lineNum := 0; while not eof(f) do begin lineNum := lineNum + 1; write(log, lineNum: 2, ': '); write(output, lineNum: 2, ': '); ReadLn(f, line); writeln(log, line); writeln(output, line); pos := 1; SkipNonWord; while pos <> Length(line) + 1 do begin wordLen := 0; while (pos <> Length(line) + 1) and AllowedInWord(line[pos]) do begin wordLen := wordLen + 1; word[wordLen] := line[pos]; pos := pos + 1 end; SetLength(word, wordLen); numWords := numWords + 1; WordTrees.RecordWord(wordTree, word, lineNum); SkipNonWord end; end; writeln(log); writeln(output); WordTrees.Display(log, wordTree); WordTrees.Display(output, wordTree); writeln(log); writeln(output); writeln(log, 'number of words: ', numWords); writeln(output, 'number of words: ', numWords); writeln(log, 'number of different words: ', WordTrees.NumberOfEntries(wordTree): 4); writeln(output, 'number of different words: ', WordTrees.NumberOfEntries(wordTree): 4); close(f); close(log) end; readln (* hold on screen until user presses key *) end (* XRefs *).

Но ми трябва помощ със написването на функциите, които се съдържат на отделни файлове.

За WordTree трябва да използвам binary search tree.

unit WordTrees;

interface
uses LineLists;

type
  WordTree = ^WordTreeDesc;
  WordTreeDesc = record 
                   word: String;
                   lineNumbers: LineLists.LineList;
                   left, right: WordTree
                 end;

procedure CreateEmpty (var wt: WordTree);
(* pre: TRUE
   post: wt is an empty word tree *)

procedure RecordWord (var wt: WordTree; word: String; line: integer);
(* pre: wt is a binary search tree (in ascending order)
   post: if word was not in tree wt, then word and line have been inserted into ordered wt,
   else line has been appended to line-number list for word *)

procedure Display (var f: Text; wt: WordTree);
(* pre: wt is created
   post: wt has been written to text file f *)

	
function NumberOfEntries (wt: WordTree): integer;
(* pre: wt is open
   post: NumberOfEntries(wt) = 'number of entries in wt' *)






end (* WordTrees *).

и singly linked list за LineList.

unit LineLists;

interface

type
  LineElem = ^LineElemDesc;
  LineElemDesc = record 
                   Line: integer; 
                   next: LineElem 
                 end;
  LineList     = record 
                   head, last: LineElem 
                 end;

procedure NewList (var pl: LineList; LineNum: integer);
(* pre: TRUE
   post: pl is a LineList containing one element with value LineNum *)

procedure Append (var pl: LineList ; LineNum: integer);
(* pre: list pl has been created by using NewList
   post: if LineNum was not in Linelist,
         then it has been inserted at the end of the list, otherwise ignored *)

procedure Display (var f: Text; pl: LineList);
(* pre: pl is open
   post: pl has been written to text file f *)



end (* LineLists *).

Моля, не обръщайте внимание на поясненията, тях съм ги писал като част от документацията.

За LineLists.Append си мисля, че може да се използва функцията Append , тъй като номерата на редовете така или иначе се нареждат в растяща последователност.

Предварително благодаря за помощта.

Ще помоля по знаещите да ми дадат идейки как да направя на паскал програма която обработва двоичен код в букви и от букви в двоичен код? Ще бъда много благодарен.

Ще помоля по знаещите да ми дадат идейки как да направя на паскал програма която обработва двоичен код в букви и от букви в двоичен код? Ще бъда много благодарен.

Нещо като това само че на паскал или в краен случай на Делфи.

Привет навсички в тая част на форума. Започнах да пиша една каталог програма на пасцал и сатигнах до един момент в който трябваше да я тествам... Оказа се, че незнайно за мен защо процедурата за въвеждане на данни не записва данните във файла. Създава файла с подоченото име, но когато го отворя след това е празен. Въпроса ми е каква може да е причината да не записва информацията във файла? Ето я и процедурата: Procedure newbase; var d:data; j,n,s:integer; begin j:=0; n:=1; s:=1; clrscr; writeln; writeln; writeln(' ':15,'Insert the information for the discs:'); assign(db,'Database'); rewrite(db); repeat begin d.num:=n; writeln; write(' ':15,'Type of content (music, movies, software): '); readln(d.class); for j:=1 to 100 do begin while (s=1)and(j<100) do begin write(' ':15,'Insert content (one name only): '); readln(d.content[j]); write(' ':15,'More content on that disc (1-Yes,2-No): '); readln(s); end; if (s=2) and (j<101) then begin d.content[j]:='.'; j:=j+1; end; end; write(db,d); writeln; write(' ':15,'1-New disc, 2-Back to Main Menu: '); readln(s); end; until s=2; close(db); end;

Какви типове са data и db ? Възниква ли грешка при изпълнение на програмата ?

Редактирано 30 август 200916 г. от Ken (преглед на промените)

Type data=record num:integer; class:string[10]; content:array[1..100] of string[25]; end; VAR ch:integer; db,base:file of data; Това е основната декларация на променливи за цялата програма... Грешката възноква при повторното отваряне на файла. След като съм записал информация с тая процесура след като отворя файла ми пише че файла е празен... Други грешки нямам, и за тва се чудя...

Редактирано 30 август 200916 г. от psycho_666 (преглед на промените)