Дофига прог Делфи 1 (проги)

Посмотреть архив целиком

program Project2;


{$APPTYPE CONSOLE}

uses

SysUtils;

type t=array [1..100] of real;

procedure tab (dx:real; var a:t; var n:integer);

var i:integer; x:real;

begin

x:=0;

i:=0;

while x<2 do

Begin

inc(i);

x:=x+dx;

a[i]:=exp(x)/x;

end;

n:=i;

end;

function min(a:t;n:integer):real;

var i:integer; m:real;

begin m:=a[1];

for i:=2 to n do

if a[i]

m:=a[i];

min:=m;

end;

var dx:real;a:t; n,p:integer;

begin

writeln('vvedite shag');

readln(dx);

tab(dx,a,n);

writeln('min znachenie: ',min (a,n));

for p:=1 to n do

writeln(a[p]);

readln;

end.


program Project3;


{$APPTYPE CONSOLE}

uses

SysUtils;

function log(var x: real): real;

var y:real;

Begin

y:=0;

if x>0 then

y:=ln(x)/ln(10)

else

writeln('Zna4enie x ne ydovltev. OOF');

log:=y;


end;


Var x:real;

begin

Writeln('vvedite 4islo');

Readln(x);

if log(x)<>0 then

Writeln(log(x):3:4);

Readln;

end.


program Project4;


{$APPTYPE CONSOLE}

uses

SysUtils;

{1} function kol(var s:string):integer;

var i,k:integer;

Begin

k:=0;

for i:=1 to length(s) do

if s[i] in ['a'..'z']+['A'..'Z'] then

inc(k);

kol:=k;

end;


{2} function del(var s:string):string;

var i:integer; l:string;

Begin

for i:=1 to length(s) do

if not (s[i] in ['0'..'9']) then

begin

l:=l+s[i];

end;

del:=l;

end;


{3} procedure sort (var s:string);

var i,j:integer; c:char;

Begin

for i:=length(s) downto 1 do

for j:=1 to i-1 do

if s[j+1]

begin

c:=s[j]; s[j]:=s[j+1]; s[j+1]:=c;

end;

end;


var st:string;

begin

readln(st);

writeln(kol(st));

writeln(del(st));

sort(st);

writeln(st);

readln;

readln;

end.


program 5;


const n=100;

type

Tdat=record

Famil: string[30];

Resul: real;

end;

Tmas=array[1..n] of Tdat;

Tf=file of Tdat;


{создание файла записей}


procedure CrtFile(var namef: string;

k: integer; var mas1: Tmas);

var

i: integer;

f: Tf;

begin

Assignfile(f, namef); Rewrite(f);

writeln('введите данные студентов');

for i:=1 to k do

begin

readln(mas1[i].Famil);

readln(mas1[i].Resul);

write(f, mas1[i]);

end;

Closefile(f);

end;


{составление списка и его сортировка}


procedure List(var namef: string;

k: integer; var cnt: integer;

var mas1,mas2: Tmas);

var

i,j: integer;

buf: Tdat;

g: Tf;

begin

Assignfile(g, namef); Reset(g);

cnt:=1;

for i:=1 to k do

begin

if mas1[i].Resul < 60 then

begin

mas2[cnt]:=mas1[i];

inc(cnt);

end;

end;

Closefile(g);

for i:=1 to cnt-1 do

for j:=i+1 to cnt do

if mas2[i+1].Famil < mas2[i].Famil then

begin

buf:=mas2[i+1];

mas2[i+1]:=mas2[i];

mas2[i]:=buf;

end;

end;

{вывод списка}

procedure OutDat(var mas2: Tmas;

var cnt: integer);

var

i: integer;

begin

writeln('студенты с ретингом < 60 баллов');

for i:=1 to cnt do

begin

writeln(mas2[i].Famil,' ',mas2[i].Resul);

end;

end;


{основная программа}

VAR

namef: string;

k,count: integer;

mas1, mas2: Tmas;

f: Tf;

BEGIN

namef:='D:\base.dat';

writeln('введите кол-во студентов');

readln(K);

CrtFile(namef,k,mas1);

List(namef,k,count,mas1,mas2);

OutDat(mas2,count);

readln

END.


program Project6;


{$APPTYPE CONSOLE}

uses

SysUtils;

type t=array[1..10,1..10]of integer;

procedure vvod(var a:t;var m,n:integer);

var i,j:integer;

begin

