Студопедия
Случайная страница | ТОМ-1 | ТОМ-2 | ТОМ-3
АвтомобилиАстрономияБиологияГеографияДом и садДругие языкиДругоеИнформатика
ИсторияКультураЛитератураЛогикаМатематикаМедицинаМеталлургияМеханика
ОбразованиеОхрана трудаПедагогикаПолитикаПравоПсихологияРелигияРиторика
СоциологияСпортСтроительствоТехнологияТуризмФизикаФилософияФинансы
ХимияЧерчениеЭкологияЭкономикаЭлектроника

Научный калькулятор

Читайте также:
  1. Калькулятор.
  2. Научный консультант серии Е.Л. Михайлова 1 страница
  3. Научный консультант серии Е.Л. Михайлова 10 страница
  4. Научный консультант серии Е.Л. Михайлова 11 страница
  5. Научный консультант серии Е.Л. Михайлова 2 страница
  6. Научный консультант серии Е.Л. Михайлова 3 страница

 

Интерфейс:

 

Код программы:

 

unit Unit5;

 

interface

 

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls, Menus, ExtCtrls, Grids, XPMan;

 

type

TForm5 = class(TForm)

Button1: TButton;

Button2: TButton;

Button3: TButton;

Button4: TButton;

Button5: TButton;

Button6: TButton;

Button7: TButton;

Button8: TButton;

Button9: TButton;

Button10: TButton;

Button11: TButton;

Button12: TButton;

Button13: TButton;

Button14: TButton;

Edit1: TEdit;

Button15: TButton;

Button16: TButton;

Button17: TButton;

Button20: TButton;

Button21: TButton;

Button22: TButton;

Button23: TButton;

Button24: TButton;

Button25: TButton;

Button26: TButton;

Button27: TButton;

Button28: TButton;

Button29: TButton;

 

procedure Button1Click(Sender: TObject);

procedure Button2Click(Sender: TObject);

procedure Button3Click(Sender: TObject);

procedure Button4Click(Sender: TObject);

procedure Button5Click(Sender: TObject);

procedure Button6Click(Sender: TObject);

procedure Button7Click(Sender: TObject);

procedure Button8Click(Sender: TObject);

procedure Button9Click(Sender: TObject);

procedure Button10Click(Sender: TObject);

procedure Button11Click(Sender: TObject);

procedure Button13Click(Sender: TObject);

procedure Button14Click(Sender: TObject);

procedure Button15Click(Sender: TObject);

procedure Button16Click(Sender: TObject);

procedure Button12Click(Sender: TObject);

procedure Button17Click(Sender: TObject);

procedure N21Click(Sender: TObject);

procedure N31Click(Sender: TObject);

procedure N41Click(Sender: TObject);

procedure N61Click(Sender: TObject);

procedure N2101Click(Sender: TObject);

procedure N1081Click(Sender: TObject);

procedure N16101Click(Sender: TObject);

procedure N32101Click(Sender: TObject);

procedure Button18Click(Sender: TObject);

procedure Button20Click(Sender: TObject);

procedure Button21Click(Sender: TObject);

procedure Button22Click(Sender: TObject);

procedure Button23Click(Sender: TObject);

procedure Button24Click(Sender: TObject);

procedure Button25Click(Sender: TObject);

procedure Button26Click(Sender: TObject);

procedure Button27Click(Sender: TObject);

procedure Button28Click(Sender: TObject);

procedure Button29Click(Sender: TObject);

 

 

private

{ Private declarations }

public

{ Public declarations }

end;

type

Tmass=array of Real;

Tmatrix=array of Tmass;

var

Form5: TForm5;

num1,num2:real;

doit:string;

n:integer;

 

implementation

 

{$R *.dfm}

//Ну тут комментировать особенно нечего. Просто задаем команды каждой кнопке

//И отправляем ее в Edit1

procedure TForm5.Button10Click(Sender: TObject);

begin

Edit1.Text:=Edit1.Text+floattostr(0);

end;

 

procedure TForm5.Button11Click(Sender: TObject);

begin

Edit1.Clear;

num1:=0;

num2:=0;

doit:='';

end;

 

procedure TForm5.Button1Click(Sender: TObject);

begin

Edit1.Text:=Edit1.Text+floattostr(1);

end;

 

procedure TForm5.Button20Click(Sender: TObject);

begin

num1:=strtofloat(Edit1.Text);

Edit1.Text:=floattostr(ln(num1));

end;

 

procedure TForm5.Button21Click(Sender: TObject);

begin

num1:=strtofloat(Edit1.Text);

Edit1.Text:=floattostr(cos(num1));

end;

 

procedure TForm5.Button22Click(Sender: TObject);

begin

