Составить программу получающую фразу T число N и выводящую на экран Nое слово из T если оно есть

Работа добавлена на сайт samzan.net:

Поможем написать учебную работу

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

Предоплата всего

от 25%

Подписываем

договор

Имя

Выберите тип работы:

Принимаю Политику конфиденциальности

Скидка 25% при заказе до 9.11.2024

1.Составить программу, получающую фразу T, число N, и выводящую на экран N-ое слово из T (если оно есть).

procedure TForm1.Button1Click(Sender: TObject);

var t:string;

i,n,p:integer;

begin

t:=Edit1.Text;

n:=strtoint(edit2.text);

p:=0;

i:=1;

while (i<=length(t)) and (p<>n-1)do begin

if t[i]=' ' then p:=p+1; i:=i+1;

end;

edit3.Text:='';

if (i>=length(t)) then edit3.Text:=edit3.Text+'слова под таким номером нет';

while (i<=length(t)) and (t[i]<>' ') do

begin

edit3.Text:=edit3.Text+t[i]; i:=i+1;

end; end;

2.Составить программу с использованием подрограмм-функций для Вычисления координаты центра тяжести материальных точек с массами m1, m2, m3 и координатами (x1,y1), (x2,y2), (x3,y3) по формулам procedure TForm1.Button1Click(Sender: TObject);

var m1,m2,m3,x1,x2,x3,y1,y2,y3: integer;

x,y: real;

begin

m1:=strtoint(Edit1.Text);

m2:=strtoint(Edit2.Text);

m3:=strtoint(Edit3.Text);

x1:=strtoint(Edit4.Text);

y1:=strtoint(Edit5.Text);

x2:=strtoint(Edit6.Text);

y2:=strtoint(Edit7.Text);

x3:=strtoint(Edit8.Text);

y3:=strtoint(Edit9.Text);

x:=(m1*x1+m2*x2+m3*x3)/(m1+m2+m3);

y:=(m1*y1+m2*y2+m3*y3)/(m1+m2+m3);

Edit10.Text:=floattostr(x);

Edit11.Text:=floattostr(y);

end;end

6.Дан натуральный массив S(N). Построить на экране дисплея круговую диаграмму: площадь i-го сектора круга должна соответствовать S(i).

Var Form1: TForm1;

a:array [1..10] of integer;

x:array [0..10] of integer;

y:array [0..10] of integer;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);

var i,n,sum:integer;

alfa:array [0..10]of real;

x0,y0:integer;//центр диаграммы

wx,wy:integer;//первая точка

x1,y1,x2,y2,x3,y3:integer;//2я-4я точки

r:integer;//радиус

begin

n:=strtoint(edit2.Text);

sum:=0;

alfa[0]:=0;

edit1.Text:=' ';

for i:=1 to n do

begin

a[i]:=random(9)+1 ;

edit1.text:=edit1.text+' '+inttostr(a[i]);

sum:=sum+a[i];

end;

Image1.Height:=300;

Image1.Width:=Image1.Height;

x0:=Image1.Width div 2;

y0:=Image1.Height div 2; //центр

r:=Image1.Width div 2;

{wx}x[0]:=x0+r;{wy}y[0]:=y0; //певая точка

for i:=1 to n do

begin

alfa[i]:=alfa[i-1]+2*pi*a[i]/sum;//альфа

{x1}x[i]:=round(x0+r*cos(alfa[i]));

{y1}y[i]:=round(y0+r*sin(alfa[i]));

brush.color:=clblue;

form1.Image1.Canvas.Pie(x0-r,y0-r,x0+r,y0+r,x[i],y[i],x[i-1],y[i-1]);

end;end; end..

3.Есть двумерный массив 5х5 элементов. Составить одномерный массив, записав из а элементы по строкам.

var

Form1: TForm1;

n,m:integer;

a:array [0..30,0..30] of integer;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);

var i,j:integer;

begin

Randomize;

n:=strtoint(edit1.text);

m:=strtoint(edit2.text);

for i:=1 to n do

for j:=1 to m do

begin

a[i,j]:=round(sin(random(100))*100);

stringGrid1.Cells[j,i]:=Inttostr(a[i,j]);

end;

stringGrid1.Rowcount:=n+1;

stringGrid1.colCount:=m+1;

with stringGrid1 do

begin

i:=0;

for j:=1 to RowCount do

Cells[i,j]:=inttostr(j);

j:=0;

for i:=1 to colcount do

cells[i,j]:=inttostr(i);

end;

procedure TForm1.Button2Click(Sender: TObject);

