Читайте также: |
|
Интерфейс:
Код программы:
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 | Нарушение авторских прав
<== предыдущая страница | | | следующая страница ==> |
Аналоговые часы с будильником | | | Динамическая картинка |