num1:=strtofloat(Edit1.Text);

Edit1.Text:=floattostr(sin(num1));

end;

 

procedure TForm5.Button23Click(Sender: TObject);

begin

num1:=strtofloat(Edit1.Text);

Edit1.Text:=floattostr(sin(num1)/cos(num1));

end;

 

procedure TForm5.Button24Click(Sender: TObject);

begin

num1:=strtofloat(Edit1.Text);

Edit1.Text:=floattostr(cos(num1)/sin(num1));

end;

 

procedure TForm5.Button25Click(Sender: TObject);

begin

num1:=strtofloat(Edit1.Text);

Edit1.Text:=floattostr(exp(num1*ln(num1)));

end;

 

procedure TForm5.Button2Click(Sender: TObject);

begin

Edit1.Text:=Edit1.Text+floattostr(2);

end;

 

procedure TForm5.Button3Click(Sender: TObject);

begin

Edit1.Text:=Edit1.Text+floattostr(3);

end;

procedure TForm5.Button4Click(Sender: TObject);

begin

Edit1.Text:=Edit1.Text+floattostr(4);

end;

 

procedure TForm5.Button5Click(Sender: TObject);

begin

Edit1.Text:=Edit1.Text+floattostr(5);

end;

 

procedure TForm5.Button6Click(Sender: TObject);

begin

Edit1.Text:=Edit1.Text+floattostr(6);

end;

 

procedure TForm5.Button7Click(Sender: TObject);

begin

Edit1.Text:=Edit1.Text+floattostr(7);

end;

 

procedure TForm5.Button8Click(Sender: TObject);

begin

Edit1.Text:=Edit1.Text+floattostr(8);

end;

 

procedure TForm5.Button9Click(Sender: TObject);

begin

Edit1.Text:=Edit1.Text+floattostr(9);

end;

 

procedure TForm5.Button13Click(Sender: TObject);

begin

num1:=strtofloat(Edit1.Text);

doit:='плюс';

Edit1.Clear;

 

end;

 

procedure TForm5.Button14Click(Sender: TObject);

begin

num1:=strtofloat(Edit1.Text);

doit:='минус';

Edit1.Clear;

end;

 

procedure TForm5.Button15Click(Sender: TObject);

begin

num1:=strtofloat(Edit1.Text);

doit:='умножить';

Edit1.Clear;

end;

 

procedure TForm5.Button16Click(Sender: TObject);

begin

num1:=strtofloat(Edit1.Text);

doit:='разделить';

Edit1.Clear;

end;

 

procedure TForm5.Button12Click(Sender: TObject);

begin

num2:=strtofloat(Edit1.Text);

if doit='плюс'

then Edit1.Text:=floattostr(num1+num2);

if doit='минус'

then Edit1.Text:=floattostr(num1-num2);

if doit='умножить'

then Edit1.Text:=floattostr(num1*num2);

if doit='разделить'

then if num2=0 then begin

MessageDlg('На ноль делить нельзя!!!',mtInformation,[mbok],0);end else

Edit1.Text:=floattostr(num1/num2);

if doit='степень'

then Edit1.Text:=floattostr(exp(num2*ln(num1)));

if doit='логарифм'

then Edit1.Text:=floattostr(ln(num1)/ln(num2));

num1:=0;

num2:=0;

doit:='';

end;

 

procedure TForm5.Button17Click(Sender: TObject);

begin

 

Edit1.Text:=Edit1.Text+',';

 

end;

 

procedure TForm5.Button18Click(Sender: TObject);

begin

num1:=strtofloat(Edit1.Text);

if num1<0 then begin MessageDlg('Под знаком корня не может быть отрицательное число!!!',mtInformation,[mbok],0);end

else Edit1.Text:=floattostr(sqrt(num1));

end;

 

procedure TForm5.N21Click(Sender: TObject);

var

b:array[1..20] of integer;

o,p,j,t:integer;

s:string;

begin

p:=strtoint(edit1.Text);

t:=2;

 

o:=0;

while p<>0 do begin

o:=o+1;

b[o]:=p mod t;

p:=p div t;

end;

s:='';

for j:=o downto 1 do

s:=s+chr(b[j]+48+round(b[j]/19)*7);

 

edit1.Text:=s;

 

end;

 

procedure TForm5.N31Click(Sender: TObject);

var

b1:array[1..20] of integer;

o1,p1,j1,t1:integer;

s1:string;

begin

p1:=strtoint(edit1.Text);

t1:=8;

 

o1:=0;

while p1<>0 do begin

o1:=o1+1;

b1[o1]:=p1 mod t1;

p1:=p1 div t1;

end;

s1:='';

for j1:=o1 downto 1 do

s1:=s1+chr(b1[j1]+48+round(b1[j1]/19)*7);

 

edit1.Text:=s1;

end;

 

procedure TForm5.N41Click(Sender: TObject);

var

b2:array[1..20] of integer;

o2,p2,j2,t2:integer;

s2:string;

begin

p2:=strtoint(edit1.Text);

t2:=16;

 

o2:=0;

while p2<>0 do begin

o2:=o2+1;

b2[o2]:=p2 mod t2;

p2:=p2 div t2;

end;

s2:='';

for j2:=o2 downto 1 do

s2:=s2+chr(b2[j2]+48+round(b2[j2]/19)*7);

 

edit1.Text:=s2;

end;

 

procedure TForm5.N61Click(Sender: TObject);

var

b3:array[1..20] of integer;

o3,p3,j3,t3:integer;

s3:string;

begin

p3:=strtoint(edit1.Text);

t3:=32;

 

o3:=0;

while p3<>0 do begin

o3:=o3+1;

b3[o3]:=p3 mod t3;

p3:=p3 div t3;

end;

s3:='';

for j3:=o3 downto 1 do

s3:=s3+chr(b3[j3]+48+round(b3[j3]/19)*7);

 

edit1.Text:=s3;

end;

 

procedure TForm5.N2101Click(Sender: TObject);

var

a4:array[1..20]of integer;

i4,j4,r4:integer;

s4,m4:real;

k4:string;

begin

k4:=edit1.text;

r4:=2;

 

s4:=0;

for i4:=length(k4) downto 1 do begin

j4:=ord(k4[i4]);

s4:=s4+(j4-48-round((j4-48)/19)*7)*exp((length(k4)-i4)*ln(r4));

end;

edit1.Text:=floattostr(s4);

 

end;

 

procedure TForm5.N1081Click(Sender: TObject);

var

a5:array[1..20]of integer;

i5,j5,r5:integer;

s5,m5:real;

k5:string;

begin

k5:=edit1.text;

r5:=8;

 

s5:=0;

for i5:=length(k5) downto 1 do begin

j5:=ord(k5[i5]);

s5:=s5+(j5-48-round((j5-48)/19)*7)*exp((length(k5)-i5)*ln(r5));

end;

edit1.Text:=floattostr(s5);

end;

 

procedure TForm5.N16101Click(Sender: TObject);

var

a6:array[1..20]of integer;

i6,j6,r6:integer;

s6,m6:real;

k6:string;

begin

k6:=edit1.text;

r6:=16;

 

s6:=0;

for i6:=length(k6) downto 1 do begin

j6:=ord(k6[i6]);

s6:=s6+(j6-48-round((j6-48)/19)*7)*exp((length(k6)-i6)*ln(r6));

end;

edit1.Text:=floattostr(s6);

end;

 

procedure TForm5.N32101Click(Sender: TObject);

var

a7:array[1..20]of integer;

i7,j7,r7:integer;

s7,m7:real;

k7:string;

begin

k7:=edit1.text;

r7:=32;

 

s7:=0;

for i7:=length(k7) downto 1 do begin

j7:=ord(k7[i7]);

s7:=s7+(j7-48-round((j7-48)/19)*7)*exp((length(k7)-i7)*ln(r7));

end;

edit1.Text:=floattostr(s7);

end;

 

procedure TForm5.Button26Click(Sender: TObject);

begin

num1:=strtofloat(Edit1.Text);

doit:='степень';

Edit1.Clear;

 

end;

 

procedure TForm5.Button27Click(Sender: TObject);

begin

num1:=strtofloat(Edit1.Text);

Edit1.Text:=floattostr(ln(num1)/ln(10));

end;

 

procedure TForm5.Button28Click(Sender: TObject);

begin

num1:=strtofloat(Edit1.Text);

if num1=0 then begin MessageDlg('На ноль делить нельзя!!!',mtInformation,[mbok],0);end

else Edit1.Text:=floattostr(1/num1);

end;

 

procedure TForm5.Button29Click(Sender: TObject);

begin

num1:=strtofloat(Edit1.Text);

doit:='логарифм';

Edit1.Clear;

end;

 

end.

 

 

4) Обработка массивов

Интерфейс:

 

Код программы:

 

Unit Unit8;

 

interface

 

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

StdCtrls, Grids, Menus, Buttons, ComCtrls;

 

type

TForm8 = class(TForm)

grdMatrix: TStringGrid;

txtRazmer: TEdit;

Label1: TLabel;

grdVector: TStringGrid;

grdX: TStringGrid;

BitBtn1..3: TBitBtn;

UpDown1: TUpDown;

Label1..6: TLabel;

procedure txtRazmerKeyPress(Sender: TObject; var Key: Char);

procedure txtRazmerExit(Sender: TObject);

procedure mnuExitClick(Sender: TObject);

procedure mnuMatrixClearClick(Sender: TObject);

procedure mnuMatrixFillClick(Sender: TObject);

procedure mnuMatrixCalcClick(Sender: TObject);

procedure grdMatrixSelectCell(Sender: TObject; ACol, ARow: Integer;

var CanSelect: Boolean);

 

private

{ Private declarations }

public

{ Public declarations }

end;

 

var

Form8: TForm8;

 

procedure TForm8.txtRazmerKeyPress(Sender: TObject; var Key: Char); // работа с TEdit (ранг матрицы) //

var

n,i,j:integer;

begin

if key<>#13 then exit;

txtRazmerExit(Sender);

end;

 

procedure TForm8.txtRazmerExit(Sender: TObject); // процедура ввода ранга матрицы,связывание её со StringGrid (матрица А и И)//

var

n,i,j:integer;

begin

n:= StrToInt(txtRazmer.text);

if (n<1) or (n>10000) then

begin

application.MessageBox('Неправильный Размер','Ошибка',48);

txtRazmer.SetFocus;

exit;

end;

grdMatrix.ColCount:=n+1;

grdMatrix.RowCount:=n+1;

grdX.RowCount:=n+1;

grdVector.RowCount:=n+1;

 

grdVector.Cols[0][0]:='b';

grdX.Cols[0][0]:='X';

 

for i:=1 to n do

begin

grdMatrix.Cols[i][0]:=IntToStr(i);

grdMatrix.Rows[i][0]:= IntToStr(i);

end;

 

for i:= 1 to n do

for j:= 1 to n do

If grdMatrix.Rows[i][j]='' then grdMatrix.Rows[i][j]:='0';

 

for i:=1 to n do

begin

If grdVector.Rows[i][0]='' then grdVector.Rows[i][0]:='0';

grdX.Rows[i][0]:='';

end;

end;

 

procedure TForm8.mnuExitClick(Sender: TObject);

begin

if Application.MessageBox('Завершить Работу Программы?','Выход',

32+MB_YESNO+MB_DEFBUTTON2) = IDYES

then halt;

end;

 

procedure TForm8.mnuMatrixClearClick(Sender: TObject);

var n,i,j:integer;

begin

n:= StrToInt(txtRazmer.text);

if (n<1) or (n>100000) then

begin

application.MessageBox('Неправильный Размер','Ошибка',48);

txtRazmer.SetFocus;

exit;

end;

grdMatrix.ColCount:=n+1;

grdMatrix.RowCount:=n+1;

grdX.RowCount:=n+1;

grdVector.RowCount:=n+1;

 

 

for i:=1 to n do

begin

grdMatrix.Cols[i][0]:=IntToStr(i);

grdMatrix.Rows[i][0]:= IntToStr(i);

end;

 

for i:= 1 to n do

for j:= 1 to n do

grdMatrix.Rows[i][j]:='0';

for i:=1 to n do

begin

grdVector.Rows[i][0]:='0';

grdX.Rows[i][0]:='';

end;

end;

 

procedure TForm8.mnuMatrixFillClick(Sender: TObject);

var n,i,j:integer;

begin

n:= StrToInt(txtRazmer.text);

if (n<1) or (n>10000) then

begin

application.MessageBox('Неправильный Размер','Ошибка',48);

txtRazmer.SetFocus;

exit;

end;

 

grdMatrix.ColCount:=n+1;

grdMatrix.RowCount:=n+1;

grdX.RowCount:=n+1;

grdVector.RowCount:=n+1;

 

for i:=1 to n do

begin

grdMatrix.Cols[i][0]:=IntToStr(i);

grdMatrix.Rows[i][0]:= IntToStr(i);

end;

 

for i:= 1 to n do

for j:= 1 to n do

grdMatrix.Rows[i][j]:=IntToStr(-10+Random(20));

 

for i:=1 to n do

begin

grdVector.Rows[i][0]:=IntToStr(-10+Random(20));

grdX.Rows[i][0]:='';

end;

end;

procedure TForm8.mnuMatrixCalcClick(Sender: TObject); // заполнение стринг грида рандомными числами черзе массив)//

var n,i,j,k,imax:integer;

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

ai:array[1..100] of real;

x:array[1..100] of real;

koef,max,sum,s,m:real;

begin

n:=grdMatrix.ColCount-1;

for i:= 1 to n do

begin // решение уравнения //

for j:= 1 to n do

a[i][j]:= StrToFloat(grdMatrix.Rows[i][j]);

a[i][n+1]:=StrToFloat(grdVector.Rows[i][0]);

grdX.Rows[i][0]:='';

end;

 

