Контрольная работа Контрольная работа по Программирование
Работа добавлена на сайт bukvasha.net: 2015-10-25Поможем написать учебную работу
Если у вас возникли сложности с курсовой, контрольной, дипломной, рефератом, отчетом по практике, научно-исследовательской и любой другой работой - мы готовы помочь.
Предоплата всего
от 25%
Подписываем
договор
Министерство образования Республики Беларусь
Белорусский национальный технический университет
Международный институт дистанционного образования
Контрольная
по дисциплине
Программирование
Вариант-11
Выполнил студент Лысов Д.В.
1-го курса группы А6
г. Гродно Дзержинского 135 кв.26
Зачетная книжка №417426
Специальность 53.01.02.
Информационные системы и
технологии
Проверил: Орехво
ГРОДНО 2007
Лабораторная работа №1
Простейшая программа в среде Delphi.
Цель работы: Научиться конструировать главную форму программы простейшими стандартными компонентами.
Постановка задачи:
Создать главную форму и присвоить ей имя, соответствующее лабораторной работе.
Сконструировать простейший калькулятор.
Написать обработчики, реализующие основные арифметические действия калькулятора.
Изучить структуру Unit главной формы.
1)Листинг программы:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Menus;
type
TForm1 = class(TForm)
Edit1: TEdit;
Button1: TButton;
Button2: TButton;
Button3: TButton;
Button4: TButton;
Button5: TButton;
Button6: TButton;
Button7: TButton;
Button8: TButton;
Button9: TButton;
ButtonPlus: TButton;
ButtonMinus: TButton;
ButtonEnter: TButton;
ButtonC: TButton;
Button0: TButton;
ButtonZ: TButton;
ButtonDel: TButton;
ButtonUmn: TButton;
MainMenu1: TMainMenu;
N1: TMenuItem;
N2: TMenuItem;
N3: TMenuItem;
procedure FormCreate(Sender: TObject);
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 Button0Click(Sender: TObject);
procedure ButtonZClick(Sender: TObject);
procedure ButtonPlusClick(Sender: TObject);
procedure ButtonMinusClick(Sender: TObject);
procedure ButtonEnterClick(Sender: TObject);
procedure ButtonCClick(Sender: TObject);
procedure Edit1KeyPress(Sender: TObject; var Key: Char);
procedure ButtonDelClick(Sender: TObject);
procedure ButtonUmnClick(Sender: TObject);
procedure N2Click(Sender: TObject);
procedure N3Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
var
accum:real;
oper:integer;
f:integer;
{$R *.dfm}
procedure DoOper;
var
numb: real;
begin
numb := StrToFloat(Form1.Edit1.Text);
case oper of
0: accum := numb;
1: accum := accum + numb;
2: accum := accum - numb;
3: accum := accum/numb;
4: accum := accum*numb;
end;
Form1.Edit1.Text := FloatToStr(accum);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
oper := 0;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
if f = 0
then begin
Edit1.Text := '1';
f := 1;
end
else Edit1.Text := Edit1.Text + '1';
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
if (f = 0)
then begin
Edit1.Text := '2';
f := 1;
end
else Edit1.Text := Edit1.Text + '2';
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
if f = 0
then begin
Edit1.Text := '3';
f := 1;
end
else Edit1.Text := Edit1.Text + '3';
end;
procedure TForm1.Button4Click(Sender: TObject);
begin
if f = 0 then
begin
Edit1.Text := '4';
f := 1;
end
else Edit1.Text := Edit1.Text + '4';
end;
procedure TForm1.Button5Click(Sender: TObject);
begin
if (f = 0)
then begin
Edit1.Text := '5';
f := 1;
end
else Edit1.Text := Edit1.Text + '5';
end;
procedure TForm1.Button6Click(Sender: TObject);
begin
if f = 0
then begin
Edit1.Text := '6';
f := 1;
end
else Edit1.Text := Edit1.Text + '6';
end;
procedure TForm1.Button7Click(Sender: TObject);
begin
if f = 0
then begin
Edit1.Text := '7';
f := 1;
end
else Edit1.Text := Edit1.Text + '7';
end;
procedure TForm1.Button8Click(Sender: TObject);
begin
if f = 0
then begin
Edit1.Text := '8';
f := 1;
end
else Edit1.Text := Edit1.Text + '8';
end;
procedure TForm1.Button9Click(Sender: TObject);
begin
if f = 0
then begin
Edit1.Text := '9';
f := 1;
end
else Edit1.Text := Edit1.Text + '9';
end;
procedure TForm1.Button0Click(Sender: TObject);
begin
if f = 0
then begin
Edit1.Text := '0';
f := 1;
end
else
if Edit1.Text <> '0'
then Edit1.Text := Edit1.Text + '0';
end;
procedure TForm1.ButtonZClick(Sender: TObject);
begin
if Edit1.Text = '0' then
begin
Edit1.Text := '0,';
f := 1;
end;
if Pos(',',Edit1.Text) = 0 then
Edit1.Text := Edit1.Text + ',';
end;
procedure TForm1.ButtonPlusClick(Sender: TObject);
begin
if f = 0
then oper := 1
else begin
DoOper;
oper :=1;
f:=0;
end;
end;
procedure TForm1.ButtonMinusClick(Sender: TObject);
begin
if f = 0
then oper := 2
else begin
DoOper;
oper :=2;
f:=0;
end;
end;
procedure TForm1.ButtonEnterClick(Sender: TObject);
begin
if f = 0
then oper := 0
else begin
DoOper;
oper :=0;
f:=0;
end;
end;
procedure TForm1.ButtonCClick(Sender: TObject);
begin
Edit1.Text := '0';
accum := 0;
oper := 0;
f := 0;
end;
procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
Key := Chr(0);
end;
procedure TForm1.ButtonDelClick(Sender: TObject);
begin
if f = 0
then oper := 3
else begin
DoOper;
oper :=3;
f:=0;
end;
end;
procedure TForm1.ButtonUmnClick(Sender: TObject);
begin
if f = 0
then oper := 4
else begin
DoOper;
oper :=4;
f:=0;
end;
end;
procedure TForm1.N2Click(Sender: TObject);
begin
Application.MessageBox('Выполнил Денис Лысов', 'Внимание!!!',0);
end;
procedure TForm1.N3Click(Sender: TObject);
begin
close;
end;
end.
2) Пример работы программы:
Лабораторная работа №2
Нахождение значения определенного интеграла методом Симпсона.
Цель работы: Изучить обработчик создания формы.
Постановка задачи:
1.Создать главную форму и присвоить ей имя, соответствующее лабораторной работе.
2.Поместить компоненту Label, в поле которой вывести значение решаемой задачи.
3.Написать обработчик создания формы, в котором запрограммировать нахождение значения определенного интеграла методом левых прямоугольников.
4.Изучить структуру Unit главной формы.
1)Листинг программы:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Label1: TLabel;
Label3: TLabel;
Label4: TLabel;
Button2: TButton;
Button3: TButton;
Label5: TLabel;
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
Col: TColor;
int,intp,pogr,rashcet : Real;
implementation
uses Unit2;
{$R *.dfm}
procedure TForm1.Button2Click(Sender: TObject);
begin
int:=0;
pogr:=0;
rashcet:=0;
Application.CreateForm(TForm2,Form2);
Form2.ShowModal;
Form2.Free;
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
close;
end;
end.
unit Unit2;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, jpeg, ExtCtrls;
type
TForm2 = class(TForm)
Button1: TButton;
Button2: TButton;
Label1: TLabel;
Button4: TButton;
Label2: TLabel;
Label3: TLabel;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form2: TForm2;
implementation
uses Unit1, Unit3;
{$R *.dfm}
function f(x:real):real;
begin
f:=(1/x)*sin(1/x);
end;
procedure TForm2.Button1Click(Sender: TObject);
begin
Form2.close;
end;
procedure TForm2.Button2Click(Sender: TObject);
var a,b,dx,x,y,y1,y2: real;
n: integer;
begin
a:=1;b:=5;
n:=80;y:=0;
dx:=(b-a)/n;
y1 := 0; x := a + dx;
while x < (b - dx) do begin
y1 := y1 + f(x);
x := x + 2*dx;
end;
y2 := 0; x := a + 2*dx;
while x < (b - 2*dx) do begin
y2 := y2 + f(x);
x := x + 2*dx;
end;
y:=((b-a)/(3*n)) * (f(a)+f(b) + 4*y1 + 2*y2);
int:=y;
rashcet:=rashcet+1;
Label1.Caption:='Ответ на 3 форме';
end;
procedure TForm2.Button4Click(Sender: TObject);
begin
if rashcet>0 then begin
Application.CreateForm(TForm3,Form3);
Form3.ShowModal;
Form3.Free;
end else
Application.MessageBox('Ошибка! Интегралл не рассчитан.', 'Внимание!!!',0);
end;
end.
unit Unit3;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm3 = class(TForm)
Button1: TButton;
Label1: TLabel;
Label2: TLabel;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form3: TForm3;
implementation
uses Unit1, Unit2;
{$R *.dfm}
procedure TForm3.Button1Click(Sender: TObject);
begin
Form3.close;
end;
procedure TForm3.FormCreate(Sender: TObject);
begin
Label2.Caption:=FloatToStr(int);
end;
end.
2) Пример работы программы:
Лабораторная работа №3
Создание нескольких форм и средства управления ими.
Цель работы: Изучить основные свойства и методы, связанные с созданием и активизацией форм
Постановка задачи:
Создать главную форму, содержащую название работы, фамилии исполнителей, кнопку изменения цвета формы и кнопку вызова другой формы.
Создать вторую форму, предназначенную для задания основных параметров, необходимых для вычисления определенного интеграла методом трапеций:
| Вариант | Подынтегральная функция | Интервал интеграла | Количество разбиений | Шаг | Первообразная функция |
| 10 | | [0,1] | 40 | 0.025 | |
На форме 2 должна быть также кнопка, по которой вычисляется интеграл и абсолютная погрешность, а затем открывается третья форма, на которой отображаются полученные результаты.
3. Каждая из форм должна содержать кнопку, по которой можно вернуться на шаг назад, т.е. на предыдущую форму.
1)Листинг программы:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Menus;
type
TForm1 = class(TForm)
Label4: TLabel;
Button1: TButton;
ColorDialog1: TColorDialog;
Button2: TButton;
Button3: TButton;
PopupMenu1: TPopupMenu;
gfjfjggf1: TMenuItem;
gfhf1: TMenuItem;
fghgfhf1: TMenuItem;
fghgfh1: TMenuItem;
Label1: TLabel;
Label3: TLabel;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
Col: TColor;
int,intp,pogr,rashcet : Real;
implementation
uses Unit2;
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
begin
Col:=Form1.Color;
if ColorDialog1.Execute()=True then
Col:=ColorDialog1.Color;
Form1.Color:=Col;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
int:=0;
pogr:=0;
rashcet:=0;
Application.CreateForm(TForm2,Form2);
Form2.ShowModal;
Form2.Free;
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
close;
end;
end.
unit Unit2;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, jpeg, ExtCtrls;
type
TForm2 = class(TForm)
Button1: TButton;
Button2: TButton;
Button3: TButton;
Label1: TLabel;
Label2: TLabel;
Button4: TButton;
Label8: TLabel;
Image1: TImage;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form2: TForm2;
implementation
uses Unit1, Unit3;
{$R *.dfm}
function f(x:real):real; {интегрируемая функция}
begin
f:=1/sqrt(1+3*x+2*x*x);
end;
procedure TForm2.Button1Click(Sender: TObject);
begin
Form2.close;
end;
procedure TForm2.Button2Click(Sender: TObject);
var h,i,z,a,b,n:real; {описание переменных}
begin
a:=0;b:=1;
n:=40;z:=0;
h:=(b-a)/n;
i:=a;
while (i<=b) do {цикл расчета по формуле трапеций}
begin
z:=z+h*(f(i)+f(i+h))/2;
i:=i+h;
end; {конец цикла}
int:=z;
rashcet:=rashcet+1;
Label1.Caption:='Ответ на 3 форме';
end;
procedure TForm2.Button4Click(Sender: TObject);
begin
if rashcet>1 then begin
Application.CreateForm(TForm3,Form3);
Form3.ShowModal;
Form3.Free;
end else
Application.MessageBox('Ошибка! Интегралл или погрешность еще не рассчитаны.', 'Внимание!!!',0);
end;
procedure TForm2.Button3Click(Sender: TObject);
var vv,nn:real;
begin
if rashcet=1 then begin
vv:=1/sqrt(2)*ln((1.75/1.25)+(sqrt(3.0625-0.0625)/1.25));
nn:=1/sqrt(2)*ln((0.75/1.25)+(sqrt(0.5625-0.0625)/1.25));
intp:=vv-nn;
pogr:=abs(int-intp);
rashcet:=rashcet+1;
Label2.Caption:='Погрешность рассчитана';
end else
Application.MessageBox('Ошибка! Интегралл еще не рассчитан.', 'Внимание!!!',0);
end;
end.
unit Unit3;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, TeEngine, Series, ExtCtrls, TeeProcs, Chart, Grids;
type
TForm3 = class(TForm)
Button1: TButton;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Chart1: TChart;
Series1: TFastLineSeries;
StringGrid1: TStringGrid;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form3: TForm3;
implementation
uses Unit1, Unit2;
{$R *.dfm}
function f(x:real):real; {интегрируемая функция}
begin
f:=1/sqrt(1+3*x+2*x*x);
end;
procedure TForm3.Button1Click(Sender: TObject);
begin
Form3.close;
end;
procedure TForm3.FormCreate(Sender: TObject);
var i:integer;
clr:TColor;
im,ib,a,b:real;
inn:integer;
begin
Label2.Caption:=FloatToStr(int);
Label4.Caption:=FloatToStr(pogr);
Chart1.Series[0].Clear;
a:=0;b:=1;
im:=a;
inn:=1000;
ib:=(b-a)/inn;
for i:=0 to inn-1 do
begin
Chart1.Series[0].AddXY(im,f(im),'',clr);
im:=im+ib;
end;
StringGrid1.Cells[0,0]:='Функция';
StringGrid1.Cells[0,1]:='a=';
StringGrid1.Cells[0,2]:='b=';
StringGrid1.Cells[0,3]:='Интеграл равен';
StringGrid1.Cells[0,4]:='Погрешность';
StringGrid1.Cells[1,0]:='f(x)=1/sqrt(1+3*x+2*x*x)';
StringGrid1.Cells[1,1]:=FloatToStr(a);
StringGrid1.Cells[1,2]:=FloatToStr(b);
StringGrid1.Cells[1,3]:=FloatToStr(int);
StringGrid1.Cells[1,4]:=FloatToStr(pogr);
end;
end.
2) Пример работы программы:
Лабораторная работа №4
Простейший текстовый редактор.
Цель работы: Изучить принципы программирования текстовых редакторов.
Постановка задачи: Создать главную форму, содержащую название работы, фамилии исполнителей, кнопку вызова подчиненной формы. На подчиненной форме спроектировать диалог, моделирующий работу текстового редактора, а именно предусмотреть чтение исходного текста из файла, операции копирования, перемещения и запись отредактированного текста в результирующий файл.
1)Листинг программы:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Label4: TLabel;
Button2: TButton;
Button3: TButton;
Label5: TLabel;
Label6: TLabel;
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
s: integer;
p: integer;
fN: String[80];
implementation
uses Unit2;
{$R *.dfm}
procedure TForm1.Button2Click(Sender: TObject);
begin
Application.CreateForm(TForm2,Form2);
Form2.ShowModal;
Form2.Free;
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
close;
end;
end.
unit Unit2;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Menus, ExtCtrls;
type
TForm2 = class(TForm)
Memo1: TMemo;
OpenDialog1: TOpenDialog;
SaveDialog1: TSaveDialog;
Panel1: TPanel;
Button2: TButton;
Button3: TButton;
Panel2: TPanel;
Button1: TButton;
Button4: TButton;
procedure Button1Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Memo1KeyPress(Sender: TObject; var Key: Char);
procedure Button4Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form2: TForm2;
implementation
uses Unit1;
{$R *.dfm}
//////////////////////////////////////////////
procedure save1;
var
f: TextFile; // файл
fName: String[80]; // имя файла
i: integer;
begin
Form2.SaveDialog1.FileName:=fn;
if Form2.SaveDialog1.FileName<>'' then
Form2.SaveDialog1.Execute;
fName := Form2.SaveDialog1.FileName;
if fName<>'' then begin
fName := fName;
fN := fName;
//if StrRScan(fN,'.txt') then
AssignFile(f, fName+'.txt');
try
Rewrite(f); // открыть для перезаписи
// запись в файл
for i:=0 to Form2.Memo1.Lines.Count do // строки нумеруются с нуля
writeln(f, Form2.Memo1.Lines[i]);
s:=0;
Form2.Caption:=fn;
Form2.SaveDialog1.FileName:=fn;
CloseFile(f); // закрыть файл
except
on EInOutError do
begin
ShowMessage('Ошибка доступа к файлу '+ fName);
exit;
end;
end;
end;
end;
///////////////////////////////////////////////////////
procedure save;
var
f: TextFile; // файл
fName: String[80]; // имя файла
i: integer;
begin
if Form2.SaveDialog1.FileName<>'' then
Form2.SaveDialog1.Execute;
fName := Form2.SaveDialog1.FileName;
if fName<>'' then begin
fName := fName+'.txt';
AssignFile(f, fName);
try
Rewrite(f); // открыть для перезаписи
// запись в файл
for i:=0 to Form2.Memo1.Lines.Count do // строки нумеруются с нуля
writeln(f, Form2.Memo1.Lines[i]);
s:=0;
CloseFile(f); // закрыть файл
except
on EInOutError do
begin
ShowMessage('Ошибка доступа к файлу '+ fName);
exit;
end;
end;
end;
end;
/////////////////////////////////////////////////////
procedure open;
var
f: TextFile; // файл
fName: String[80]; // имя файла
buf: String[80]; // буфер для чтения из файла
begin
if Form2.OpenDialog1.FileName<>'' then
Form2.OpenDialog1.FileName:='';
Form2.OpenDialog1.Execute;
fName := Form2.OpenDialog1.FileName;
fn := Form2.OpenDialog1.FileName;
Form2.Caption:=fn;
if fName<>'' then begin
try
AssignFile(f, fName);
Reset(f); // открыть для чтения
if IOResult <> 0 then
begin
MessageDlg('Ошибка доступа к файлу ' + fName,
mtError,[mbOk],0);
exit;
end;
// чтение из файла
while not EOF(f) do
begin
readln(f, buf); // прочитать строку из файла
Form2.Memo1.Lines.Add(buf); // добавить строку в поле Memo1
end;
CloseFile(f); // закрыть файл
except
begin
ShowMessage('Ошибка доступа к файлу '+ fName);
exit;
end;
end;
end;
end;
////////////////////////////////////////////////
procedure TForm2.Button1Click(Sender: TObject);
begin
Form2.close;
end;
procedure TForm2.Button3Click(Sender: TObject);
begin
save1;
end;
procedure TForm2.Button2Click(Sender: TObject);
begin
Form2.Memo1.Clear;
open;
end;
procedure TForm2.FormCreate(Sender: TObject);
begin
s:=0;
p:=0;
p:=p+1;
fn:='Новый'+IntToStr(p);
Form2.Caption:=fn;
end;
procedure TForm2.Memo1KeyPress(Sender: TObject; var Key: Char);
begin
s:=1;
end;
procedure TForm2.Button4Click(Sender: TObject);
begin
if s=1 then save;
p:=p+1;
fn:='Новый'+IntToStr(p);
Form2.Caption:=fn;
Form2.Memo1.Clear;
end;
end.
Пример работы программы:
Лабораторная работа №5
Управление программой с помощью компонентов ScrollBar, RadioButton, CheckBox.
Цель работы: Изучить основные свойства и методы компонентов ScrollBar, RadioButton, CheckBox..
Постановка задачи: Написать программу смешивания цветов. При этом должен быть организован диалог, как показано ниже.
1)Листинг программы:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, ComCtrls, AppEvnts, StdCtrls;
type
TForm1 = class(TForm)
ApplicationEvents1: TApplicationEvents;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
ScrollBar1: TScrollBar;
ScrollBar2: TScrollBar;
ScrollBar3: TScrollBar;
Panel1: TPanel;
Panel2: TPanel;
CheckBox1: TCheckBox;
CheckBox2: TCheckBox;
CheckBox3: TCheckBox;
RadioGroup1: TRadioGroup;
Panel3: TPanel;
Button1: TButton;
Panel4: TPanel;
Panel5: TPanel;
Panel6: TPanel;
Label4: TLabel;
Label5: TLabel;
Label6: TLabel;
Label7: TLabel;
Label8: TLabel;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure CheckBox1Click(Sender: TObject);
procedure CheckBox2Click(Sender: TObject);
procedure CheckBox3Click(Sender: TObject);
procedure RadioGroup1Click(Sender: TObject);
procedure ScrollBar1Change(Sender: TObject);
procedure ScrollBar2Change(Sender: TObject);
procedure ScrollBar3Change(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
rec:trect;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
rec.Left:=0;
rec.Top:=0;
rec.Right:=279;
rec.Bottom:=39;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
close;
end;
procedure TForm1.CheckBox1Click(Sender: TObject);
begin
if CheckBox1.Checked=False then
ScrollBar1.Enabled:=False else
ScrollBar1.Enabled:=True;
end;
procedure TForm1.CheckBox2Click(Sender: TObject);
begin
if CheckBox2.Checked=False then
ScrollBar2.Enabled:=False else
ScrollBar2.Enabled:=True;
end;
procedure TForm1.CheckBox3Click(Sender: TObject);
begin
if CheckBox3.Checked=False then
ScrollBar3.Enabled:=False else
ScrollBar3.Enabled:=True;
end;
procedure TForm1.RadioGroup1Click(Sender: TObject);
begin
if RadioGroup1.ItemIndex=1 then
Panel3.Visible:=False else
Panel3.Visible:=True;
end;
procedure TForm1.ScrollBar1Change(Sender: TObject);
begin
Panel4.Color:=rgb(ScrollBar1.Position,0,0);
Panel1.Color:=rgb(ScrollBar1.Position,ScrollBar2.Position,ScrollBar3.Position);
Label4.Caption:=inttostr(ScrollBar1.Position);
end;
procedure TForm1.ScrollBar2Change(Sender: TObject);
begin
Panel5.Color:=rgb(0,ScrollBar2.Position,0);
Panel1.Color:=rgb(ScrollBar1.Position,ScrollBar2.Position,ScrollBar3.Position);
Label5.Caption:=inttostr(ScrollBar2.Position);
end;
procedure TForm1.ScrollBar3Change(Sender: TObject);
begin
Panel6.Color:=rgb(0,0,ScrollBar3.Position);
Panel1.Color:=rgb(ScrollBar1.Position,ScrollBar2.Position,ScrollBar3.Position);
Label6.Caption:=inttostr(ScrollBar3.Position);
end;
end.
2) Пример работы программы:
Лабораторная работа №6
Управление программой с помощью меню
Цель работы: Изучить принципы построения меню и организации команд управления программой
Постановка задачи: Разработать программу вычисления определенного интеграла методом Симпсона под управлением команд, расположенных в главном меню.
1)Листинг программы:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Menus, StdCtrls, jpeg, ExtCtrls;
type
TForm1 = class(TForm)
MainMenu1: TMainMenu;
N1: TMenuItem;
Label5: TLabel;
N2: TMenuItem;
Label12: TLabel;
Label1: TLabel;
Label3: TLabel;
Label4: TLabel;
Label2: TLabel;
Label6: TLabel;
Label7: TLabel;
N3: TMenuItem;
procedure N2Click(Sender: TObject);
procedure N3Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
function f(x:real):real; {интегрируемая функция}
begin
f:=(1/x)*sin(1/x);
end;
procedure TForm1.N2Click(Sender: TObject);
var a,b,dx,x,y,y1,y2: real;
n: integer;
begin
a:=1;b:=5;
n:=80;y:=0;
dx:=(b-a)/n;
{Вычисление по методу Симпсона}
y1 := 0; x := a + dx; {x = X1}
while x < (b - dx) do begin {x < Xn}
y1 := y1 + f(x);
x := x + 2*dx; {x = X1, X3, X5 ... Xn-1}
end;
y2 := 0; x := a + 2*dx; {x = X2}
while x < (b - 2*dx) do begin {x < Xn-1}
y2 := y2 + f(x);
x := x + 2*dx; {x = X2, X4, X6 ... Xn-2}
end;
y:=((b-a)/(3*n)) * (f(a)+f(b) + 4*y1 + 2*y2);
Label12.Caption:=FloatToStr(y);
end;
procedure TForm1.N3Click(Sender: TObject);
begin
Close;
end;
end.
2) Пример работы программы:
Лабораторная работа №7
Элементы PopupMenu, ListBox, ComboBox.
Цель работы: Изучить основные свойства и методы компонентов классов TPopupMenu, TListBox, TComboBox.
Постановка задачи: Разработать программу вычисления определенных интегралов, подынтегральные функции которых выбираются из списка. В программе предусмотреть изменение свойств компонентов по правой кнопке. При нажатии правой кнопки предусмотреть возможность открытия ComboBox, из списка которого выбирать название выходной формы.
1)Листинг программы:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, jpeg, Menus;
type
TForm1 = class(TForm)
Label4: TLabel;
PopupMenu1: TPopupMenu;
N2: TMenuItem;
N3: TMenuItem;
N1: TMenuItem;
ColorDialog1: TColorDialog;
Label1: TLabel;
Label3: TLabel;
ComboBox1: TComboBox;
Button1: TButton;
Label5: TLabel;
Label2: TLabel;
procedure ComboBox1Change(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure N3Click(Sender: TObject);
procedure N2Click(Sender: TObject);
procedure N1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
Col: TColor;
h,i,z,a,b:real; {описание переменных}
implementation
{$R *.dfm}
function f(x:real):real; {интегрируемая функция}
begin
If Form1.ComboBox1.Text='f(x)=sin(x)' Then f:=sin(x);
If Form1.ComboBox1.Text='f(x)=cos(x)' Then f:=cos(x);
If Form1.ComboBox1.Text='f(x)=ln(x)' Then f:=ln(x);
end;
procedure TForm1.ComboBox1Change(Sender: TObject);
begin
Label5.Caption:='';
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
h:=(b-a)/80; {начальные значения переменных}
z:=0;
i:=a;
while (i<=b) do {цикл расчета по формуле трапеций}
begin
z:=z+h*(f(i)+f(i+h))/2;
i:=i+h;
end; {конец цикла}
Label5.Caption:=FloatToStr(z);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
a:=1;b:=2;z:=0;
end;
procedure TForm1.N3Click(Sender: TObject);
begin
if Form1.ComboBox1.Font.Style=[] then
Form1.ComboBox1.Font.Style:=[fsBold] else
Form1.ComboBox1.Font.Style:=[];
end;
procedure TForm1.N2Click(Sender: TObject);
begin
Col:=Form1.Color;
if ColorDialog1.Execute()=True then
Col:=ColorDialog1.Color;
Form1.ComboBox1.Font.Color:=Col;
end;
procedure TForm1.N1Click(Sender: TObject);
begin
Col:=Form1.Color;
if ColorDialog1.Execute()=True then
Col:=ColorDialog1.Color;
Form1.ComboBox1.Color:=Col;
end;
end.
.
2) Пример работы программы:
Лабораторная работа №8
Графические компоненты
Цель работы: Изучить основные графические компоненты, их свойства и методы
Постановка задачи: Разработать программу, содержащую три формы – три способа представления графической информации.
На 1-й форме продемонстрировать отображение графических картинок, созданных в других графических редакторах.
На 2-й форме с помощью кнопочного меню рисовать различные графические фигуры посредством компоненты класса TShape.
На 3-й форме реализовать рисование простейшими примитивами, типа линия, прямоугольник, эллипс и т.д.
1)Листинг программы:
unit graf;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Menus;
type
TForm1 = class(TForm)
Label1: TLabel;
Label3: TLabel;
Label4: TLabel;
MainMenu1: TMainMenu;
N1: TMenuItem;
N11: TMenuItem;
N21: TMenuItem;
N41: TMenuItem;
procedure N41Click(Sender: TObject);
procedure N21Click(Sender: TObject);
procedure N11Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
uses unit1,unit3;
{$R *.dfm}
procedure TForm1.N41Click(Sender: TObject);
begin
close;
end;
procedure TForm1.N21Click(Sender: TObject);
begin
Application.CreateForm(TForm3,Form3);
Form3.ShowModal;
Form3.Free;
end;
procedure TForm1.N11Click(Sender: TObject);
begin
Application.CreateForm(TRed,Red);
Red.ShowModal;
Red.Free;
end;
end.
unit Unit3;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls, Buttons;
type
TForm3 = class(TForm)
BitBtn1: TBitBtn;
Shape1: TShape;
BitBtn2: TBitBtn;
BitBtn3: TBitBtn;
BitBtn4: TBitBtn;
BitBtn5: TBitBtn;
BitBtn6: TBitBtn;
Shape2: TShape;
Shape3: TShape;
Shape4: TShape;
Shape5: TShape;
Shape6: TShape;
procedure BitBtn1Click(Sender: TObject);
procedure BitBtn2Click(Sender: TObject);
procedure BitBtn3Click(Sender: TObject);
procedure BitBtn4Click(Sender: TObject);
procedure BitBtn5Click(Sender: TObject);
procedure BitBtn6Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form3: TForm3;
implementation
{$R *.dfm}
procedure TForm3.BitBtn1Click(Sender: TObject);
begin
Shape1.Visible:=true;
Shape1.Shape:=stCircle;
Shape2.Visible:=false;
Shape3.Visible:=false;
Shape4.Visible:=false;
Shape5.Visible:=false;
Shape6.Visible:=false;
end;
procedure TForm3.BitBtn2Click(Sender: TObject);
begin
Shape2.Visible:=true;
Shape2.Shape:=stEllipse;
Shape1.Visible:=false;
Shape3.Visible:=false;
Shape4.Visible:=false;
Shape5.Visible:=false;
Shape6.Visible:=false;
end;
procedure TForm3.BitBtn3Click(Sender: TObject);
begin
Shape3.Visible:=true;
Shape3.Shape:=stRectangle;
Shape1.Visible:=false;
Shape2.Visible:=false;
Shape4.Visible:=false;
Shape5.Visible:=false;
Shape6.Visible:=false;
end;
procedure TForm3.BitBtn4Click(Sender: TObject);
begin
Shape4.Visible:=true;
Shape4.Shape:=stRoundRect;
Shape1.Visible:=false;
Shape2.Visible:=false;
Shape3.Visible:=false;
Shape5.Visible:=false;
Shape6.Visible:=false;
end;
procedure TForm3.BitBtn5Click(Sender: TObject);
begin
Shape5.Visible:=true;
Shape5.Shape:=stRoundSquare;
Shape1.Visible:=false;
Shape2.Visible:=false;
Shape3.Visible:=false;
Shape4.Visible:=false;
Shape6.Visible:=false;
end;
procedure TForm3.BitBtn6Click(Sender: TObject);
begin
Shape6.Visible:=true;
Shape6.Shape:=stSquare;
Shape1.Visible:=false;
Shape2.Visible:=false;
Shape3.Visible:=false;
Shape4.Visible:=false;
Shape5.Visible:=false;
end;
procedure TForm3.FormCreate(Sender: TObject);
begin
Shape1.Visible:=true;
Shape1.Shape:=stCircle;
Shape2.Visible:=false;
Shape3.Visible:=false;
Shape4.Visible:=false;
Shape5.Visible:=false;
Shape6.Visible:=false;
end;
end.
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Buttons, ExtCtrls, Menus, ExtDlgs;
type
TRed = class(TForm)
Image1: TImage;
BitBtn1: TBitBtn;
BitBtn2: TBitBtn;
BitBtn3: TBitBtn;
BitBtn4: TBitBtn;
BitBtn5: TBitBtn;
BitBtn6: TBitBtn;
BitBtn8: TBitBtn;
Shape1: TShape;
Shape2: TShape;
Bevel1: TBevel;
ColorDialog1: TColorDialog;
MainMenu1: TMainMenu;
Timer1: TTimer;
Edit3: TEdit;
Edit4: TEdit;
Bevel2: TBevel;
Edit5: TEdit;
Edit6: TEdit;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Edit7: TEdit;
Label5: TLabel;
Button1: TButton;
Label6: TLabel;
Edit1: TEdit;
Edit2: TEdit;
Label7: TLabel;
Label8: TLabel;
Edit8: TEdit;
Edit9: TEdit;
Label9: TLabel;
Bevel3: TBevel;
Button2: TButton;
Bevel4: TBevel;
Label10: TLabel;
Label11: TLabel;
Label12: TLabel;
Label13: TLabel;
Edit10: TEdit;
Edit11: TEdit;
Edit12: TEdit;
Edit13: TEdit;
Button3: TButton;
Bevel5: TBevel;
Label14: TLabel;
Label15: TLabel;
Label16: TLabel;
Label17: TLabel;
Edit14: TEdit;
Edit15: TEdit;
Edit16: TEdit;
Edit17: TEdit;
Button4: TButton;
OpenPictureDialog1: TOpenPictureDialog;
SavePictureDialog1: TSavePictureDialog;
File1: TMenuItem;
Exit1: TMenuItem;
N4: TMenuItem;
Save1: TMenuItem;
New1: TMenuItem;
N1: TMenuItem;
BitBtn7: TBitBtn;
procedure polegon();
procedure duga(x1,x2,y1,y2,r: integer);
procedure ellips(xc,yc,enx,eny:integer);
procedure krug(xc,yc, x2, y2:integer);
procedure line(bx:TBitMap;x1, y1, x2, y2:integer);
procedure zakrash(x,y: integer);
procedure FormCreate(Sender: TObject);
procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Image1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure BitBtn5Click(Sender: TObject);
procedure BitBtn1Click(Sender: TObject);
procedure BitBtn2Click(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure Shape1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure BitBtn3Click(Sender: TObject);
procedure BitBtn4Click(Sender: TObject);
procedure BitBtn6Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure BitBtn8Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure N1Click(Sender: TObject);
procedure Save1Click(Sender: TObject);
procedure Exit1Click(Sender: TObject);
procedure New1Click(Sender: TObject);
procedure BitBtn7Click(Sender: TObject);
private
{ Private declarations }
public
bp:TBitMap;
b1:TBitMap;
b2:TBitMap;
{ Public declarations }
end;
var
Red: TRed;
flag,lin: integer;
X1,Y1: integer;
Xp,Yp,Xp1,Yp1: integer;
ClrFon: TColor;
implementation
{$R *.dfm}
procedure TRed.polegon();
var a,i,j:integer;
x1,x2:integer;
begin
line(b2,Xp,Yp,Xp1,Yp1);
line(b1,Xp,Yp,Xp1,Yp1);
line(bp,Xp,Yp,Xp1,Yp1);
b2.Canvas.CopyMode:=cmSrcCopy;
b2.Canvas.CopyRect(Rect(0,0,500,300),b1.Canvas,Rect(0,0,500,300));
Image1.Canvas.CopyMode:=cmSrcCopy;
Image1.Canvas.CopyRect(Rect(0,0,500,300),bp.Canvas,Rect(0,0,500,300));
for j:=0 to 299 do
begin
a:=0;
for i:=0 to 499 do
begin
if (b2.Canvas.Pixels[i,j]<>RGB(255,255,255))and
(b2.Canvas.Pixels[i-1,j]=b2.Canvas.Pixels[i,j]) then a:=a-1;
if b2.Canvas.Pixels[i,j]<>RGB(255,255,255) then
begin
if a=0 then begin a:=1; x1:=i; end else begin a:=2; x2:=i; end;
if a=2 then begin
a:=0;
line(b2,x1,j,x2,j);
end;
end;
end;
end;
Image1.Canvas.CopyMode:=cmSrcAnd;
Image1.Canvas.CopyRect(Rect(0,0,500,300),b2.Canvas,Rect(0,0,500,300));
bp.Canvas.CopyMode:=cmSrcCopy;
bp.Canvas.CopyRect(Rect(0,0,500,300),Image1.Canvas,Rect(0,0,500,300));
b1.Canvas.CopyMode:=cmSrcCopy;
b1.Canvas.CopyRect(Rect(0,0,500,300),Image1.Canvas,Rect(0,0,500,300));
end;
procedure TRed.duga(x1,x2,y1,y2,r: integer);
type s= -1..1;
var
xser,yser: real;
la1,lb1,la2,lb2: real;
xpr,ypr: real;
dlina1{,dlina2}: real;
xmin{,xmax}: integer;
ymin{,ymax}: integer;
xc1,yc1,xc2,yc2,xc,yc: integer;
x,y,di,db,xpr2,ypr2: integer;
t,t2: s;
per1,par1,per2,par2: boolean;
col:TColor;
function sign(d: real): s;
begin
if d<0 then sign:=-1
else if d>0 then sign:=1
else sign:=0;
end;
begin
per1:=false;
par1:=false;
per2:=false;
par2:=false;
col:=Red.Shape1.Brush.Color;
if y1=y2 then
begin
if x1=x2 then
begin
ShowMessage('Вы ввели точку!');
exit;
end;
par1:=true;
end
else if x1=x2 then
per1:=true;
if x1>x2 then xmin:=x2
else xmin:=x1;
if y1>y2 then ymin:=y2
else ymin:=y1;
xser:=abs(x1-x2)/2+xmin;
yser:=abs(y1-y2)/2+ymin;
if (not per1)and(not par1) then
begin
la1:=(y2-y1)/(x2-x1);
lb1:=(y1*x2-x1*y2)/(x2-x1);
la2:=-1/la1;
lb2:=yser-la2*xser;
xpr:=xser;
ypr:=la2*xpr+lb2;
dlina1:=sqrt(sqr(xpr-x1)+sqr(ypr-y1));
While dlina1
begin
xpr:=xpr+1;
ypr:=la2*xpr+lb2;
dlina1:=sqrt(sqr(xpr-x1)+sqr(ypr-y1));
end;
end else
if par1 then
begin
xpr:=xser;
ypr:=yser+sqrt( r*r-(sqr(x2-xser)+sqr(y2-yser)) );
end else
begin
xpr:=xser+sqrt( r*r-(sqr(x2-xser)+sqr(y2-yser)) );
ypr:=yser;
end;
xc1:=round(xpr);
yc1:=round(ypr);
xc2:=round(xser-(xpr-xser));
yc2:=round(yser-(ypr-yser));
if sqrt(sqr(xc1)+sqr(yc1))
begin
xc:=xc1;
yc:=yc1;
end else
begin
xc:=xc2;
yc:=yc2;
end;
x:=0;
y:=r;
di:=2*(1-r);
xpr2:=xc;
ypr2:=yc;
t2:=1;
{рисование центра}
b1.canvas.pen.Width:=1;
b1.canvas.pen.color:=col;
b1.canvas.pixels[xpr2,ypr2]:=col;
if par1 then
if yc
else t:=1;
if per1 then
if xc
else t:=1;
if (not per1)and(not par1) then
begin
t2:=0;
if (xc*la1+lb1-yc)<0
then t:=-1
else t:=1;
end;
// if CheckBox1.Checked then t:=-t;
repeat
if t2=0 then
begin
if t*((xc+x)*la1+lb1-(yc-y))<=0 then b1.canvas.pixels[xpr2+x,ypr2-y]:=col;
if t*((xc+x)*la1+lb1-(yc+y))<=0 then b1.canvas.pixels[xpr2+x,ypr2+y]:=col;
if t*((xc-x)*la1+lb1-(yc-y))<=0 then b1.canvas.pixels[xpr2-x,ypr2-y]:=col;
if t*((xc-x)*la1+lb1-(yc+y))<=0 then b1.canvas.pixels[xpr2-x,ypr2+y]:=col;
end else
if par1 then
begin
if t*((yc-y)-yser)<=0 then b1.canvas.pixels[xpr2+x,ypr2-y]:=col;
if t*((yc+y)-yser)<=0 then b1.canvas.pixels[xpr2+x,ypr2+y]:=col;
if t*((yc-y)-yser)<=0 then b1.canvas.pixels[xpr2-x,ypr2-y]:=col;
if t*((yc+y)-yser)<=0 then b1.canvas.pixels[xpr2-x,ypr2+y]:=col;
end else
begin
if t*((xc+x)-xser)<=0 then b1.canvas.pixels[xpr2+x,ypr2+y]:=col;
if t*((xc+x)-xser)<=0 then b1.canvas.pixels[xpr2+x,ypr2-y]:=col;
if t*((xc-x)-xser)<=0 then b1.canvas.pixels[xpr2-x,ypr2+y]:=col;
if t*((xc-x)-xser)<=0 then b1.canvas.pixels[xpr2-x,ypr2-y]:=col;
end;
if di<0 then
begin
db:=2*di+2*y-1;
if db<=0 then begin
x:=x+1;
di:=di+2*x+1;
end
else begin
x:=x+1;
y:=y-1;
di:=di+2*(x-y+1);
end
end else if di>0 then
begin
db:=2*di-2*x-1;
if db<0 then begin
x:=x+1;
y:=y-1;
di:=di+2*(x-y+1);
end
else begin
y:=y-1;
di:=di-2*y+1;
end
end else begin
x:=x+1;
y:=y-1;
di:=di+2*(x-y+1);
end;
until y<0;
end;
procedure TRed.Ellips(xc,yc,enx,eny:integer);
var
x,y,a,b:integer;
a2,b2,dds,ddt,dxt,t,s,e,ca,cd,indx:longint;
col:TColor;
begin
col:=Red.Shape1.Brush.Color;
a:=abs(enx-xc);
b:=abs(eny-yc);
a2:=a*a;
b2:=b*b;
dds:=4*a2;
ddt:=4*b2;
dxt:=round(a2/sqrt(a2+b2));
t:=0;
s:=-4*a2*b;
e:=round((-s/2)-2*b2-a2);
ca:=-6*b2;
cd:=ca-4*a2;
x:=xc;
y:=yc+b;
b1.canvas.pixels[x,y]:=col;
b1.canvas.pixels[2*xc-x,2*yc-y]:=col;
b1.canvas.pixels[x,2*yc-y]:=col;
b1.canvas.pixels[2*xc-x,y]:=col;
for indx:=1 to dxt do
begin
x:=x+1;
if e>=0 then e:=e+t+ca
else
begin
y:=y-1;
e:=e+t-s+cd;
s:=s+dds;
end;
t:=t-ddt;
b1.canvas.pixels[x,y]:=col;
b1.canvas.pixels[2*xc-x,2*yc-y]:=col;
b1.canvas.pixels[x,2*yc-y]:=col;
b1.canvas.pixels[2*xc-x,y]:=col;
end;
dxt:=abs(y-yc);
e:=round(e-(t/2+s/2+b2+a2));
ca:=-6*a2;
cd:=ca-4*b2;
for indx:=1 to dxt do
begin
y:=y-1;
if e<=0 then e:=e-s+ca
else
begin
x:=x+1;
e:=e-s+t+cd;
t:=t-ddt;
end;
s:=s+dds;
b1.canvas.pixels[x,y]:=col;
b1.canvas.pixels[2*xc-x,2*yc-y]:=col;
b1.canvas.pixels[x,2*yc-y]:=col;
b1.canvas.pixels[2*xc-x,y]:=col;
end;
end;
procedure TRed.krug(xc,yc, x2, y2:integer);
var
x3,y3,i,dxt: integer;
r2,dst,t,s,e,ca,cd,indx: double;
radius:integer;
col:TColor;
begin
col:=Red.Shape1.Brush.Color;
radius:=Round(sqrt((x2-xc)*(x2-xc)+(y2-yc)*(y2-yc)));
r2:=radius*radius;
dst:= 4*r2;
dxt:=Round(radius/1.414213562373);
t:=0;
s:=s-4*r2*radius;
e:=(-s/2)-3*r2;
ca:=ca-6*r2;
cd:=-10*r2;
x3:=0;
y3:=radius;
b1.Canvas.Pixels[xc,yc+radius]:=col;
b1.Canvas.Pixels[xc,yc-radius]:=col;
b1.Canvas.Pixels[xc+radius,yc]:=col;
b1.Canvas.Pixels[xc-radius,yc]:=col;
for i:=1 to dxt do
begin
x3:=x3+1;
if (e>=0) then e:=e+t+ca
else begin
y3:=y3-1;
e:=e+t-s+cd;
s:=s+dst;
end;
t:=t-dst;
b1.Canvas.Pixels[xc+x3,yc+y3]:=col;
b1.Canvas.Pixels[xc+y3,yc+x3]:=col;
b1.Canvas.Pixels[xc+y3,yc-x3]:=col;
b1.Canvas.Pixels[xc+x3,yc-y3]:=col;
b1.Canvas.Pixels[xc-x3,yc-y3]:=col;
b1.Canvas.Pixels[xc-y3,yc-x3]:=col;
b1.Canvas.Pixels[xc-y3,yc+x3]:=col;
b1.Canvas.Pixels[xc-x3,yc+y3]:=col;
end;
end;
procedure TRed.zakrash(x,y: integer);
var xl,xr: integer;
clr1: TColor;
begin
xl:=x;
xr:=x;
repeat
xl:=xl-1;
clr1:=bp.canvas.pixels[xl,y];
until (clr1<>ClrFon);
repeat
xr:=xr+1;
clr1:=bp.canvas.pixels[xr,y];
until (clr1<>ClrFon);
inc(xl);
dec(xr);
bp.canvas.MoveTo(xl,y);
bp.canvas.LineTo(xr+1,y);
x:=xl;
while x<=xr do
begin
clr1:=bp.canvas.pixels[x,y+1];
if (clr1=ClrFon) then
zakrash(x,y+1);
clr1:=bp.canvas.pixels[x,y-1];
if (clr1=ClrFon) then
zakrash(x,y-1);
inc(x);
end;
end;
procedure TRed.FormCreate(Sender: TObject);
begin
bp := TBitmap.Create;
b1 := TBitmap.Create;
b2 := TBitmap.Create;
bp.Width:=500;
bp.Height:=300;
b1.Width:=500;
b1.Height:=300;
b2.Width:=500;
b2.Height:=300;
lin:=0; flag:=0;
bp.Canvas.MoveTo(0,0);
bp.Canvas.LineTo(0,299);
bp.Canvas.LineTo(499,299);
bp.Canvas.LineTo(499,0);
bp.Canvas.LineTo(0,0);
Image1.Canvas.CopyRect(Rect(0,0,500,300),bp.Canvas,Rect(0,0,500,300));
end;
procedure TRed.line(bx:TBitMap;x1, y1, x2, y2:integer);
type s= -1..1;
var
s1,s2: s;
dy,dx,x,y: integer;
f,i,e,wr: integer;
function sign(d: integer): s;
begin
if d<0 then sign:=-1
else if d>0 then sign:=1
else sign:=0;
end;
begin
dx:=abs(x2-x1);
dy:=abs(y2-y1);
s1:=sign(x2-x1);
s2:=sign(y2-y1);
if dy>dx then
begin
wr:=dx;
dx:=dy;
dy:=wr;
f:=1;
end else f:=0;
e:=2*dy-dx;
for i:=1 to dx do
begin
{ x:=x1+PaintBox1.width div 2;
y:=PaintBox1.height div 2 - y1;}
bx.Canvas.Pixels[x1,y1]:= Red.Shape1.Brush.Color;
while e>=0 do
begin
if f=1 then x1:=x1+s1
else y1:=y1+s2;
e:=e-2*dx;
end;
if f=1 then y1:=y1+s2
else x1:=x1+s1;
e:=e+2*dy;
end;
x:=x2+Image1.width div 2;
y:=Image1.height div 2 - y2;
bx.Canvas.Pixels[x1,y1]:= Red.Shape1.Brush.Color;
end;
procedure TRed.Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if flag=1 then
begin
if Shape1.Brush.Color<>bp.canvas.pixels[x,y] then
begin
bp.canvas.pen.color:=Shape1.Brush.Color;
ClrFon:=bp.canvas.pixels[x,y];
zakrash(X,Y);
Image1.Canvas.CopyRect(Rect(0,0,500,300),bp.Canvas,Rect(0,0,500,300));
end;
end else
if flag=6 then
begin
//image1.Canvas.CopyMode:=cmSrcAnd;
if lin=0 then begin
b2.Canvas.Brush.Color:=RGB(255,255,255);
b2.Canvas.FillRect(Rect(0,0,500,300));
b1.Canvas.CopyRect(Rect(0,0,500,300),b2.Canvas,Rect(0,0,500,300));
bp.Canvas.CopyRect(Rect(0,0,500,300),Image1.Canvas,Rect(0,0,500,300));
X1:=X; Y1:=Y; lin:=1;
Xp:=X; Yp:=Y;
end;
end
else
begin
image1.Canvas.CopyMode:=cmSrcCopy;
b1.Canvas.CopyMode:=cmSrcCopy;
bp.Canvas.CopyMode:=cmSrcCopy;
lin:=1; X1:=X; Y1:=Y;
end;
end;
procedure TRed.Image1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if (flag=3)and(lin=1) then
begin
line(b1,X1,Y1,X,Y);
Image1.Canvas.CopyRect(Rect(0,0,500,300),b1.Canvas,Rect(0,0,500,300));
bp.Canvas.CopyRect(Rect(0,0,500,300),b1.Canvas,Rect(0,0,500,300));
end;
if (flag=8)and(lin=1) then
begin
Image1.Canvas.CopyRect(Rect(0,0,500,300),b1.Canvas,Rect(0,0,500,300));
bp.Canvas.CopyRect(Rect(0,0,500,300),b1.Canvas,Rect(0,0,500,300));
end;
if (flag=4)and(lin=1) then
begin
//krug(X1,Y1,X,Y);
Image1.Canvas.CopyRect(Rect(0,0,500,300),b1.Canvas,Rect(0,0,500,300));
bp.Canvas.CopyRect(Rect(0,0,500,300),b1.Canvas,Rect(0,0,500,300));
end;
if (flag=5)and(lin=1) then
begin
ellips(X1,Y1,X,Y);
Image1.Canvas.CopyRect(Rect(0,0,500,300),b1.Canvas,Rect(0,0,500,300));
bp.Canvas.CopyRect(Rect(0,0,500,300),b1.Canvas,Rect(0,0,500,300));
end;
if (flag=7)and(lin=1) then
begin
Image1.Canvas.CopyRect(Rect(0,0,500,300),b1.Canvas,Rect(X1,Y1,X,Y));
bp.Canvas.CopyRect(Rect(0,0,500,300),Image1.Canvas,Rect(0,0,500,300));
bp.Canvas.Pen.Color:=RGB(0,0,0);
bp.Canvas.MoveTo(0,0);
bp.Canvas.LineTo(0,299);
bp.Canvas.LineTo(499,299);
bp.Canvas.LineTo(499,0);
bp.Canvas.LineTo(0,0);
Image1.Canvas.CopyRect(Rect(0,0,500,300),bp.Canvas,Rect(0,0,500,300));
end;
if (flag=6)and(lin=1) then
begin
line(b2,X1,Y1,X,Y);
line(b1,X1,Y1,X,Y);
X1:=X; Y1:=Y;
Xp1:=X; Yp1:=Y;
image1.Canvas.Pixels[x,y]:=Red.Shape1.Brush.Color;
//image1.Canvas.CopyMode:=cmSrcAnd;
//Image1.Canvas.CopyRect(Rect(0,0,500,300),b2.Canvas,Rect(0,0,500,300));
//image1.Canvas.CopyMode:=cmMergeCopy;
bp.Canvas.CopyRect(Rect(0,0,500,300),image1.Canvas,Rect(0,0,500,300));
end else lin:=0;
end;
procedure TRed.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var xx,yy:integer;
begin
if (flag=2)and(lin=1) then
begin
bp.Canvas.Pen.Color:=Shape1.Brush.Color;
bp.Canvas.MoveTo(X1,Y1);
bp.Canvas.LineTo(X,Y);
X1:=X; Y1:=Y;
Image1.Canvas.CopyRect(Rect(0,0,500,300),bp.Canvas,Rect(0,0,500,300));
end;
if (flag=3)and(lin=1) then
begin
line(b1,X1,Y1,X,Y);
Image1.Canvas.CopyRect(Rect(0,0,500,300),b1.Canvas,Rect(0,0,500,300));
b1.Canvas.CopyRect(Rect(0,0,500,300),bp.Canvas,Rect(0,0,500,300));
end;
if (flag=4)and(lin=1) then
begin
b1.Canvas.CopyRect(Rect(0,0,500,300),bp.Canvas,Rect(0,0,500,300));
krug(X1,Y1,x,y);
Image1.Canvas.CopyRect(Rect(0,0,500,300),b1.Canvas,Rect(0,0,500,300));
end;
if (flag=8)and(lin=1) then
begin
b1.Canvas.CopyRect(Rect(0,0,500,300),bp.Canvas,Rect(0,0,500,300));
duga(X1,x,Y1,y,StrToInt(Edit7.Text));
Image1.Canvas.CopyRect(Rect(0,0,500,300),b1.Canvas,Rect(0,0,500,300));
end;
if (flag=5)and(lin=1) then
begin
ellips(X1,Y1,x,y);
Image1.Canvas.CopyRect(Rect(0,0,500,300),b1.Canvas,Rect(0,0,500,300));
b1.Canvas.CopyRect(Rect(0,0,500,300),bp.Canvas,Rect(0,0,500,300));
end;
if (flag=7)and(lin=1) then
begin
line(b1,X1,Y1,X,Y1);
line(b1,X1,Y1,X1,Y);
line(b1,X,Y1,X,Y);
line(b1,X1,Y,X,Y);
Image1.Canvas.CopyRect(Rect(0,0,500,300),b1.Canvas,Rect(0,0,500,300));
b1.Canvas.CopyRect(Rect(0,0,500,300),bp.Canvas,Rect(0,0,500,300));
end;
if (flag=6)and(lin=1) then
begin
//Image1.Canvas.CopyMode:=cmSrcCopy;
//Image1.Canvas.CopyRect(Rect(0,0,500,300),bp.Canvas,Rect(0,0,500,300));
b2.Canvas.CopyMode:=cmMergeCopy;
b2.Canvas.CopyRect(Rect(0,0,500,300),b1.Canvas,Rect(0,0,500,300));
line(b2,X1,Y1,X,Y);
//Image1.Canvas.CopyMode:=cmSrcAnd;
//Image1.Canvas.CopyRect(Rect(0,0,500,300),b2.Canvas,Rect(0,0,500,300));
end;
end;
procedure TRed.BitBtn5Click(Sender: TObject);
begin
flag:=1; // Заливка
lin:=0;
end;
procedure TRed.BitBtn1Click(Sender: TObject);
begin
flag:=2;
if lin=1 then
begin
lin:=0;
polegon();
end;
end;
procedure TRed.BitBtn2Click(Sender: TObject);
begin
flag:=3;
if lin=1 then
begin
lin:=0;
polegon();
end;
end;
procedure TRed.Timer1Timer(Sender: TObject);
var r:Trect;
begin
r.Left:=0;
r.Top:=0;
r.Right:=500;
r.Bottom:=300;
Image1.Canvas.BrushCopy(r,bp,r,RGB(255,255,255));
end;
procedure TRed.Shape1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
ColorDialog1.Execute();
Shape1.Brush.Color:=ColorDialog1.Color;
end;
procedure TRed.BitBtn3Click(Sender: TObject);
begin
flag:=4;
if lin=1 then
begin
lin:=0;
polegon();
end;
end;
procedure TRed.BitBtn4Click(Sender: TObject);
begin
flag:=5;
if lin=1 then
begin
lin:=0;
polegon();
end;
end;
procedure TRed.BitBtn6Click(Sender: TObject);
begin
flag:=6;
if lin=1 then
begin
lin:=0;
polegon();
end;
end;
procedure TRed.Button1Click(Sender: TObject);
var
x1,y1,x2,y2,r:integer;
begin
b1.Canvas.CopyRect(Rect(0,0,500,300),bp.Canvas,Rect(0,0,500,300));
x1:=StrToInt(Edit3.Text)+250;
y1:=StrToInt(Edit4.Text)*(-1)+150;
x2:=StrToInt(Edit6.Text)+250;
y2:=StrToInt(Edit5.Text)*(-1)+150;
r:=StrToInt(Edit7.Text);
duga(x1,x2,y1,y2,r);
bp.Canvas.CopyRect(Rect(0,0,500,300),b1.Canvas,Rect(0,0,500,300));
Image1.Canvas.CopyRect(Rect(0,0,500,300),b1.Canvas,Rect(0,0,500,300));
end;
procedure TRed.BitBtn8Click(Sender: TObject);
begin
flag:=7;
if lin=1 then
begin
lin:=0;
polegon();
end;
end;
procedure TRed.Button2Click(Sender: TObject);
var
x1,y1,x2,y2:integer;
begin
b1.Canvas.CopyRect(Rect(0,0,500,300),bp.Canvas,Rect(0,0,500,300));
x1:=StrToInt(Edit1.Text)+250;
y1:=StrToInt(Edit2.Text)*(-1)+150;
x2:=StrToInt(Edit8.Text)+250;
y2:=StrToInt(Edit9.Text)*(-1)+150;
line(b1,x1,y1,x2,y2);
bp.Canvas.CopyRect(Rect(0,0,500,300),b1.Canvas,Rect(0,0,500,300));
Image1.Canvas.CopyRect(Rect(0,0,500,300),b1.Canvas,Rect(0,0,500,300));
end;
procedure TRed.Button3Click(Sender: TObject);
var
x1,y1,x2,y2:integer;
begin
b1.Canvas.CopyRect(Rect(0,0,500,300),bp.Canvas,Rect(0,0,500,300));
x1:=StrToInt(Edit10.Text)+250;
y1:=StrToInt(Edit11.Text)*(-1)+150;
x2:=StrToInt(Edit13.Text)+250;
y2:=StrToInt(Edit12.Text)*(-1)+150;
ellips(x1,y1,x2,y2);
bp.Canvas.CopyRect(Rect(0,0,500,300),b1.Canvas,Rect(0,0,500,300));
Image1.Canvas.CopyRect(Rect(0,0,500,300),b1.Canvas,Rect(0,0,500,300));
end;
procedure TRed.Button4Click(Sender: TObject);
var
x1,y1,x2,y2:integer;
begin
b1.Canvas.CopyRect(Rect(0,0,500,300),bp.Canvas,Rect(0,0,500,300));
x1:=StrToInt(Edit14.Text)+250;
y1:=StrToInt(Edit15.Text)*(-1)+150;
x2:=StrToInt(Edit17.Text)+250;
y2:=StrToInt(Edit16.Text)*(-1)+150;
krug(x1,y1,x2,y2);
bp.Canvas.CopyRect(Rect(0,0,500,300),b1.Canvas,Rect(0,0,500,300));
Image1.Canvas.CopyRect(Rect(0,0,500,300),b1.Canvas,Rect(0,0,500,300));
end;
procedure TRed.N1Click(Sender: TObject);
begin
if Red.OpenPictureDialog1.Execute then
begin
b1.LoadFromFile(Red.OpenPictureDialog1.FileName);
b1.Width:=500;
b1.Height:=300;
bp.Canvas.CopyRect(Rect(0,0,500,300),b1.Canvas,Rect(0,0,500,300));
Image1.Canvas.CopyRect(Rect(0,0,500,300),b1.Canvas,Rect(0,0,500,300));
Image1.Width:=500;
Image1.Height:=300;
bp.Width:=500;
bp.Height:=300;
end;
end;
procedure TRed.Save1Click(Sender: TObject);
begin
if Red.SavePictureDialog1.Execute() then
begin
Red.image1.Picture.SaveToFile(SavePictureDialog1.FileName+'.bmp');
end;
end;
procedure TRed.Exit1Click(Sender: TObject);
begin
Red.Close;
end;
procedure TRed.New1Click(Sender: TObject);
begin
b2.Canvas.Brush.Color:=RGB(255,255,255);
b2.Canvas.FillRect(Rect(0,0,500,300));
bp.Canvas.Brush.Color:=RGB(255,255,255);
bp.Canvas.FillRect(Rect(0,0,500,300));
b1.Canvas.Brush.Color:=RGB(255,255,255);
b1.Canvas.FillRect(Rect(0,0,500,300));
b2.Canvas.MoveTo(0,0);
b2.Canvas.LineTo(0,299);
b2.Canvas.LineTo(499,299);
b2.Canvas.LineTo(499,0);
b2.Canvas.LineTo(0,0);
b1.Canvas.CopyRect(Rect(0,0,500,300),b2.Canvas,Rect(0,0,500,300));
bp.Canvas.CopyRect(Rect(0,0,500,300),b2.Canvas,Rect(0,0,500,300));
Image1.Canvas.CopyRect(Rect(0,0,500,300),bp.Canvas,Rect(0,0,500,300));
end;
procedure TRed.BitBtn7Click(Sender: TObject);
begin
flag:=8;
if lin=1 then
begin
lin:=0;
polegon();
end;
end;
end
2) Пример работы программы:
Лабораторная работа №9,10
Графическое представление данных
Цель работы: Изучить возможности вывода результатов моделирования временных процессов в виде графиков
Постановка задачи: Разработать программу отображения результатов вычисления определенного интеграла (из работы №3) в графической форме с помощью компонента TChar.
Табличное представление данных
Цель работы: Изучить способы построения таблиц и использование их для ввода и вывода данных
Постановка задачи: Дополнить программу из работы №9 выходными результатами в табличной форме
1)Листинг программы:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Menus;
type
TForm1 = class(TForm)
Label4: TLabel;
Button1: TButton;
ColorDialog1: TColorDialog;
Button2: TButton;
Button3: TButton;
PopupMenu1: TPopupMenu;
gfjfjggf1: TMenuItem;
gfhf1: TMenuItem;
fghgfhf1: TMenuItem;
fghgfh1: TMenuItem;
Label1: TLabel;
Label3: TLabel;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
Col: TColor;
int,intp,pogr,rashcet : Real;
implementation
uses Unit2;
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
begin
Col:=Form1.Color;
if ColorDialog1.Execute()=True then
Col:=ColorDialog1.Color;
Form1.Color:=Col;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
int:=0;
pogr:=0;
rashcet:=0;
Application.CreateForm(TForm2,Form2);
Form2.ShowModal;
Form2.Free;
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
close;
end;
end.
unit Unit2;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, jpeg, ExtCtrls;
type
TForm2 = class(TForm)
Button1: TButton;
Button2: TButton;
Button3: TButton;
Label1: TLabel;
Label2: TLabel;
Button4: TButton;
Label8: TLabel;
Image1: TImage;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form2: TForm2;
implementation
uses Unit1, Unit3;
{$R *.dfm}
function f(x:real):real; {интегрируемая функция}
begin
f:=1/sqrt(1+3*x+2*x*x);
end;
procedure TForm2.Button1Click(Sender: TObject);
begin
Form2.close;
end;
procedure TForm2.Button2Click(Sender: TObject);
var h,i,z,a,b,n:real; {описание переменных}
begin
a:=0;b:=1;
n:=40;z:=0;
h:=(b-a)/n;
i:=a;
while (i<=b) do {цикл расчета по формуле трапеций}
begin
z:=z+h*(f(i)+f(i+h))/2;
i:=i+h;
end; {конец цикла}
int:=z;
rashcet:=rashcet+1;
Label1.Caption:='Ответ на 3 форме';
end;
procedure TForm2.Button4Click(Sender: TObject);
begin
if rashcet>1 then begin
Application.CreateForm(TForm3,Form3);
Form3.ShowModal;
Form3.Free;
end else
Application.MessageBox('Ошибка! Интегралл или погрешность еще не рассчитаны.', 'Внимание!!!',0);
end;
procedure TForm2.Button3Click(Sender: TObject);
var vv,nn:real;
begin
if rashcet=1 then begin
vv:=1/sqrt(2)*ln((1.75/1.25)+(sqrt(3.0625-0.0625)/1.25));
nn:=1/sqrt(2)*ln((0.75/1.25)+(sqrt(0.5625-0.0625)/1.25));
intp:=vv-nn;
pogr:=abs(int-intp);
rashcet:=rashcet+1;
Label2.Caption:='Погрешность рассчитана';
end else
Application.MessageBox('Ошибка! Интегралл еще не рассчитан.', 'Внимание!!!',0);
end;
end.
unit Unit3;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, TeEngine, Series, ExtCtrls, TeeProcs, Chart, Grids;
type
TForm3 = class(TForm)
Button1: TButton;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Chart1: TChart;
Series1: TFastLineSeries;
StringGrid1: TStringGrid;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form3: TForm3;
implementation
uses Unit1, Unit2;
{$R *.dfm}
function f(x:real):real; {интегрируемая функция}
begin
f:=1/sqrt(1+3*x+2*x*x);
end;
procedure TForm3.Button1Click(Sender: TObject);
begin
Form3.close;
end;
procedure TForm3.FormCreate(Sender: TObject);
var i:integer;
clr:TColor;
im,ib,a,b:real;
inn:integer;
begin
Label2.Caption:=FloatToStr(int);
Label4.Caption:=FloatToStr(pogr);
Chart1.Series[0].Clear;
a:=0;b:=1;
im:=a;
inn:=1000;
ib:=(b-a)/inn;
for i:=0 to inn-1 do
begin
Chart1.Series[0].AddXY(im,f(im),'',clr);
im:=im+ib;
end;
StringGrid1.Cells[0,0]:='Функция';
StringGrid1.Cells[0,1]:='a=';
StringGrid1.Cells[0,2]:='b=';
StringGrid1.Cells[0,3]:='Интеграл равен';
StringGrid1.Cells[0,4]:='Погрешность';
StringGrid1.Cells[1,0]:='f(x)=1/sqrt(1+3*x+2*x*x)';
StringGrid1.Cells[1,1]:=FloatToStr(a);
StringGrid1.Cells[1,2]:=FloatToStr(b);
StringGrid1.Cells[1,3]:=FloatToStr(int);
StringGrid1.Cells[1,4]:=FloatToStr(pogr);
end;
end.
2) Пример работы программы:
Лабораторная работа №11
Управление программой с помощью панели инструментов
Цель работы: Научиться подключать инструментальную панель, изучить основные свойства и типы кнопок и использование их для управления вычислительным процессом
Постановка задачи: Разработать программу вычисления интеграла различными методами, при этом управление вычислительным процессом осуществлять с помощью кнопок, расположенных на инструментальной панели.
1)Листинг программы:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ComCtrls, ToolWin, StdCtrls, ExtCtrls, ImgList, jpeg;
type
TForm1 = class(TForm)
Label4: TLabel;
Label1: TLabel;
Label3: TLabel;
ToolBar1: TToolBar;
ToolButton1: TToolButton;
ToolButton2: TToolButton;
ToolButton3: TToolButton;
ToolButton4: TToolButton;
ToolButton5: TToolButton;
RadioGroup1: TRadioGroup;
Edit1: TEdit;
Button1: TButton;
ImageList1: TImageList;
Label8: TLabel;
Image1: TImage;
procedure ToolButton1Click(Sender: TObject);
procedure ToolButton3Click(Sender: TObject);
procedure ToolButton5Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
Check: Byte;
implementation
{$R *.dfm}
function AbsReal(X : Extended):Extended;
begin
Result := Abs(X);
end;
function F(X : Double):Double;
begin
Result:=1/sqrt(1+3*x+2*x*x);
end;
function IntegralRect(a : Double; b : Double; Epsilon : Double):Double;
var
i : Integer;
n : Integer;
h : Double;
s1 : Double;
s2 : Double;
begin
n := 1;
h := b-a;
s2 := h*F((a+b)/2);
repeat
n := 2*n;
s1 := s2;
h := h/2;
s2 := 0;
i := 1;
repeat
s2 := s2+F(a+h/2+h*(i-1));
i := i+1;
until not (i<=n);
s2 := s2*h;
until not (AbsReal(s2-s1)>3*Epsilon);
Result := s2;
end;
function IntegralTrap(a : Double; b : Double; Epsilon : Double):Double;
var
i : Integer;
n : Integer;
h : Double;
s1 : Double;
s2 : Double;
begin
n := 1;
h := b-a;
s2 := h*(F(a)+F(b))/2;
repeat
s1 := s2;
s2 := 0;
i := 1;
repeat
s2 := s2+F(a-h/2+h*i);
i := i+1;
until not (i<=n);
s2 := s1/2+s2*h/2;
n := 2*n;
h := h/2;
until not (AbsReal(s2-s1)>3*Epsilon);
Result := s2;
end;
function IntegralSimps(a : Double; b : Double; Epsilon : Double):Double;
var
h : Double;
s : Double;
s1 : Double;
s2 : Double;
s3 : Double;
x : Double;
begin
s2 := 1;
h := b-a;
s := F(a)+F(b);
repeat
s3 := s2;
h := h/2;
s1 := 0;
x := a+h;
repeat
s1 := s1+2*F(x);
x := x+2*h;
until not (x
s := s+s1;
s2 := (s+s1)*h/3;
x := AbsReal(s3-s2)/15;
until not (x>Epsilon);
Result := s2;
end;
procedure TForm1.ToolButton1Click(Sender: TObject);
begin
RadioGroup1.ItemIndex:=0;
Check:=1;
form1.Edit1.Text:='';
end;
procedure TForm1.ToolButton3Click(Sender: TObject);
begin
RadioGroup1.ItemIndex:=1;
Check:=2;
form1.Edit1.Text:='';
end;
procedure TForm1.ToolButton5Click(Sender: TObject);
begin
RadioGroup1.ItemIndex:=2;
Check:=3;
form1.Edit1.Text:='';
end;
procedure TForm1.Button1Click(Sender: TObject);
var s:String ;
begin
case Check of
1:str(IntegralRect(0,1,0.0001):10:7,s);
2:str(IntegralTrap(0,1,0.0001):10:7,s);
3:str(IntegralSimps(0,1,0.0001):10:7,s);
end ;
form1.Edit1.Text:=s;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Check:=1;
end;
end
2) Пример работы программы:
Лабораторная работа №12
Стандартные диалоговые компоненты
Цель работы: Изучить способы работы с основными стандартными диалоговыми компонентами
Постановка задачи: Разработать программу, в которой предусмотреть сохранение значения определенного интеграла и его графического образа в файле. При помощи локального меню предоставить также возможность чтения образа интеграла, ранее сохраненного в файле, в компоненту класса TImage.
1)Листинг программы:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Menus;
type
TForm1 = class(TForm)
Label4: TLabel;
Button1: TButton;
ColorDialog1: TColorDialog;
Button2: TButton;
Button3: TButton;
PopupMenu1: TPopupMenu;
gfjfjggf1: TMenuItem;
gfhf1: TMenuItem;
fghgfhf1: TMenuItem;
fghgfh1: TMenuItem;
Label1: TLabel;
Label3: TLabel;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
Col: TColor;
int,intp,pogr,rashcet : Real;
implementation
uses Unit2;
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
begin
Col:=Form1.Color;
if ColorDialog1.Execute()=True then
Col:=ColorDialog1.Color;
Form1.Color:=Col;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
int:=0;
pogr:=0;
rashcet:=0;
Application.CreateForm(TForm2,Form2);
Form2.ShowModal;
Form2.Free;
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
close;
end;
end.
unit Unit2;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, jpeg, ExtCtrls;
type
TForm2 = class(TForm)
Button1: TButton;
Button2: TButton;
Button3: TButton;
Label1: TLabel;
Label2: TLabel;
Button4: TButton;
Label8: TLabel;
Image1: TImage;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form2: TForm2;
implementation
uses Unit1, Unit3;
{$R *.dfm}
function f(x:real):real; {интегрируемая функция}
begin
f:=1/sqrt(1+3*x+2*x*x);
end;
procedure TForm2.Button1Click(Sender: TObject);
begin
Form2.close;
end;
procedure TForm2.Button2Click(Sender: TObject);
var h,i,z,a,b,n:real; {описание переменных}
begin
a:=0;b:=1;
n:=40;z:=0;
h:=(b-a)/n;
i:=a;
while (i<=b) do {цикл расчета по формуле трапеций}
begin
z:=z+h*(f(i)+f(i+h))/2;
i:=i+h;
end; {конец цикла}
int:=z;
rashcet:=rashcet+1;
Label1.Caption:='Ответ на 3 форме';
end;
procedure TForm2.Button4Click(Sender: TObject);
begin
if rashcet>1 then begin
Application.CreateForm(TForm3,Form3);
Form3.ShowModal;
Form3.Free;
end else
Application.MessageBox('Ошибка! Интегралл или погрешность еще не рассчитаны.', 'Внимание!!!',0);
end;
procedure TForm2.Button3Click(Sender: TObject);
var vv,nn:real;
begin
if rashcet=1 then begin
vv:=1/sqrt(2)*ln((1.75/1.25)+(sqrt(3.0625-0.0625)/1.25));
nn:=1/sqrt(2)*ln((0.75/1.25)+(sqrt(0.5625-0.0625)/1.25));
intp:=vv-nn;
pogr:=abs(int-intp);
rashcet:=rashcet+1;
Label2.Caption:='Погрешность рассчитана';
end else
Application.MessageBox('Ошибка! Интегралл еще не рассчитан.', 'Внимание!!!',0);
end;
end.
unit Unit3;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, TeEngine, Series, ExtCtrls, TeeProcs, Chart, Menus,
ExtDlgs;
type
TForm3 = class(TForm)
Button1: TButton;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Chart1: TChart;
Series1: TFastLineSeries;
Image1: TImage;
OpenPictureDialog1: TOpenPictureDialog;
SaveDialog1: TSaveDialog;
MainMenu1: TMainMenu;
N1: TMenuItem;
N3: TMenuItem;
N2: TMenuItem;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure N3Click(Sender: TObject);
procedure N2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form3: TForm3;
implementation
uses Unit1, Unit2;
{$R *.dfm}
function f(x:real):real; {интегрируемая функция}
begin
f:=1/sqrt(1+3*x+2*x*x);
end;
procedure TForm3.Button1Click(Sender: TObject);
begin
Form3.close;
end;
procedure TForm3.FormCreate(Sender: TObject);
var i:integer;
clr:TColor;
im,ib,a,b:real;
inn:integer;
begin
Label2.Caption:=FloatToStr(int);
Label4.Caption:=FloatToStr(pogr);
Chart1.Series[0].Clear;
a:=1;b:=2;
im:=a;
inn:=1000;
ib:=(b-a)/inn;
for i:=0 to inn-1 do
begin
Chart1.Series[0].AddXY(im,f(im),'',clr);
im:=im+ib;
end;
end;
procedure TForm3.N3Click(Sender: TObject);
begin
SaveDialog1.InitialDir:=extractfilepath(application.ExeName);
if savedialog1.Execute then
begin
if extractfileExt(SaveDialog1.FileName)<>'.bmp' then SaveDialog1.FileName:=SaveDialog1.FileName+'.bmp';
Chart1.SaveToBitmapFile(SaveDialog1.FileName);
end;
end;
procedure TForm3.N2Click(Sender: TObject);
begin
SaveDialog1.InitialDir:=extractfilepath(application.ExeName);
if OpenPictureDialog1.Execute then
Image1.Picture.LoadFromFile(OpenPictureDialog1.FileName);
end;
end.
2) Пример работы программы:
Лабораторная работа №13
Создание многостраничного документа
Цель работы: Изучить компоненты TPageControl, TTabSheet
Постановка задачи: Разработать программу ввода данных, выбора метода расчета, расчета и представления результатов в табличной и графической формах на примере вычисления определенного интеграла, реализуя отдельные вычислительные шаги на различных закладках многостраничного документа.
1)Листинг программы:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ComCtrls, StdCtrls, ExtCtrls, TeEngine, Series, TeeProcs, Chart,
Grids;
type
TForm1 = class(TForm)
PageControl1: TPageControl;
TabSheet1: TTabSheet;
TabSheet2: TTabSheet;
TabSheet3: TTabSheet;
TabSheet4: TTabSheet;
ComboBox1: TComboBox;
RadioGroup1: TRadioGroup;
Button1: TButton;
Button2: TButton;
Button3: TButton;
Button4: TButton;
Button5: TButton;
Button6: TButton;
Edit1: TEdit;
Label1: TLabel;
Chart1: TChart;
Series1: TFastLineSeries;
StringGrid1: TStringGrid;
Button8: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button5Click(Sender: TObject);
procedure Button6Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure ComboBox1Change(Sender: TObject);
procedure RadioGroup1Click(Sender: TObject);
procedure Button8Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
a,b:real;
implementation
{$R *.dfm}
function AbsReal(X : Extended):Extended;
begin
Result := Abs(X);
end;
function F(X : Double):Double;
begin
If Form1.ComboBox1.Text='f(x)=sin(x)' Then Result:=sin(x);
If Form1.ComboBox1.Text='f(x)=cos(x)' Then Result:=cos(x);
If Form1.ComboBox1.Text='f(x)=ln(x)' Then Result:=ln(x);
end;
function IntegralRect(a : Double; b : Double; Epsilon : Double):Double;
var
i : Integer;
n : Integer;
h : Double;
s1 : Double;
s2 : Double;
begin
n := 1;
h := b-a;
s2 := h*F((a+b)/2);
repeat
n := 2*n;
s1 := s2;
h := h/2;
s2 := 0;
i := 1;
repeat
s2 := s2+F(a+h/2+h*(i-1));
i := i+1;
until not (i<=n);
s2 := s2*h;
until not (AbsReal(s2-s1)>3*Epsilon);
Result := s2;
end;
function IntegralTrap(a : Double; b : Double; Epsilon : Double):Double;
var
i : Integer;
n : Integer;
h : Double;
s1 : Double;
s2 : Double;
begin
n := 1;
h := b-a;
s2 := h*(F(a)+F(b))/2;
repeat
s1 := s2;
s2 := 0;
i := 1;
repeat
s2 := s2+F(a-h/2+h*i);
i := i+1;
until not (i<=n);
s2 := s1/2+s2*h/2;
n := 2*n;
h := h/2;
until not (AbsReal(s2-s1)>3*Epsilon);
Result := s2;
end;
function IntegralSimps(a : Double; b : Double; Epsilon : Double):Double;
var
h : Double;
s : Double;
s1 : Double;
s2 : Double;
s3 : Double;
x : Double;
begin
s2 := 1;
h := b-a;
s := F(a)+F(b);
repeat
s3 := s2;
h := h/2;
s1 := 0;
x := a+h;
repeat
s1 := s1+2*F(x);
x := x+2*h;
until not (x
s := s+s1;
s2 := (s+s1)*h/3;
x := AbsReal(s3-s2)/15;
until not (x>Epsilon);
Result := s2;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
PageControl1.ActivePage:=TabSheet2;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
PageControl1.ActivePage:=TabSheet3;
end;
procedure TForm1.Button5Click(Sender: TObject);
begin
PageControl1.ActivePage:=TabSheet2;
end;
procedure TForm1.Button6Click(Sender: TObject);
begin
PageControl1.ActivePage:=TabSheet3;
end;
procedure TForm1.Button4Click(Sender: TObject);
begin
PageControl1.ActivePage:=TabSheet1;
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
PageControl1.ActivePage:=TabSheet4;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
a:=1;b:=2;
StringGrid1.Cells[0,0]:='Функция';
StringGrid1.Cells[0,1]:='a=';
StringGrid1.Cells[0,2]:='b=';
StringGrid1.Cells[0,3]:='Интеграл равен';
PageControl1.ActivePage:=TabSheet1;
end;
procedure TForm1.ComboBox1Change(Sender: TObject);
begin
Chart1.Series[0].Clear;
StringGrid1.Cells[1,0]:='';
StringGrid1.Cells[1,1]:='';
StringGrid1.Cells[1,2]:='';
StringGrid1.Cells[1,3]:='';
form1.Edit1.Text:='';
end;
procedure TForm1.RadioGroup1Click(Sender: TObject);
begin
Chart1.Series[0].Clear;
StringGrid1.Cells[1,0]:='';
StringGrid1.Cells[1,1]:='';
StringGrid1.Cells[1,2]:='';
StringGrid1.Cells[1,3]:='';
form1.Edit1.Text:='';
end;
procedure TForm1.Button8Click(Sender: TObject);
var s:String ;
i:integer;
clr:TColor;
im,ib:real;
inn:integer;
begin
case RadioGroup1.ItemIndex of
0:str(IntegralRect(1,2,0.0001):10:7,s);
1:str(IntegralTrap(1,2,0.0001):10:7,s);
2:str(IntegralSimps(1,2,0.0001):10:7,s);
end ;
form1.Edit1.Text:=s;
Chart1.Series[0].Clear;
a:=1;b:=2;
im:=a;
inn:=1000;
ib:=(b-a)/inn;
for i:=0 to inn-1 do
begin
Chart1.Series[0].AddXY(im,f(im),'',clr);
im:=im+ib;
end;
If Form1.ComboBox1.Text='f(x)=sin(x)' Then StringGrid1.Cells[1,0]:='sin(x)';
If Form1.ComboBox1.Text='f(x)=cos(x)' Then StringGrid1.Cells[1,0]:='cos(x)';
If Form1.ComboBox1.Text='f(x)=ln(x)' Then StringGrid1.Cells[1,0]:='ln(x)';
StringGrid1.Cells[1,1]:=FloatToStr(a);
StringGrid1.Cells[1,2]:=FloatToStr(b);
StringGrid1.Cells[1,3]:=s;
end;
end.
2) Пример работы программы:
