вот мой вариант но тут что то не так
помогите плз




program Lab5_1;{Найти среднее арифметическое действительных корней трёх квадратных уравнений}
uses crt ;
var z,x,y,SRA:real;
var a1, b1, c1, a2, b2, c2,a3,b3,c3: real ;
procedure K(a,b,c:real;var x1,x2,k:real);
function dskt(var b,a,c:integer):real;
begin
if (dskt>0) or (dskt<0) then
k:=2;
else
k:=1;
end;
begin
case dskt of
dskt>0:x1:=(-b+sqrt(dskt))/2a;
dskt>0:x2:=(-b-sqrt(dskt))/2a;
dskt=0:x1:=(-b+sqrt(dskt))/2a
else
x1:=0;
x2:=0;
end;
begin
dskt:=sqr(b)-4*(a)*©;
end;
begin
clrscr;
writeln('Введите значение коэфициэнтов первого квадратного уравнения ');
readln(a1,b1,c1);
z:=dskt(a1,b1,c1);
writeln('Введите значение коэфициэнтов второго квадратного уравнения ');
readln(a2,b2,c2);
x:=dskt(a2,b2,c2);
writeln('Введите значение коэфициэнтов третьего квадратного уравнения ');
readln(a3,b3,c3);
y:=dskt(a3,b3,c3);
S:=
writeln('Среднее арифметическое действительных корней трёх квадратных уравнений=',SRA);
readkey ;
end .

Пожалуйста, пользуйся кнопкой CODE при вставке текста программы.

Смотри ошибки компиляции:
1) Syntax error, ";" expected but "ELSE" found с указанием на строку означает - что перед else не ставится ";".
2) в case используются только перечислимые типы, а dskt - тип real. Варианты выбора - тоже значения или диапазоны перечислимых типов. Т.е. в данном случае case заменяется на несколько if.
3) dskt=0:x1:=(-b+sqrt(dskt))/2a - наверное 2*a

Ну и далее, по мере исправления...

суть не в этом сама суть программы мне не понятна чтобы работала в норме с заданием

Если грамматические и синтаксические ошибки устраивают, то в чём собственно вопрос?
Как структура - правильно - решение уравнения вынесено в процедуру.

Начни отладку пошагам - сначала отладь решение квадратных уравнений с выводом корней на экран.
Потом делай это в цикле 3 раза

const
  N = 3;
........
  S:=0;
  for i:=1 to N do begin
    {1. ввод коэффициентов a, b, c}
..................
    {2. решение квадратного уравнения и получение его корней x1, x2}
    SqrEquat(a, b, c, x1, x2);
    {3. сложение корней}
    S:=S+x1+x2;
  end;
  S:=S/(N*2); {вычисление среднего арифметического}

если честно мне не понятно

Если честно, то нам уже самим не очень понятно, что именно вам не понятно.

У тебя структура программы выбрана верно, но в самой реализации допущены ошибки.
Поэтому для решения задачи, предлагаю разбить её на ряд небольших задач.

Итак, постановка задачи

Будем решать последовательно. Для начала, создадим и отладим функцию для решения квадратных уравнений. Назовём её SqrEquat (у тебя её "звали" просто "K").
Действия функции:
1) если корня два (дискримминант больше 0), то функция будет возвращать два корня x1 и x2, а само значение функции будет равно 2;
1) если корень один (дискримминант равен 0), то функция будет возвращать два корня x1 и x2, просто одинаковых (x1==x2), а само значение функции будет равно 1;
2) если действительных корней нет, то возвращаться будет два корня равных нулю (x1==x2==0), а само значение функции будет равно 0.
Делаем тестовую программу.

program test;
function SqrEquat( a, b, c : real; {коэффициенты квадратного уравнения}
                           var x1, x2 : real) {корни уравнения}
                          : integer; {функция возвращает количество действительных корней уравнения}
begin
.....................{реализация функции}
end;

var
  n : integer;
  x1, x2 : real;
begin
  n:=SqrEquat(4, 20, 24, x1, x2);
  case n of
    0: WriteLn('There are not a real roots.');
    1: WriteLn('There is a single root x= ', x1);
    2: WriteLn('There are double roots x1=', x1, ', x2=', x2);
  end; 
end.

После получения работающего кода функции, его можно скопировать в "настоящую" программу, где на основе корней уравнения выполняются дальнейшие расчёты. Например,

............................
var
  i, n, SumN : integer;
  x1, x2,
  a, b, c,
  SumX : real;
begin
  SumN:=0;{количество действительных корней во всех уравнениях}
  SumX:=0;{сумма всех действительных корней во всех уравнениях}
  for i:=1 to 3 do begin
    writeln('Введите значение коэфициэнтов ', i, '-го квадратного уравнения: ');
    readln(a,b,c);
    n:=SqrEquat(a, b, c, x1, x2);
    case n of
      1: SumX:=SumX+x1;
      2: SumX:=SumX+x1+x2;
    end;
    SumN:=SumN+n;
  end;
  if SumN<>0 then
    WriteLn('The average of a real roots is ', SumX/SumN);
  else
    WriteLn('There are not a real roots.');
end.

спасибо большое)))

вот все к чему я смог прийти
program koren;{Íàéòè ñðåäíåå àðèôìåòè÷åñêîå äåéñòâèòåëüíûõ êîðíåé òð¸õ êâàäðàòíûõ óðàâíåíèé}
uses crt;
var SRA,X1,X2,q,w,e,S:real;
i,K:integer;
F:boolean;
procedure squart(A,B,C:real; var Y1,Y2:real;VAr F:boolean);
var D:real;
begin
D:=B*B-4*A*C;
if D>=0 then
begin
Y1:=(-B+SQRT(D))/(2*A);
Y2:=(-B-SQRT(D))/(2*A);
F:=True;
end
else
begin
F:=False;
Y1:=0;
Y2:=0;
end;
end;
begin
clrscr;
K:=0;
S:=0;
begin
write('Ââåäèòå êàæäûé ÷ëåí òðåõ êâàäðàòíûõ óðàâíåíèé ');
for i:=1 to 3 do
readLn(q,w,e);
squart(q,w,e,X1,X2,F);
writeln(X1,X2,F);
if F=True
then
begin
K:=K+2;
S:=X1+X2+S;
end;
end;
SRA:=S/K;
writeln(SRA);
readkey;
End.

помогите пожалуйста найти и исправить недочеты

Используй же тег CODE, тебе же сказали, нам нихрена не доставляет форматировать код руками.