for i:=1 to n-1 do

begin

max:=abs(a[i][i]);

imax:=i;

for j:= i+1 to n do

if abs(a[j][i])>max then

begin

max:=abs(a[j][i]);

imax:= j;

end;

if i<>imax then

begin

for j:= i to n+1 do

begin

max:=a[i][j];

a[i][j]:=a[imax][j];

a[imax][j]:=max;

end

end;

 

if abs(a[i][i])<1e-10 then

begin

application.MessageBox('Деление на ноль','Ошибка!',16);

exit;

end;

 

for j:=1 to n+1 do ai[j]:=a[i][j]/a[i][i];

for k:=i+1 to n do

begin

koef:=a[k][i];

for j:=1 to n+1 do

a[k][j]:=a[k][j]-ai[j]*koef;

end;

end;

 

for i:= n downto 1 do

begin

sum:=0;

for j:= i+1 to n do

sum:=sum+a[i][j]*x[j];

for i:= 1 to n do

grdX.Rows[i][0]:=FloatToStrF(x[i],ffGeneral,7,4);

 

 

procedure TForm8.grdMatrixSelectCell(Sender: TObject; ACol, ARow: Integer;

var CanSelect: Boolean);

begin

grdVector.Row:=Arow;

grdX.Row:=Arow;

end

end.

 

 

Записная книжка

Интерфейс:

 

unit Unit9;

 

interface

 

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, ComCtrls, ToolWin, StdCtrls, ExtCtrls, MPlayer, Menus, TabNotBk,

Grids;

 

type

TForm9 = class(TForm)

bu: TPageControl;

TabSheet 1-31: TTabSheet;

 

StringGrid 1-31: TStringGrid;

 

Button 1-92: TButton;

 

procedure N4Click(Sender: TObject);

 

procedure Button 1-31Click(Sender: TObject);

 

procedure StringGrid 1-31Click(Sender: TObject);

 

procedure Button 1-92Click(Sender: TObject);

 

private

{ Private declarations }

public

{ Public declarations }

end;

 

var

st:systemtime;

Form9: TForm9;

 

implementation

 

{$R *.dfm}

 

//Сохраняем записи

procedure SaveStringGrid(StringGrid: TStringGrid; const FileName: TFileName);

var

f: TextFile;

i, k: Integer;

begin

AssignFile(f, FileName);

Rewrite(f);

with StringGrid do

begin

//прописывает цисло колон и столбцов

Writeln(f, ColCount);

Writeln(f, RowCount);

//сканирует ячейки

for i:= 0 to ColCount - 1 do

for k:= 0 to RowCount - 1 do

Writeln(F, Cells[i, k]);

end;

CloseFile(F);

end;

//Загружает записи из файлов

procedure LoadStringGrid(StringGrid: TStringGrid; const FileName: TFileName);

var

f: TextFile;

iTmp, i, k: Integer;

strTemp: String;

begin

AssignFile(f, FileName);

Reset(f);

with StringGrid do

begin

//Считывает число столбцов и строк

Readln(f, iTmp);

ColCount:= iTmp;

Readln(f, iTmp);

RowCount:= iTmp;

//сканирует и заполняет ячейки

for i:= 0 to ColCount - 1 do

for k:= 0 to RowCount-1 do

begin

Readln(f, strTemp);

Cells[i, k]:= strTemp;

end;

end;

CloseFile(f);

end;

 

//В этих процедурах прописано добавление новой записи

procedure TForm9.Button10Click(Sender: TObject);

begin

StringGrid8.RowCount:= StringGrid8.RowCount + 1

end;

.

.

.

procedure TForm9.Button29Click(Sender: TObject);

begin

StringGrid27.RowCount:= StringGrid27.RowCount + 1

end;

 

 

procedure TForm9.Button2Click(Sender: TObject);

begin

SaveStringGrid(StringGrid2, 'A.txt');

end;

.

.

.

procedure TForm9.Button62Click(Sender: TObject);

begin

SaveStringGrid(StringGrid29, 'Я.txt');

end;

//обращение к процедуре считываения файла

 

 

procedure TForm9.Button64Click(Sender: TObject);

begin

LoadStringGrid(StringGrid1, 'А.txt');

end;

.

.

.

procedure TForm9.Button92Click(Sender: TObject);

begin

LoadStringGrid(StringGrid31, 'Я.txt');

end;

 

procedure TForm9.Button9Click(Sender: TObject);

begin

StringGrid7.RowCount:= StringGrid7.RowCount + 1

end;

 

procedure TForm9.N4Click(Sender: TObject);

begin

Form9.close;

end;

 

//заполнения шапки листа

 

procedure TForm9.StringGrid10Click(Sender: TObject);

begin

