Задачи по Паскалю

[MissLove]

1 - Даны вещественные числа N и M. Найти на интервале <от меньшего из них до большего из них> с шагом 0.1 все вещественные числа, делящиеся на 0.5 с остатком не более 1-го знака после точки.

2 - Произвольный треугольник задан декартовыми координатами своих вершин (X1,Y1),(X2,Y2),(X3,Y3) – целыми числами. Выяснить, принадлежит ли этому треугольнику точка с координатами (X,Y) – целыми числами, т.е. находится ли она внутри него или на ребре.

3 - Заменить в группах символов, состоящих только из цифр, все цифры предыдущими по значению цифрами, а '0' заменить на точку.
Например, строка: ‘ 6е-1 75 bа12 123‘ ; результат: ‘ 6е-1 64 bа12 012‘

4 - Найти сумму элементов строки, в которой расположен наибольший элемент.

5 - Массив целых чисел. В функции найти в исходном массиве наименьший элемент, удалить его из массива (размерность итогового массива уменьшится на 1). Найденный элемент передать в головную программу в качестве возвращаемого значения функции.

6 -
- Ввести с клавиатуры произвольное имя текстового файла.
- Найти на жестком диске компьютера все файлы с заданным именем (одноименные файлы могут находиться в разных папках), поочередно вывести на экран их содержимое. Если ни одного файла не найдено, выдать сообщение.
- Выполнить обработку каждого найденного файла в соответствии с заданием в варианте.
- Создать текстовый файл с именем программы, в который записать результаты выполнения программы, т.е. продублировать вывод информации на экран и в текстовый файл. Этот файл перезаписывать при каждом запуске программы.

-Определить максимальную длину строки в файле.



Мне позарез нужно ЛЮБЫЕ ДВЕ лабы...очень прошу... Заранее спасибо...

[MissLove]

