Имеется 2 файла справочника и один файлик основной. Необходимо сформировать ведомости. Первая ведомость формируется как надо, тоесть как мне надо ). А вот вторая в последнем столбике Количество Струдников не прописывает их количество. Код написан, вроде должно работать, а не тут-то было. Вот в этом файле
Vedomosti.pas ( 12.69 килобайт )
Кол-во скачиваний: 652
- процедуры по формированию ведомостей.
spravka1.txt ( 229 байт )
Кол-во скачиваний: 455
- первый справочник(текстовый).
___________________2.rar ( 541 байт )
Кол-во скачиваний: 349
- основной фаил и второй справочник(оба они типизированные).
Но может вы и без этого увидите как исправить процедуру по созданию второй ведомости.
Заранее благодарен.
всё-всё, выложил все необходимые файлы.
Теперь можешь смотреть
Я понял кажется в чём ошибка, но как устранить...что-то не соображу...
procedure vedomost2_sozdanie;
VAR
i,w,k,j,t,p,n:integer;
s1,s2,s3,s4,s,q:string;
z:tmas;
x:thmas;
l:tmasiv;
Begin
w:=0;
q:='0';
i:=0;
assign(spravochnik1,'spravka1.txt');
assign(vedomost2,'vedomost2');
reset(spravochnik1);
while not(eof(spravochnik1)) do
begin
inc(w);
readln(spravochnik1,s);
end;
rewrite(vedomost2);
reset(spravochnik1);
with Zap_ved2 do
While not(eof(spravochnik1)) do
begin
readln(spravochnik1,s1);
readln(spravochnik1,s2);
readln(spravochnik1,s3);
readln(spravochnik1,s4);
Cod_OTDELA:=s1;
FIO_zava:=s3;
telefnchik:=s4;
kol_vo_sotr:=q;
write(vedomost2,Zap_ved2);
end;
close(spravochnik1);
close(vedomost2);
sortirovkaVED2;
sortirovkaosnovpo3_1;
t:=filesize(osnov);
getmem(z,t*sizeof(Zap));
getmem(x,t*sizeof(HZ));
k:=0;
while not(eof(osnov)) do
begin
read(osnov,Zap);
inc(k);
z^[k]:=zap;
end;
close(osnov);
k:=0;
reset(osnov);
while not(eof(osnov)) do
begin
read(osnov,Zap);
inc(k);
x^[k]:=helpzap; { <-- вот тут я создаю массив записей, но так как первоначально }
end; {файла на него нету, то он собой представляет 1 запись всего, как я понимаю...}
close(osnov); {а мне надо чтобы их было столько же сколько в файле osnov}
p:=1;
For i:=1 to t do
begin
IF z^[i].CodeOTD <> z^[i+1].CodeOTD then {или может тут ошибка в построение цикла...хотя я вручную проверял...вроде правильно...}
begin
x^[i].CODEOTDELA:=z^[i].CodeOTD;
str(p,x^[i].TAB);
p:=1;
end
Else
begin
IF z^[i+1].Tabnomr<>z^[i].Tabnomr then
inc(p);
end;
end;
freemem(z,t*sizeof(Zap));
reset(vedomost2);
j:=filesize(vedomost2);
getmem(l,j*sizeof(Zap_ved2));
k:=0;
while not(eof(vedomost2)) do
begin
read(vedomost2,Zap_ved2);
inc(k);
l^[k]:=Zap_ved2;
end;
close(vedomost2);
For i:=1 to j do
FOR n:=1 to t do
IF l^[i].Cod_OTDELA=x^[j].CODEOTDELA then
l^[i].kol_vo_sotr:=x^[j].TAB;
rewrite(vedomost2);
For i:=1 to j do
write(vedomost2,l^[i]);
close(vedomost2);
freemem(l,j*sizeof(Zap_ved2));
freemem(x,t*sizeof(HZ));
sortirovka;
End;
For i:=1 to t doи чуть ниже то же самое...
begin
IF z^[i].CodeOTD <> z^[i+1].CodeOTD then { <--- При i = T ты вылетаешь за пределы отведенной памяти }
так вроде когда я вылетаю - то он сравнивает с NIL, а нилу он не равен и действия выполняются...
Ты записускал её с фалами со всеми?
видел что во второй ведомости? только в последнюю строчку добавляется кол-во сотрудников почему-то...
Да не могу я ее запускать... Нет у меня кириллицы, в 16-битных приложениях, сколько раз повторять... Толку то, что я запущу... Я ж результат проверить не могу!
окей, попробую, а так вот скрины:
- соновной фаил. - справочник 1
- справочник 2 . -ведомость 2.
вообщем условие изменилось. В массив x нужна писать в поле x^[i].CODEOTDELA z^[i].CodeOTD, а в поле x^[i].TAB количество идущх подряд записей z^[i], начинающихся на одинаковый код отдела
причём реализовано должно быть так:
если вы массиве Z у нас:
01 *....
01 *....
02 *....
03 *...
03 *...
03 *...
То в массив X записаться должно так:
01 * 2
02 * 1
03 * 3
Что-то я не понимаю как организовать цикл, при этом не выходя за границы памяти выделенной под массив Z...
const
z_size = 6;
type
x_arr = array[1 .. z_size] of record
code: string;
count: integer;
end;
z_arr = array[1 .. z_size] of string;
var
x: x_arr;
i, k, p: integer;
const
z: z_arr = ('01', '01', '02', '03', '03', '03');
begin
k := 0;
i := 1;
while i <= z_size do begin
p := 1; inc(i);
while z[i] = z[i - 1] do begin
inc(p); inc(i);
end;
inc(k);
x[k].code := z[i - 1];
x[k].count := p;
end;
for i := 1 to k do begin
writeln(x[i].code, ' : ', x[i].count);
end;
end.
Да, спасиб, всё ясно стало
Токо вот теоритически алгорит правельный, а считает не то почему-то...
- вот тут первый столбик - это рассчпечатка z[i].CodeOTD, а второй, ниже, там где через двоеточие, это сформировавшийся массив X. Как видно - считает почему-то не то....Не понимаю...
║
║ reset(osnov);
║ t:=filesize(osnov);
║ getmem(z,t*sizeof(Zap));
║ getmem(x,t*sizeof(HZ));
║ k:=0;
║ while not(eof(osnov)) do
║ begin
║ read(osnov,Zap);
║ inc(k);
║ z^[k]:=zap;
║ end;
║ close(osnov);
║ k:=0;
║ reset(osnov);
║ while not(eof(osnov)) do
║ begin
║ read(osnov,Zap);
║ inc(k);
║ x^[k]:=helpzap;
║ end;
║ close(osnov);
║ k:=0;
║ i:=1;
║ while i <= t do
║ begin
║ p:=1;
║ inc(i);
║ while z^[i].CodeOTD = z^[i-1].CodeOTD do
║ begin
║ inc(p);
║ inc(i);
║ end;
║ inc(k);
║ x^[k].CODEOTDELA:= z^[i-1].CodeOTD;
║ str(p,x^[k].TAB);
║ end;
║
║ For i:=1 to t do
║ writeln(z^[i].CodeOTD);
║ writeln;
║ For i:=1 to k do
║ writeln(x^[i].CODEOTDELA,' : ',x^[k].TAB);
║
Значится, так... Первое, что тебе надо было сделать (я совсем забыл тебе сказать) - это во всех структурах поменять простой string на string[255]... У меня, например, под FPC, это играет решающую роль - без этого не работает, а с изменением - на ура... Попробуй...
For i:=1 to k do
writeln(x^[i].CODEOTDELA,' : ',x^[i].TAB); { <--- Печатать i-ый элемент, а не всегда последний !!! }
Щет!!! ))
несколько дней искал в чём трабла, а тут даж не замечал
Надо завязывать с учёбой , даёшь выходные после завершения лабораторки
СПасиб тебе огромнейшее ))