Stringgrid10.Cells[0,0]:='ФИО';

Stringgrid10.Cells[1,0]:='Профессия';

Stringgrid10.Cells[2,0]:='Адрес';

Stringgrid10.Cells[3,0]:='Телефон';

Stringgrid10.Cells[4,0]:='Почта';

 

end;

end.

 

 

6) Типовой расчёт №1 по Мат. Анализу

 

Интерфейс:

 

 

Код программ:

 

unit Unit7;

 

interface

 

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls, Menus;

 

type

TForm16 = class(TForm);

TForm15= class(TForm);

TForm14 = class(TForm);

TForm13 = class(TForm);

TForm12 = class(TForm);

TForm11 = class(TForm);

Button1: TButton;

Button2: TButton;

Button3: TButton;

Button4: TButton;

Button5: TButton;

Label1: TLabel;

MainMenu1: TMainMenu;

N1: TMenuItem;

N11: TMenuItem;

N21: TMenuItem;

N31: TMenuItem;

N41: TMenuItem;

N51: TMenuItem;

procedure Button1Click(Sender: TObject);

procedure Button2Click(Sender: TObject);

procedure Button3Click(Sender: TObject);

procedure Button4Click(Sender: TObject);

procedure Button5Click(Sender: TObject);

procedure N11Click(Sender: TObject);

procedure N21Click(Sender: TObject);

procedure N31Click(Sender: TObject);

procedure N41Click(Sender: TObject);

procedure N51Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

 

var

Form16: TForm16;

Form15: TForm15;

Form14: TForm14;

Form13: TForm13;

Form12: TForm12;

Form11: TForm11;

 

 

Implementation

 

procedure TForm16.Button1Click(Sender: TObject);

begin

Form10.Visible:=true

end;

 

procedure TForm16.Button2Click(Sender: TObject);

begin

Form11.Visible:=true

end;

 

procedure TForm16.Button3Click(Sender: TObject);

begin

Form13.Visible:=true

end;

 

procedure TForm16.Button4Click(Sender: TObject);

begin

Form14.Visible:=true

end;

 

procedure TForm16.Button5Click(Sender: TObject);

begin

Form15.Visible:=true

end;

 

procedure TForm16.N11Click(Sender: TObject);

begin

Form10.Visible:=true

end;

procedure TForm16.N21Click(Sender: TObject);

begin

Form11.Visible:=true

end;

procedure TForm16.N31Click(Sender: TObject);

begin

Form13.Visible:=true

end;

 

procedure TForm16.N41Click(Sender: TObject);

begin

Form14.Visible:=true

end;

procedure TForm16.N51Click(Sender: TObject);

begin

Form15.Visible:=true

end;

 

end.

 

\\\\задача 1

 

unit Unit10;

 

interface

 

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls;

 

type

TForm10 = class(TForm)

Label1: TLabel;

Label2: TLabel;

Label3: TLabel;

Edit1: TEdit;

Edit2: TEdit;

Edit3: TEdit;

Button1: TButton;

procedure Button1Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

 

var

Form10: TForm10;

 

implementation

 

{$R *.dfm}

 

procedure TForm10.Button1Click(Sender: TObject);

var

a,b,c,d:real;

begin

a:=(2/3)*sqrt(64);

b:=(2/3)*sqrt((strtoint(edit1.Text)+4)*(strtoint(edit1.Text)+4)*(strtoint(edit1.Text)+4));

c:=2*(strtoint(edit2.Text))-(2/3)*(strtoint(edit2.Text))*sqrt(strtoint(edit2.Text));

d:=0;

edit3.Text:=Floattostr(a-b+c-d);

end;

 

end.

 

\\\\Задача 2

 

unit Unit11;

 

interface

 

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls;

 

type

TForm11 = class(TForm)

Label1: TLabel;

Label2: TLabel;

Label3: TLabel;

Label4: TLabel;

Edit1: TEdit;

Edit2: TEdit;

Button1: TButton;

Edit3: TEdit;

procedure Button1Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

 

var

Form11: TForm11;

 

implementation

 

{$R *.dfm}

 

procedure TForm11.Button1Click(Sender: TObject);

var a,b:real;

begin

a:=pi*(25*ln(strtoint(edit1.Text)+1)-(1/2)*(strtoint(edit1.Text)+1)*(strtoint(edit1.Text)+1)+2*(strtoint(edit1.Text)+1)-ln(strtoint(edit1.Text)+1));

b:=pi*(25*ln(strtoint(edit2.Text)+1)-(1/2)*(strtoint(edit2.Text)+1)*(strtoint(edit2.Text)+1)+2*(strtoint(edit2.Text)+1)-ln(strtoint(edit2.Text)+1));