var i,j,k:integer;

b:array of integer;

begin

edit3.Text:='';

setlength(b,n*m);

k:=0;

for i:=1 to n do

for j:=1 to m do

begin

b[k]:=a[i,j]; edit3.Text:=edit3.Text+inttostr(b[k])+' ';

k:=k+1;

end;end;end.

4.Составить программу, которая не используя приемов обработки строковой информации выяснит, является ли число полиндромом.

procedure TForm1.Button1Click(Sender: TObject);

var n,nn,s,k:integer;

begin

n:=strtoint(Edit1.text);

nn:=n;

s:=0;

while n<>0 do

begin

k:=n mod 10;

n:=n div 10;

s:=s*10+k

end;

if nn=s then Showmessage('Яв-ся') ;

end;

end.

5.Выяснить, сколько слов в предложенном тексте (слова в тексте разделены, возможно, не одним пробелом).

procedure TForm1.Button1Click(Sender: TObject);

var s:string; i,n:integer;

begin

s:=edit1.text;

i:=1;

n:=1;

while (i<>length(s)) do

if (s[i]=' ') and (s[i+1]=' ') then delete(s,i,1) else i:=i+1; //удаляем лишние пробелы

for i:=1 to length(s) do if (s[i]=' ') then n:=n+1; //считаем пробелы

edit2.Text:=inttostr(n);

end;

7.Составить программу для вывода на графический экран рисунка соцветия "зонтик". Число «кружков» предварительно запрашивать.

procedure TForm1.Button1Click(Sender: TObject);

Var x,y,n,i,x1,y1:integer;

h:real;

begin

n:=strtoint(edit1.Text);

x:=form1.Width div 2; //определяем координаты центра канвы

y:=form1.Height div 2;

form1.canvas.moveto(x,y);

form1.canvas.lineto(x,400); //рисуме стебель

i:=0;

h:=pi/(n-1); //делим на n-1 потому что для n веток n-1 промежуток

canvas.Brush.Color:=clBlack;

for i:=0 to n-1 do

begin

x1:= x+round(100*sin(i*h+pi/2)); //100 - длина кисточек

y1:= y+round(100*cos(i*h+pi/2));

form1.canvas.Moveto(x,y);

form1.canvas.lineto(x1,y1);

form1.canvas.ellipse(x1-7,y1-7,x1+7,y1+7);

end; end; end

10.Дана строка латинских букв. Преобразовать строку следующим образом: оставить в строке только строчные буквы.

procedure TForm1.Button1Click(Sender: TObject);

var s,z:string; i,n:integer;

begin

s:=edit1.text;

z:='QWERTYUIOPASDFGHJKLZXCVBNM';

i:=1;

while (i<=length(s)) do

if (pos(s[i],z)<>0) then delete(s,i,1) else i:=i+1;

edit2.Text:='';

edit2.Text:=edit2.Text+s;

end;

11.Составить программу, которая для двумерного массива MxN по специальному сигналу переставляет местами указанные столбцы.

procedure TForm1.Button1Click(Sender: TObject);

var m,n,i,j,b:integer;

a:array [1..100,1..100] of integer;

begin

m:=strtoint(edit1.Text);

n:=strtoint(edit2.Text);

stringgrid1.ColCount:=6;

stringgrid1.RowCount:=7;

for i:=1 to 5 do

for j:=1 to 5 do

begin

a[i,j]:=random(10);

stringgrid1.Cells[j,i]:=inttostr(a[i,j]);

end;

stringgrid2.ColCount:=6;

stringgrid2.RowCount:=7;

for i:=1 to 5 do

for j:=1 to 5 do

begin

b:=a[i,m];

a[i,m]:=a[i,n];

a[i,n]:=b;

end;

for i:=1 to 5 do

for j:=1 to 5 do

stringgrid2.Cells[j,i]:=inttostr(a[i,j]);

end; end.

12.Составить программу, получающую строку знаков и выдающую сколько и каких знаков получено (знаки имеют ASCII-коды).

procedure TForm1.Button1Click(Sender: TObject);

var s:string; i:integer;

a:array[0..255] of integer;

begin

s:=edit1.text;

for i:=0 to 255 do a[i]:=0;

for i:=1 to length(s) do

a[ord(s[i])]:=a[ord(s[i])]+1;

for i:=0 to 255 do

if (a[i]<>0) then edit2.text:=edit2.text+chr(i)+' - '+inttostr(a[i])+'; ';

end;

end.

13.Составить программу для нахождения всех простых чисел из заданного промежутка.