writeln('vvedite kol-vo strok:');

readln(n);

writeln('vvedite kol-vo stolbcov:');

read(m);

writeln('vvedite elementi matrici:');

for i:=1 to n do

begin

for j:=1 to m do

read(a[i,j]);

readln;

end;

end;

procedure maxmin(a:t;m,n:integer;var max,min:integer);

var i,j:integer;

begin

max:=a[1,1];

min:=a[1,2];

for i:=1 to n do

for j:=1 to m do

if ((i+j)mod 2=0)then

begin

if a[i,j]>max then max:=a[i,j]

end

else

if a[i,j]

writeln('maximalniy sredi elem s chet sum indeksov:',max);

writeln('min sredi elem s nechet summoy indeksov:',min);

end;

var a:t;

m,n,max,min:integer;

begin

vvod(a,n,m);

maxmin(a,n,m,max,min);

READLN;

end.


program Project7;


{$APPTYPE CONSOLE}

uses

SysUtils;

type t=array[1..15]of string;

t1=text;

procedure vvod(var a:t;var n:integer);

var i:integer;

begin

writeln('vvedite razmer massiva:');

readln(n);

writeln('vvedite massiv:');

for i:=1 to n do

readln(a[i]);

end;

function del(s,sl:string):string;

var i:integer;

begin

for i:=1 to round(length(s)/length(sl)) do

begin

pos(sl,s);

delete(s,pos(sl,s),length(sl));

end;

del:=s;

end;

procedure ud(n:integer; var a:t);

var sl:string;

i:integer;

begin

writeln('vvedite slovo:');

readln(sl);

for i:=1 to n do

a[i]:=del(a[i],sl);

end;

procedure vvodf(fname:string;a:t;n:integer);

var f:t1;

s:string;

i:integer;

begin

assign(f,fname);

rewrite(f);

for i:=1 to n do

writeln(f,a[i]);

close(f);

assign(f,fname);

reset(f);

while not eof(f) do

begin

readln(s);

writeln(s);

end;

close(f);

end;

var a:t;

n:integer;

begin

vvod(a,n);

ud(n,a);

vvodf('C:\f1.txt',a,n);

READLN;

end.


program Project8;


{$APPTYPE CONSOLE}

uses

SysUtils;

const n=3;

type t=array[1..n,1..n]of integer;

t1=array[1..n,1..n-1]of integer;

procedure vvod(var a:t);

var i,j:integer;

begin

writeln('vvedite elemeti massiva!');

for i:=1 to n do

begin

for j:=1 to n do

read(a[i,j]);

readln;

end;

end;

procedure vivod(b:t1);

var i,j:integer;

begin

writeln('vivod poluchennogo massiva');

for i:=1 to n do

begin

for j:=1 to n-1 do

write(b[i,j],' ');

readln;

end;

end;

procedure uddig(a:t;var b:t1);

var i,j:integer;

begin

for i:=1 to n do

for j:=1 to n-1 do

if j

else b[i,j]:=a[i,j+1];

end;

var a:t;

b:t1;

begin

vvod(a);

uddig(a,b);

vivod(b);

READLN;

end.


program Project15;

{$APPTYPE CONSOLE}

uses

SysUtils,System;

Function Integral(a,b:integer):real;

const ep=0.0001;

var

h:real;

x:real;

s2,s1:real;

n,i:integer;

begin

s1:=(exp(b)-arctan(b))*(b-a);

h:=1;

repeat

x:=a;

s2:=s1;

n:=round((b-a)/h);

s1:=0;

for i:=1 to n do

begin

s1:=s1+((exp(x)-arctan(x)))*h;

x:=x+h;

end;

h:=h/2;

until abs(s2-s1)

Integral:=s1;

end;

var

a:array[1..3] of real;

i:integer;

begin

a[1]:=Integral(0,1);

a[2]:=Integral(1,2);

a[3]:=Integral(2,3);

for i:=1 to 3 do

begin

writeln('interval (',i-1,',',i,']: ',a[i]:5:2);

end;

readln;

end.




Случайные файлы

Файл
29009.rtf
184044.doc
8266.rtf
23902-1.rtf
4otchet.docx




Чтобы не видеть здесь видео-рекламу достаточно стать зарегистрированным пользователем.
Чтобы не видеть никакую рекламу на сайте, нужно стать VIP-пользователем.
Это можно сделать совершенно бесплатно. Читайте подробности тут.