edit3.Text:=floattostr(a-b);

end;

 

end.

 

 

\\\\ Задача 3

unit Unit13;

 

interface

 

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls;

 

type

TForm13 = class(TForm)

Label1: TLabel;

Label2: TLabel;

Label3: TLabel;

Edit1: TEdit;

Edit2: TEdit;

Label4: TLabel;

Edit3: TEdit;

Edit4: TEdit;

Button1: TButton;

Edit5: TEdit;

procedure Button1Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

 

var

Form13: TForm13;

 

implementation

 

{$R *.dfm}

 

procedure TForm13.Button1Click(Sender: TObject);

var a,b,c,d:real;

begin

a:=(3/2)*(strtofloat(edit1.Text))+2*sin(strtofloat(edit1.Text))+(1/4)*sin(2*strtofloat(edit1.Text));

b:= (3/2)*(strtofloat(edit2.Text))+2*sin(strtofloat(edit2.Text))+(1/4)*sin(2*strtofloat(edit2.Text));

c:=(1/2)*(strtofloat(edit3.Text)+(1/2)*sin(2*strtofloat(edit3.text)));

d:=(1/2)*(strtofloat(edit4.Text)+(1/2)*sin(2*strtofloat(edit4.text)));

edit5.Text:=floattostr(a-b+c-d);

end;

 

end.

 

 

\\\\\\\\ Задача 4

 

 

unit Unit14;

 

interface

 

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls;

 

type

TForm14 = class(TForm)

Label1: TLabel;

Label2: TLabel;

Label3: TLabel;

Edit1: TEdit;

Edit2: TEdit;

Button1: TButton;

Edit3: TEdit;

procedure Button1Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

 

var

Form14: TForm14;

 

implementation

 

{$R *.dfm}

 

procedure TForm14.Button1Click(Sender: TObject);

var a,b:real;

begin

a:=(sin(2*strtofloat(edit1.Text))/cos(2*strtofloat(edit1.Text)))-strtofloat(edit1.Text);

b:= (sin(2*strtofloat(edit2.Text))/cos(2*strtofloat(edit2.Text)))-strtofloat(edit2.Text);

edit3.text:=floattostr(a-b);

end;

 

end.

 

 

\\\\\ Задача 5

 

unit Unit15;

 

interface

 

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls;

 

type

TForm15 = class(TForm)

Label1: TLabel;

Label2: TLabel;

Label3: TLabel;

Edit1: TEdit;

Edit2: TEdit;

Button1: TButton;

Edit3: TEdit;

procedure Button1Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

 

var

Form15: TForm15;

 

implementation

 

{$R *.dfm}

 

procedure TForm15.Button1Click(Sender: TObject);

var a,b:real;

begin

a:=2*pi*(strtofloat(edit1.Text)/2*sqrt(strtofloat(edit1.Text)*strtofloat(edit1.Text)+4)+2*ln(strtofloat(edit1.Text)+sqrt(strtofloat(edit1.Text)*strtofloat(edit1.Text)+4)));

b:=2*pi*(strtofloat(edit2.Text)/2*sqrt(strtofloat(edit2.Text)*strtofloat(edit2.Text)+4)+2*ln(strtofloat(edit2.Text)+sqrt(strtofloat(edit2.Text)*strtofloat(edit2.Text)+4)));

edit3.Text:=floattostr(a-b);

end;

 

end.

 

7) Игра «Собери картинку»

Интерфейс:

 

 

Код программы:

 

unit soberi_;

 

interface

 

uses

Windows, Messages, SysUtils, Variants, Classes,

Graphics, Controls, Forms, Dialogs;

 

type

TForm1 = class(TForm)

procedure FormCreate(Sender: TObject);