procedure TForm1.Button1Click(Sender: TObject);

var i,j,a,b,t:integer;

begin

b:=strtoint(edit2.text);

a:=strtoint(edit1.text);

t:=0;

for i:=a to b do

begin

for j:=1 to i do

if i mod j=0 then t:=t+1;

if t=2 then edit3.Text:=edit3.Text+' '+inttostr(i);

t:=0;end; end; end.

14.Составить рекурсивный алгоритм вычисления чисел Фибоначчи.

Фибоначчи+Факториал

procedure TForm1.Button1Click(Sender: TObject);

var k,n,m:real;

Function Factorial(k: real) : real;

Begin

if k=0 then

Factorial := 1 else

Factorial := factorial(k-1) * k;

end;

Function Fibo(k: real) : real;

Begin

if (k=1) or (k=2) then

Fibo := 1 else

Fibo := Fibo(k-1)+Fibo(k-2) ;

End;

begin

n:=strtofloat(edit1.text);

m:=factorial(n);

edit2.text:=floattostr(m);

edit3.text:=floattostr(fibo(n));

end;

end.

17.Подсчитать число гласных и согласных букв в тексте, записанном на английском языке.

procedure TForm1.Button1Click(Sender: TObject);

var s,gl,sg:string; i,gb,sb:integer;

begin

s:=edit1.text;

gl:='EeAaYyUuOoIi';

sg:='QqWwRrTtPpSsDdFfGgHhJjKklZzXxCcVvBbNnMm';

i:=1;

sb:=0; gb:=0;

while (i<=length(s)) do

begin

if (pos(s[i],gl)<>0) then gb:=gb+1;

if (pos(s[i],sg)<>0) then sb:=sb+1;

i:=i+1;

end;

edit2.Text:=inttostr(sb);

edit3.Text:=inttostr(gb);

end;

18.Дан числовой массив A(N). Удалить из массива максимальный элемент. Если максимальных элементов несколько, то последний.

procedure TForm1.Button1Click(Sender: TObject);

var

max, i,j:integer;

a:array [1..50] of integer;

begin

edit1.Text:=' ';

edit2.Text:=' ';

for i:=1 to 20 do begin

a[i]:=random(26)-13;

edit1.Text:=edit1.Text+' '+inttostr(a[i]);

end;

max:=a[1];

j:=1;

for i:=1 to 20 do

if a[i]>max then begin max:=a[i]; j:=i end;

edit3.Text:=inttostr(max);

for i:=j to 19 do

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

for i:=1 to 19 do

edit2.Text:=edit2.Text+' '+inttostr(a[i]);

end;end.

9.Написать программу, которая демонстрирует движение прямоугольника по диагоналям: из левого верхнего угла – в правый нижний, а затем из правого угла – левый нижний.

var

Form1: TForm1;

x,y: Integer;

w, h: Integer;

n: Integer;

Col: TColor = clGreen;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);

begin

w := 50;

h := 50;

end;

procedure TForm1.FormKeyPress(Sender: TObject; var Key: Char);

begin

if Key = #13 then

begin

if n = 0 then

begin

Col := clRed;

n := 1;

end

else

begin

Col := clGreen;

n := 0;

end;

procedure TForm1.Timer1Timer(Sender: TObject);

begin

Repaint;

Canvas.Rectangle(x, y, x + w, y + h);

Canvas.Pen.Color := Col;

Canvas.Brush.Color := Col;

x := x + 3;

y := y + 3;

if (x + w > ClientWidth) or (y + w > ClientHeight) then

begin

Timer1.Enabled := False;

Timer2.Enabled := True;

end;

9. procedure TForm1.Timer2Timer(Sender: TObject);

begin

Repaint;

Canvas.Rectangle(x, y, x + w, y + h);

Canvas.Pen.Color := Col;

Canvas.Brush.Color := Col;

x := x - 3;

y := y - 3;

if (x <= 0) or (y <= 0) then

begin

Timer2.Enabled := False;

Timer1.Enabled := True;

end;end;end.

19.Методом трапеций вычислить

при n=10. Оценить результат.

procedure TForm1.Button1Click(Sender: TObject);

var

n,a,b,h,s,x:real;

begin

a:=0;

b:=1;

s:=0;

x:=a;

n:=strtofloat(edit1.text);

h:=(b-a)/n ;

repeat

s:=s+(1/(x+1))*h;

x:=x+h;

until x>b; //*<

edit2.Font.Color:=clnavy;

edit2.Text:=floattostr(s); //корень