В первой задаче не могу понять как сделать, чтобы выводились только с остатком не более одного знака... нигде не могу найти ничего подобного к сожалению =(( помогите хоть советом можалуйста...

[KORT]

4 примерно, а может и так должна иметь вид

 
USES CRT;
Type
    mas1=array [1..5,1..3] of integer;
Var
   M: mas1;
   i,j,mах,p: byte;
begin
Randomize;
For i:=1 to 5 do
    begin
    For j:=1 to 3 do
    M[i,j]:=random (50)-10;
    end;
For i:=1 to 5 do
    Begin
    For j:=1 to 3 do
    Begin
    Write (M[i,j]:5);
    end;
    Writeln;
    End;
For i:=1 to 5 do
             Begin
             P:=0;
             For J:=1 to 3 do
                 max:=M[i,j];
                 If M[i,j]>max then
                             begin
                             P:=P+M[i,j];
                             Writeln;
                             Write(P:5);
                             end
              End;
End.

[Carbon]

4.

const rows=10,columns=10;
var matrix:array [1..rows,1..columns] of extended;
i,j,dest_row:integer;
sum,max_elem:extended;
 
begin
max_elem:=matrix[1,1];
dest_row:=1;
sum:=0.0;
for i:=1 to rows do
  for j:=1 to columns do
    if max_elem<matrix[i,j] then
    begn
      dest_row:=i;
      max_elem:=matrix[i,j]
    end;
 
for i:=1 to columns do
  sum:=sum+matrix[dest_row,i];
 
writeln(sum)
 
end.

Правда, без заполнения массива.

ЗЫ KORT, только сейчас глянул что мы 1 и ту же задачу выписали.

[Carbon]

2.

var x1,x2,x3,x, y1,y2,y3,y, A,B,U:integer;
 
begin
  U=(x1-x3)*(y2-y3)-(x2-x3)*(y1-y3);
  if U=0 then writeln('С треугольником что-то не так...')
  else
  begin
    A:=(x-x3)*(y2-y3)-(x2-x3)*(y-y3);
    B:=(x1-x3)*(y-y3)-(x-x3)*(y1-y3);
    if (U<0) and (U<=A) and (A<=0) and (U<=B) and (B<=0) or
       (U>0) and (U>=A) and (A>=0) and (U>=B) and (B>=0) then
       writeln('Внутри треугольника')
    else
       writeln('Снаружи')
  end
end.

[Alex21]

-=2=- Вершины треуголька - ABC, для удобности взял координаты AX,AY ...и т.д. Точка - О (OX, OY) Если не разберетесь могу исправить на ваши (x1,y1,x2,y2...).
Координаты треугольника определяем случайным образом. Координаты точки вводим с клавиатуры.
Задача сведена к тому, что определяем длины отрезков вершин треугольника и точки и сравниваем их отношения. Короче нарисуйте на листе треугольник, поставите точку, и соедините все точки отрезвами, тогда все станет понятно.

program Project2;
uses CRT; 
var
AX,AY,BX,BY,CX,CY:integer; {Точки треугольника}
OX,OY:integer; {Точка}
procedure Vvod_O; {Вводим координаты точки О}
begin
  Write('Введите координаты точки O> x = ');
  ReadLN(OX);
  Write('Введиет координаты точки O> y = ');
  ReadLN(OY);
end;
procedure Create_tringle; {генерируем точки A B C}
begin
  Randomize();
  AX:=Random(200);
  AY:=Random(200);
  BX:=Random(200);
  BY:=Random(200);
  CX:=Random(200);
  CY:=Random(200);
  WriteLn('AX = ',AX,'   BX = ',BX,'   CX = ',CX);
  WriteLn('AY = ',AY,'   BY = ',BY,'   CY = ',CY);
end;
function AB:integer;  {определяем длину отрезка AB}
begin
 AB:=round(sqrt(sqr(abs(AX-BX))+sqr(abs(AY-BY))));
end;
function AC:integer; {определяем длину отрезка AC}
begin
 AC:=round(sqrt(sqr(abs(AX-CX))+sqr(abs(AY-CY))));
end;
function BC:integer;  {определяем длину отрезка BC}
begin
 BC:=round(sqrt(sqr(abs(BX-CX))+sqr(abs(BY-CY))));
end;
function AO:integer; {определяем длину отрезка AO}
begin
 AO:=round(sqrt(sqr(abs(AX-OX))+sqr(abs(AY-OY))));
end;
function BO:integer;  {определяем длину отрезка BO}
begin
 BO:=round(sqrt(sqr(abs(BX-OX))+sqr(abs(BY-OY))));
end;
function CO:integer;  {определяем длину отрезка CO}
begin
 CO:=round(sqrt(sqr(abs(CX-OX))+sqr(abs(CY-OY))));
end;
begin
ClrScr;
 Create_tringle; {Вызов процедуры создания треугольника}
 VVOD_O; {вызов процедуры ввода координат т.О}
   if (AO+BO)=AB then WriteLn('На ребре AB');
   if (BO+BC)=BC then WriteLn('На ребре BC');
   if (AO+AC)=AC then WriteLn('На ребре AC');
 
   if (AO+BO+CO)>(AB+BC+AC) then WriteLn('За треугольником');
   if (AO+BO+CO)<(AB+BC+AC) then WriteLn('Внутри треугольника');
 readln;
end.

Carbon опередил :-) Но у меня определяет положение на ребре.

[Tayfun]

Математику я знаю совсем немного, но по моему остаток всегда целое число, если я ошибся то лови исходник
program zad1;
uses crt;
var
p,dx,n,m:real;
begin
clrscr;
writeln('VVEDITE n,m');
readln(n,m);
if n>m then begin p:=n; n:=m; m:=p; end;
dx:=n;
while dx<m do begin
p:=round(dx) mod 5;
if round(p*10)=p*10 then writeln(dx:1:2,' ',p:1:2);
dx:=dx+0.1;
end;
readkey;
end.

Если же всетаки речь идет о частном то этот
program zad1;
uses crt;
var
p,dx,n,m:real;
begin
clrscr;
writeln('VVEDITE n,m');
readln(n,m);
if n>m then begin p:=n; n:=m; m:=p; end;
dx:=n;
while dx<m do begin
p:=dx/5;
if frac(p)<0.9 then writeln(dx:1:2,' ',p:1:2);
dx:=dx+0.1;
end;
readkey;
end.

[Carbon]

Но у меня определяет положение на ребре.

Там вроде пофиг...

ЗЫ Только вот спешил и ошибся: в строке после begin не =, а :=.

[Tayfun]

Несложная, но большая...

program zad3;
uses crt;
var
bo,bb:boolean;
b3,b2,sc,ss,b,s:string;
t,p,cc,j,e,i,c:integer;
begin
clrscr;
sc:='0123456789';
writeln('VVEDITE STROKU');
readln(s);
s:=s+' ';
c:=length(s);
for i:=1 to c do begin
b:=copy(s,i,1);
if b<>' ' then ss:=ss+b else begin
cc:=length(ss);
bo:=true;
for j:=1 to cc do begin
b2:=copy(ss,j,1);
bb:=false;
for t:=1 to 10 do begin
b3:=copy(sc,t,1);
if b3=b2 then bb:=true;
end;
if bb=false then bo:=false;
end;
if bo=true then  begin for j:=1 to cc do begin
b2:=copy(ss,j,1);
val(b2,p,e);
if p=0 then write('.') else write(p-1);
end; write(' '); end else write(ss,' ');
ss:='';
end;
end;
readkey;
end.

Может кто-то знает короче способ?

[MissLove]

ВСЕМ ОГРОМНЕЙШЕЕ СПАСИБО!))))