procedure FormMouseDown(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

procedure FormPaint(Sender: TObject);

 

// эти объявления вставлены сюда вручную

procedure ShowPole;

procedure Mixer;

procedure NewGame;

 

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

 

implementation

const

H = 4; W = 4; // размер поля - 4х4

var

 

wc,hc: integer; // ширина и высота клетки

 

// игровое поле

pole: array[1..H, 1..W] of byte;

ex,ey: integer; // координаты пустой клетки

 

// правильное расположение клеток

stp: array[1..H, 1..W] of byte =

((1, 2, 3, 4),

(5, 6, 7, 8),

(9,10,11,12),

(13,14,15, 0));

 

pic: TBitmap; // картинка

 

// новая игра

procedure TForm1.NewGame;

var

fname: string[20]; // файл картинки

i,j: integer;

begin

{ сюда можно вставить инструкции,

обеспечивающие, например, случайный

выбор загружаемой картинки }

 

fname:= 'pic_1.bmp';

try

pic.LoadFromFile(fname);

except

on EFopenError do

begin

ShowMessage('Ошибка обращения к файлу ' + fname);

Form1.Close;

end;

end;

// Установить размер формы равный

// равный размеру картинки.

 

// размер клетки

hc:= Pic.Height div H;

wc:= Pic.Width div W;

 

// размер формы

ClientWidth:= wc * W;

ClientHeight:= hc * H;

 

// исходное (правильное) положение

for i:=1 to H do

for j:=1 to W do

pole[i,j]:= stp[i,j];

Form1.Mixer; // перемешать фишки

Form1.ShowPole; // отобразить поле

end;

 

// проверяет, расположены ли

// клетки (фрагменты картинки) в нужном порядке

function Finish: boolean;

var

row,col: integer;

i: integer;

begin

row:=1; col:=1;

Finish:= True; // пусть фишки в нужном порядке

for i:=1 to 15 do

begin

if pole[row,col] <> i then

begin

Finish:= False;

break;

end;

// к следующей клетке

if col < 4

then inc(col)

else begin

col:=1;

inc(row);

end;

end;

end;

 

 

// "перемещает" фишку в соседнюю пустую клетку,

// если она есть, конечно

procedure Move(cx,cy: integer);

// cx,cy - клетка, в которой игрок сделал щелчок

var

r: integer; // выбор игрока

begin

// проверим, возможен ли обмен

if not ((abs(cx-ex) = 1) and (cy-ey = 0) or

(abs(cy-ey) = 1) and (cx-ex = 0))

then exit;

// Обмен. Переместим фишку из x,y в ex,ey

Pole[ey,ex]:= Pole[cy,cx];

Pole[cy,cx]:= 0;

ex:=cx;

ey:=cy;

// отрисовать поле

Form1.ShowPole;

if Finish then

begin

pole[4,4]:= 16;

Form1.ShowPole;

r:= MessageDlg('Цель достигнута!'+ #13+

'Еще раз?',mtInformation,[mbYes,mbNo],0);

if r = mrNo then Form1.Close; // завершить работу программы

Form1.NewGame;

end;

end;

 

// щелчок в клетке

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer);

var

cx,cy: integer; // координаты клетки

begin

// преобразуем мыши в координаты клетки

cx:= Trunc(X / wc) + 1;

cy:= Trunc(Y / hc) + 1;

Move(cx,cy);

end;

 

// выводит игровое поле

procedure TForm1.ShowPole;

var

Source, Dest: Trect; // области: источник и приемник

sx,sy: integer; // левый верхний угол области источника

i,j: integer;

 

begin

 

// содержимое клеток

for i:= 1 to W do

for j:= 1 to H do

begin

// преобразуем номер картинки

// в координаты левого верхнего

// угла области источника

sy:= ((pole[i,j] -1) div W) * hc;

sx:= ((pole[i,j] -1) mod W) * wc;

 

Source:= Bounds(sx,sy,wc,hc);

Dest:= Bounds((j-1)*wc,(i-1)*hc,wc,hc);

if pole[i,j] <> 0

then Canvas.CopyRect(Dest,pic.Canvas,Source)

else Canvas.Rectangle((j-1)*wc,(i-1)*hc,j*wc,i*hc);

end;

end;

 

// "перемешивает" фишки

procedure TForm1.Mixer;

var

x1,y1: integer; // пустая клетка

x2,y2: integer; // эту переместить в пустую

d: integer; // направление, относительно пустой

i: integer;

begin

x1:=4; y1:=4; // см. описание массива stp

randomize;

for i:= 1 to 150 do // кол-во перестановок

begin

repeat

x2:=x1;

y2:=y1;

d:=random(4)+1;

case d of

1: dec(x2);

2: inc(x2);

3: dec(y2);

4: inc(y2);

end;

until (x2>=1) and (x2<=4) and (y2>=1) and (y2<=4);

// здесь определили фишку, которую

// надо переместить в пустую клетку

Pole[y1,x1]:= Pole[y2,x2];

Pole[y2,x2]:= 0;

x1:=x2;

y1:=y2;

end;

// запомним координаты пустой клетки

ex:= x1;

ey:= y1;

end;

 

// обработка события OnCreate

procedure TForm1.FormCreate(Sender: TObject);

begin

pic:= TBitMap.Create;

NewGame;

end;// обработка события OnPaint

procedure TForm1.FormPaint(Sender: TObject);

begin

Form1.ShowPole;

end;

end.

 


Дата добавления: 2015-10-23; просмотров: 159 | Нарушение авторских прав


<== предыдущая страница | следующая страница ==>
Аналоговые часы с будильником| Динамическая картинка

mybiblioteka.su - 2015-2024 год. (0.277 сек.)