end;end.

20.Составить программу для вывода на графический экран рисунка соцветия "колос". Число «кружков» предварительно запрашивать.

procedure TForm1.Button1Click(Sender: TObject);

var x,y,n,i:integer;

begin

n:=strtoint(edit1.text);

x:=form1.Width div 2; //определим положение середины канвы

y:=form1.Height div 4; //определим вершину стебля

with Form1.Canvas do

begin

Pen.Color:=clBlue; //зададим цвет

Moveto(x,y);

LineTo(x,y+300); //рисуем стебель

end;

y:=330; i:=0;

with Form1.Canvas do

begin

while i< n do

begin

x:=(form1.Width div 2)-30;

y:=y-25;

canvas.Brush.Color:=clBlack;

ellipse(x,y,x+20,y+20);

x:=(form1.Width div 2)+30;

ellipse(x,y,x-20,y-20);

i:=i+2;

end; end; end;end.

21.Дан числовой массив А(N). Из массива выбрать элементы не принадлежащие сегменту [m,k], где m,k- заданные целые числа, и сформировать из них новый массив.

var

Form1: TForm1;

a, b: array [1..50] of integer;

i,n,k,m,j: integer;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);

begin

Randomize;

Edit2.Clear;

n:=StrToInt(Edit1.Text);

For i:=1 to n do

begin

A[i]:=random(20)-10;

Edit2.Text:=Edit2.Text+ ' ' +IntToStr(A[i])+' ';

end;

procedure TForm1.Button2Click(Sender: TObject);

begin

Edit5.Clear;

m:=StrToInt(Edit3.Text);

k:=StrToInt(Edit4.Text);

j:=1;

For i:=1 to n do

if (a[i]< m) or (a[i]> k) then

begin

b[j]:=a[i];

j:=j+1;

end;

For i:=1 to j-1 do

Edit5.Text:=Edit5.Text+ ' ' +IntToStr(b[i])+' ';

end;end.

22.Дано число. Составить программу для нахождения количество цифр в числе.

procedure TForm1.Button1Click(Sender: TObject);

var k:integer;

n:longint;

begin

n:=strtoint(edit1.Text);

k:=0;

while n<>0 do

begin

k:=k+1;

n:=n div 10;

end;

edit2.Text:=inttostr(k);

end;end.

23.Отделить, и, методом хорд, уточнить корень уравнения x6+2x-1=0.

procedure TForm1.Button1Click(Sender: TObject);

var a,b,e,c,z,k,fa2,fc:real;

function f(t:real):real;

begin

f:=t*t*t*t*t*t+2*t-1;

end;

begin

a:=0;

b:=3;

k:=0;

e:=strtofloat(edit1.text);

fa2:=30*a*a*a*a+2 ;

If (f(a)*fa2)>0 then

begin c:=a; z:=b; end

else begin c:=b; z:=a; end;

repeat

fc:=c*c*c*c*c*c+2*c-1;

k:=k+1;

c:=c-((z-c)*f(c))/(f(z)-f(c));

until abs(fc)<e;

edit2.Text:=floattostr(k)+' '+floattostr(c);

end; end.

24.Создать файл из 100 целых чисел, Вывести его содержимое. Вывести содержимое файла из целых чисел, в обратном порядке расположения элементов.

procedure TForm1.Button1Click(Sender: TObject);

var

f,g: TextFile;

i: integer;

a:array [1..100] of integer;

begin

Memo1.text:=' ';

Memo2.text:=' ';

AssignFile(f,'I:\1.txt');

Rewrite(f);

For i:=1 to 100 do

begin

a[i]:=random(50);

Memo1.text:=memo1.Text+' '+inttostr(a[i]);

end;

writeln(f, memo1.text);

CloseFile(f);

for i:=100 downto 1 do

Memo2.text:=memo2.Text+' '+inttostr(a[i]);

end;

end.

8.Дан список студентов группы (фамилия, пробел, имя). Расположить список в алфавитном порядке имен.

procedure TForm1.Button1Click(Sender: TObject);

var a,b:array [1..10] of string;

i,j,n,k,f:integer;

x,xx:string;

begin

n:=3;

a[1]:='Ivanov Ivan';

a[2]:='Abramov Zaleriy';

a[3]:='Pershinov Vitaliy';

for k:=1 to 3 do

begin

f:=0; i:=1; b[k]:='';

while i<=length(a[k]) do

begin

if a[k][i]=' ' then f:=1;

if f=1 then b[k]:=b[k]+a[k][i];

i:=i+1;

end;

for i:=1 to n-1 do //пузырьковый м сорт.

for j:=1 to n-1 do

begin

if b[j]>b[j+1] then

begin

xx:=b[j];

b[j]:=b[j+1];

b[j+1]:=xx;

x:=a[j];

a[j]:=a[j+1];

a[j+1]:=x;

end;

for i:=1 to 3 do

memo1.Text:=memo1.Text+' '+ a[i]+chr(13)+chr(10);

end;

end.

15.Найдите приемлемый вид эмпирической функции и определите ее параметры, если известно:

3.2

4.3

5.4

8.3

9.0

1.4

11.7

13.5

procedure TForm1.Button1Click(Sender: TObject);

type point=record

xi,yi:real;

end;

var mas:array[1..8] of point;

i:integer;

Sx,Sy,Sxy,Sx2,k,a:real;

begin

mas[1].xi:=0 ;mas[1].yi:=3.2;

mas[2].xi:=1 ;mas[2].yi:=4.3;

mas[3].xi:=3 ;mas[3].yi:=5.4;

mas[4].xi:=6;mas[4].yi:=8.3;

mas[5].xi:=8;mas[5].yi:=9;

mas[6].xi:=10;mas[6].yi:=11.4;

mas[7].xi:=11;mas[7].yi:=11.7;

mas[8].xi:=13;mas[8].yi:=13.5;

for i:=1 to 8 do StringGrid1.Cells[i,1]:=floattostr(mas[i].xi);

for i:=1 to 8 do StringGrid1.Cells[i,2]:=floattostr(mas[i].yi);

Sx:=0;

Sy:=0;

Sxy:=0;

Sx2:=0;

for i:=1 to 8 do begin

Sx:=Sx+mas[i].xi;

Sy:=Sy+mas[i].yi;

Sxy:=Sxy+mas[i].xi * Mas[i].yi;

Sx2:=Sx2+mas[i].xi * Mas[i].xi;

end;

k:= (8*Sxy-Sx*Sy)/(8*Sx2-Sx*Sx);

a:= 0.125*(Sy-k*Sx);

edit1.Text:=floattostr(a);

edit2.text:=floattostr(k);

end;

end.

16.Методом наименьших квадратов подберите функцию вида y=c*xa для табличной функции:

2.45

3.70

5.70

8.55

11.25

12.95

17.15

procedure TForm1.Button1Click(Sender: TObject);

type point=record

xi,yi:real;

end;

var mas:array[1..8] of point;

i:integer;

Sx,Sy,Sxy,Sx2,k,a:real;

begin

mas[1].xi:=2 ;mas[1].yi:=2.45;

mas[2].xi:=4 ;mas[2].yi:=3.70;

mas[3].xi:=8 ;mas[3].yi:=5.70;

mas[4].xi:=16;mas[4].yi:=8.55;

mas[5].xi:=25;mas[5].yi:=11.25;

mas[6].xi:=32;mas[6].yi:=12.95;

mas[7].xi:=50;mas[7].yi:=17.15;

for i:=1 to 7 do StringGrid1.Cells[i,1]:=floattostr(mas[i].xi);

for i:=1 to 7 do StringGrid1.Cells[i,2]:=floattostr(mas[i].yi);

Sx:=0;

Sy:=0;

Sxy:=0;

Sx2:=0;

for i:=1 to 7 do begin

Sx:=Sx+ln(mas[i].xi);

Sy:=Sy+ln (mas[i].yi);

Sxy:=Sxy+(ln(mas[i].xi) * (ln(Mas[i].yi)));

Sx2:=Sx2+ln(mas[i].xi) * ln(Mas[i].xi);

end;

k:= (7*Sxy-Sx*Sy)/(7*Sx2-Sx*Sx);

a:= exp(0.1428571*(Sy-k*Sx));

edit1.Text:=floattostr(a);

edit2.text:=floattostr(k);

end;

end.

25.Создать файл типа TEXT. Вывести его содержимое на экран в виде "бегущей строки".

procedure TForm1.Timer1Timer(Sender: TObject);

Var s : String;

begin

s := Label1.Caption; //2 shag

//s := s + s[1];

Label1.Caption := copy(s, 2, length(s) - 1);

end;

procedure TForm1.FormCreate(Sender: TObject); //1 shag

var t:textfile;

st:string;

begin

assignfile (t,'e:\f.txt');

reset(t);

while not eof(t) do

begin

readln(t,st);

Label1.Caption:=Label1.Caption+ st ;

end;

closefile(t);

end;

end.