Листинг а.14.1 - Программа обработки базы данных(модуль а) на языке Pascal

Unit File_Rec;

Interface

Function FileExists(FileName: String): Boolean;

Function Pust(FileName: string; F: boolean):boolean;

Procedure DirCat;

Implementation

Uses Input, Dos;

Const

NoFile='Файла не существует!!! ';

PovtVvod=' Повторите ввод ';

function FileExists(FileName: String): Boolean;

var

F: file;

begin

{$I-}

Assign(F, FileName);

Reset(F);

Close(F);

{$I+}

FileExists := (IOResult = 0) and (FileName <> '');

end; { FileExists }

Function Pust(FileName: string; F: boolean):boolean;

Var D: SearchRec;

begin

Pust:=true;

FindFirst(FileName, AnyFile, D);

If DosError<>0 then

begin

Pust:=False;

if F then OutMessageXY(20,24,NoFile,PovtVvod);

end

end;

Procedure DirCat;

Var s : SearchRec;

i : Byte;

begin

FindFirst('*.*', AnyFile, s);

Writeln(' Список файлов текущего каталога');

Writeln;

While DosError=0 do

begin

i:=i+1;

if i<5 then write(s.Name:15)

else

begin

writeln(s.Name:15);

i:=0;

end;

FindNext(s)

end;

Writeln

end;

End.

Листинг А.14.2 - Программа обработки базы данных (модуль Б) на языке Pascal

Unit Input;

Interface

Function IntToStr(I: Longint) : String;

Procedure OutMessageXY(X,Y:Byte;Str1,Str2:String);

Procedure OutPutString(Color, Fon, TaOld, Width: Byte);

Function error(Message: string; NumberMin, NumberMax: LongInt):boolean;

Function error1:boolean;

Procedure InputString(Var S: String; LenNaimt: byte; Inv: String);

Ё б® бва®Є®© ЇаЁЈ« иҐ­Ёп Inv}

Procedure InputNumber(Var Number: Real; NumberMin, NumberMax: LongInt;

Width: Byte; Inv: String);

Procedure InputReal(Var R: Real; Width: Byte; Inv: String);

Implementation

Uses CRT;

Const

ErrMes=' Ошибка ввода!!! ';

MesNumb='Численное значение должно быть в диапазоне ';

TaOld=15;

TaNew=Red+16*LightGray+Blink;

Color=Yellow;

Fon =Blue;

Var flag: boolean;

Function IntToStr(I: Longint): String;

var

S: string[11];

begin

Str(I, S);

IntToStr := S;

end;

Procedure OutMessageXY(X,Y:Byte;Str1,Str2:String);

Var Xcur, Ycur: byte;

Begin

Xcur:=WHereX;

Ycur:=WHereY;

GotoXY(X, Y);

TextAttr:=TaNew;

Write(Str1,Str2);

TextAttr:=TaOld;

GotoXY(Xcur, Ycur);

End;

Procedure OutPutString(Color, Fon, TaOld, Width: Byte);

Var Str: String;

i, Xcur, Ycur: byte;

Begin

Xcur:=WHereX;

Ycur:=WHereY;

Str:='';

TextAttr:=Color+16*Fon;

for i:=1 to Width do Str:=Str + ' ';

Write(Str);

TextAttr:=TaOld;

GotoXY(Xcur, Ycur);

End;

Function error(Message: string; NumberMin, NumberMax: LongInt):boolean;

Var Mes: string;

begin

error:=true;

if flag then

begin

Mes:=ErrMes + Message;

writeln(Mes, '[', NumberMin, '..', NumberMax,']');

error:=false;

end;

end;

Function error1:boolean;

Var Mes: string;

begin

error1:=true;

if flag then

begin

Mes:=ErrMes + ' Введено НЕ число....';

writeln(Mes);

error1:=false;

end;

end;

Procedure InputString(Var S: String; LenNaimt: byte; Inv: String);

Begin

repeat

flag:=false;

Write(Inv,'===>');

OutPutString(Color, Fon, TaOld, LenNaimt);

Readln(S);

if length(S)>LenNaimt then flag:=true;

until error('Количество символов в строке должно быть в диапазоне',1,LenNaimt);

End;

Procedure InputNumber(Var Number: Real; NumberMin, NumberMax: LongInt;

Width: Byte; Inv: String);

Begin

repeat

flag:=false;

Write(Inv,'===>');

OutPutString(Color, Fon, TaOld, Width);

{$I-}

Readln(Number);

{$I+}

if IOResult<>0 then flag:=true

else if (Number<NumberMin) or (Number>NumberMax) then flag:=true;

until error(MesNumb, NumberMin, NumberMax);

End;

Procedure InputReal(Var R: Real; Width: Byte; Inv: String);

Begin

repeat

flag:=false;

Write(Inv,'===>');

OutPutString(Color, Fon, TaOld, Width);

{$I-}

Readln(R);

{$I+}

if IOResult<>0 then flag:=true;

until error1;

End;

end.

Листинг А.15 – Использование и подключение модуля Graph

uses crt,graph;

procedure Flag(xc,yc,r,c0,c1,c2,c3,c4,c5:integer); {процедура создания флага}

begin

setcolor(c0); {задает цвет для фона}

rectangle(xc,yc,xc+8*r,yc+4*r); { формула для прямоугольника}

setfillstyle(1,c0); {цвет для фона флага}

bar(xc,yc,xc+8*r,yc+4*r);{формула для круга

setlinestyle(0,0,3); {цвет линий}

setcolor(c1); {цвет для круга 1}

circle(xc+2*r,yc+3*r div 2,r); {формула для круга}

setcolor(c2); {цвет для круга 2}

circle(xc+4*r,yc+3*r div 2,r); {формуля для круга

setcolor(c3); {цвет для круга 3}

circle(xc+6*r,yc+3*r div 2,r); {формула для круга}

setcolor(c4); {цвет для круга 4}

circle(xc+3*r,yc+5*r div 2,r); {формула для круга}

setcolor(c5); {цвет для круга 5}

circle(xc+5*r,yc+5*r div 2,r); {формула для круга}

end;

var gd,gm,x,y,r,dx,dy:integer; {основная программа}

begin

gd:=0;

initgraph(gd,gm,''); {использование графа}

x:=10;y:=10;r:=10; {значения для координат и радиуса}

dx:=8;dy:=6;

Flag(x,y,r,15,9,8,12,14,10); {координаты флага}

repeat

delay(700); {задержка при перемещении флага}

Flag(x,y,r,0,0,0,0,0,0); {начальные координаты флага}

x:=x+dx;y:=y+dy; {формула для координат}

Flag(x,y,r,15,9,8,12,14,10); {координаты флага}

until (x>getmaxX-r*8)or(y>getmaxY-r*4); {условие повторения}

Flag(x,y,r,15,9,8,12,14,10); {координаты флага}

setcolor(12);

outtextXY(getmaxX div 2-90,getmaxY div 2,'Programma zavershena, Press Enter'); {вывод текста по некоторым координатам}

readln {останавливает программу}

end.

Листинг А.16 – Использование объектно-ориентированного программирования

uses graph,crt;

type krug=object

x,y,r,c:integer;

procedure Draw;{порождение}

procedure NewColor(c1:integer);{изменение цвета}

procedure NewRadius(r1:integer);{изменение размеров}

end;

zkr_krg=object(krug):{наследуются от объекта krug}

x,y,r,c

procedure Init

procedure NewColor

procedure NewRadius

procedure Draw;{новая}

end;

procedure krug.draw;{ создание круга}

begin

setcolor(c); {задает цвет}

circle(x,y,r); {координаты и радиус круга}

end;

procedure krug.NewColor(c1:integer); {создание круга с новым цветом}

begin

c:=c1;

end;

procedure krug.NewRadius(r1:integer); {новый радиус круга}

begin

r:=r1;

end;

procedure zkr_krg.draw; {наследование круга}

begin

setcolor(c); {задает цвет}

circle(x,y,r); {круг}

setfillstyle(1,c);

floodfill(x,y,c);

end;

var xc,yc,i,r1,r2,r3,r:integer; {основная программа}

k:array[1..50] of krug;

zk:zkr_krg; {наследование}

kf:real;

begin

randomize;

initgraph(xc,yc,''); {использование графа}

xc:=getmaxX div 2;

yc:=getmaxY div 2;

r1:=10;

r2:=20;

r3:=50;

r:=(r2+r3)div 2; {радиус основного круга}

for i:=1 to 50 do {Создание 50 кругов}

begin

k[i].NewRadius(r1); {радиус для первого круга}

k[i].x:=random(2*xc-2*k[i].r)+k[i].r; {формула координат и радиуса для кругов по Х}

k[i].y:=random(2*yc-2*k[i].r)+k[i].r; {формула координат и радиуса для кругов по Y}

end;

zk.x:=xc;

zk.y:=yc;

zk.NewColor(14); {задает новый цвет}

kf:=1.1;

repeat

cleardevice; {отчистка}

for i:=1 to 50 do {цикл для создания 50 кругов}

begin

k[i].NewColor(random(15)+1); {задает значение случайных цветов}

k[i].draw;

end;

r:=round(r*kf);

zk.NewRadius(r);

if r>=r3 then kf:=0.9; {если Основной радиус больше чем радиус 3, тогда радиус случайных кругов будет равен 0.9}

if r<=r2 then kf:=1.1; {если Основной радиус меньше чем радиус 2, тогда радиус случайных кругов будет равен 1.1}

zk.draw; {вызов процедуры круга}

delay(300); {задержка 300 мс}

until keypressed; {программа будет закончена после нажатия клавиши}

end.

Листинг А.17 – Разработка разветвляющихся программ

unit Unit1;

interface

uses

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

Dialogs, StdCtrls, ExtCtrls;

type

TForm1 = class(TForm)

edt1: TEdit;

edt2: TEdit;

rg1: TRadioGroup;

mmo1: TMemo;

btn1: TButton;

procedure btn1Click(Sender: TObject);

procedure FormCreate(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.btn1Click(Sender: TObject);

var l,x,y,a:Real;

d,b:string;

begin

x:=StrToFloat(edt1.Text);

y:=StrToFloat(edt2.Text);

if rg1.ItemIndex=0 then

begin

x:=Exp(2*ln(a));

d:='0';

b:='x^2=';

end;

if rg1.ItemIndex=1 then

begin

x:=(Exp(a)-exp(-a))/2

d:='1';

b:='sh(x)='

end;

if rg1.ItemIndex=2 then

begin

x:=Exp(a*ln(2.7));

d:='2';

b:='e^x=';

end;

if (x/y)>0 then // условие для x/y>0

begin

l:=Ln((x)+((x*x)+y)*(x*x)+y)*(x*x)+y;

mmo1.Lines[StrToInt(d)]:=b+FloatToStr(l);

end;

if (x/y)<0 then // условие для x/y<0

begin

l:=ln(abs(x/y)+((x+y)*(x+y)*(x+y)));

mmo1.Lines[StrToInt(d)]:=b+FloatToStr(l);

end;

if (x=0) and (y=0) then // условие для x=0 и y=0 (не выполняется)

begin

l:=((x*x)+y)*(x*x)+y*(x*x)+y;

mmo1.Lines[StrToInt(d)]:=b+FloatToStr(l);

end;

end;

procedure TForm1.FormCreate(Sender: TObject); // добавление в в окно вывода ответов

begin

mmo1.Clear;

mmo1.Lines.Add('x^2=');

mmo1.Lines.Add('sh(x)=');

mmo1.Lines.Add('e^x=');

end;

end.

Листинг А.17 – Разработка циклических алгоритмов

unit Unit1;

interface

uses

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

Dialogs, StdCtrls;

type

TForm1 = class(TForm)

Memo1: TMemo;

Button1: TButton;

Edit1: TEdit;

Label1: TLabel;

Label2: TLabel;

procedure Button1Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);

var

l : String;

s,i, Len : Integer;

begin

l := edit1.Text; // вводим данные.

Len := Length(l); // перевод в строку.

i := Len - (Len mod 3);

// перебор символов с шагом = 3.

while i >= 3 do begin

l[i] := '-';

Insert('99', l, i + 1);

Dec(i, 3);

end;

Memo1.Text := l; // вывод ответа с измененными элементами

end;

end.

Листинг А.19 – Обработка массивов

unit Unit1;

interface

uses

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

Dialogs, StdCtrls, Grids;

type

TForm1 = class(TForm)

StringGrid1: TStringGrid;

StringGrid2: TStringGrid;

button1: TButton;

Edit1: TEdit;

Label1: TLabel;

button2: TButton;

procedure FormCreate(Sender: TObject);

procedure button1Click(Sender: TObject);

procedure button2Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

Const

nmax=10; //максимальная размерность массива

type

//объявление типа двумерного массива

mas2=array[1..NMax,1..Nmax] of extended;

mas1=array[1..NMax] of Extended; //объявление типа одномерного массива

var

Form1: TForm1;

a:mas2;

b,y:mas1;

n,i,j:integer;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);

begin

n:=3; //размерность массива

//задание числа строк и столбцов для матриц

Edit1.Text:=floattostr(n);

StringGrid1.ColCount:=n+1;

StringGrid1.rowCount:=n+1;

StringGrid2.rowCount:=n+1;

StringGrid1.rowCount:=n+1;

//Заполнение верхнего и левого столбцов надписями

StringGrid1.Cells[0,0]:='Массив A';

StringGrid2.Cells[0,0]:='Массив В';

for i:=1 to n do

begin

StringGrid1.Cells[0,i]:='i='+Inttostr(i);

StringGrid1.Cells[i,0]:='j='+Inttostr(i);

end;

end;

procedure TForm1.button1Click(Sender: TObject);

begin

n:=StrToInt(Edit1.Text);

StringGrid1.ColCount:=n+1;

StringGrid1.rowCount:=n+1;

StringGrid2.rowCount:=n+1;

StringGrid1.rowCount:=n+1;

for i:=1 to n do

begin

StringGrid1.Cells[0,i]:='i='+Inttostr(i); //перевод элемента i

StringGrid1.Cells[i,0]:='j='+Inttostr(i);

end;

end;

procedure TForm1.button2Click(Sender: TObject);

var s,buf:Extended;

min:Integer;

begin

for i:=1 to n do

for j:=1 to n do

a[i,j]:=StrToFloat(StringGrid1.Cells[j,i]); // перевод массива

for i:=1 to n do

for j:=1 to n do begin

if a[i,j]> a[i+1,j+1] then b[i]:=1 else b[i]:=0; // замена элемента

end;

for i:=1 to n do

StringGrid2.Cells[0,i]:=floatToStrF(b[i],fffixed,6,2)

end;

end.

Листинг А.20 – Обработка строк.

unit Unit1;

interface

uses

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

Dialogs, StdCtrls;

type

TForm1 = class(TForm)

Memo1: TMemo;

Memo2: TMemo;

Button1: TButton;

Label1: TLabel;

Label2: TLabel;

procedure Button1Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);

const

D = ['0', '1'];

var

S : String;

i, Len, Cnt, CntMin, IMin : Integer;

begin

S := Memo1.Text;

Len := Length(S);

IMin := 0;

CntMin := Len;

Cnt := 0;

for i := 1 to Len do begin

if not (S[i] in D) then Continue;

Inc(Cnt);

if (i = Len) or (S[i] <> S[i + 1]) then begin // сравнение элементов

if (Cnt < CntMin) then begin

CntMin := Cnt;

IMin := i - Cnt + 1;

if CntMin = 1 then Break;

end;

Cnt := 0;

end;

end;

Memo2.Clear; // отчистка мемо2

if IMin > 0 then begin

Memo2.Lines.Add('Первая наименьшая группа:'); //вывод ответа

Memo2.Lines.Add(

'Кол-во элементов : ' + IntToStr(CntMin)

+ ', Позиция: ' + IntToStr(IMin)

+ ', Группа: "' + Copy(S, IMin, CntMin) + '".'

);

end else

Memo2.Lines.Add('В строке нету групп.');

end;

end.

Листинг А.21 – Использование файлов

unit Unit1;

interface

uses

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

Dialogs, StdCtrls, Mask;

type

TTowar = record

TowarNum: Integer;

Name: String[50];

KolVo: Integer;

Price: Integer;

Datum: TDate;

end;

type

TForm1 = class(TForm)

GroupBox1: TGroupBox;

Edit1: TEdit;

Edit2: TEdit;

Edit3: TEdit;

MaskEdit1: TMaskEdit;

Button1: TButton;

ListBox1: TListBox;

Label1: TLabel;

Label2: TLabel;

Label3: TLabel;

Label4: TLabel;

Button2: TButton;

Label5: TLabel;

GroupBox2: TGroupBox;

ListBox2: TListBox;

Label6: TLabel;

MaskEdit2: TMaskEdit;

Button3: TButton;

Label7: TLabel;

Edit4: TEdit;

Label8: TLabel;

Label9: TLabel;

procedure FormCreate(Sender: TObject);

procedure Button1Click(Sender: TObject);

procedure Button2Click(Sender: TObject);

procedure Button3Click(Sender: TObject);

procedure FormCanResize(Sender: TObject; var NewWidth, NewHeight: Integer;

var Resize: Boolean);

procedure Button4Click(Sender: TObject);

procedure Button5Click(Sender: TObject);

procedure Button6Click(Sender: TObject);

private

procedure WriteTowar(const FileName: String);

procedure ReadTowar(const FileName: String; var ListBox: TListBox); overload;

function ReadTowar(const FileName: String; Price: Integer; Datum: TDate; var ListBox: TListBox): TTowar; overload;

public

{ Public-Deklarationen }

end;

const FileName = 'Towar.tow';

var

Form1: TForm1;

Towar: TTowar;

Tow: File of TTowar;

implementation

uses Unit2;

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject); // добавить запись

begin

ListBox1.Clear;

WriteTowar(FileName);

ReadTowar(FileName, ListBox1)

end;

procedure TForm1.Button2Click(Sender: TObject); // просмотреть записи

begin

ReadTowar(FileName, ListBox1)

end;

procedure TForm1.Button3Click(Sender: TObject);

begin

ListBox2.Clear;

ReadTowar(FileName, StrToInt(Edit4.Text), StrToDate(MaskEdit2.Text), ListBox2);

end;

procedure TForm1.FormCanResize(Sender: TObject; var NewWidth,

NewHeight: Integer; var Resize: Boolean);

begin

Resize := False;

end;

procedure TForm1.FormCreate(Sender: TObject);

var k: Integer;

begin

if not(FileExists(FileName)) then

begin

k := MessageDlg('Файл '+FileName+' не существует+'Создать?', mtWarning, [mbYes, mbNo],0); // создание нового файла

if k = mrYes then

begin

AssignFile(Tow, FileName);

Rewrite(Tow);

CloseFile(Tow);

MessageDlg('Файл'+FileName+' не был создан по причине отмены,покиньте программу', mtConfirmation, [mbOK],0); //ошибка1

end

else

begin

MessageDlg('Файл '+FileName+' не может быть создан, покиньте программу, mtError, [mbOK],0);// ошибка2

Exit;

end;

end;

Label9.Caption := 'Сегодня - '+DateToStr(Date);// вывод сегодняшней даты

MaskEdit2.Text := DateToStr(Date)

end;

procedure TForm1.ReadTowar(const FileName: String;var ListBox: TListBox);

var i: Integer;

begin

AssignFile(Tow, FileName);

Reset(Tow);

for i := 0 to FileSize(Tow) - 1 do

begin

Seek(Tow, i);

Read(Tow, Towar); //поля для записи

ListBox.Items.Add(Номер товара - '+IntToStr(Towar.TowarNum));

ListBox.Items.Add('Название товара - '+Towar.Name);

ListBox.Items.Add(' Количесво товара- '+IntToStr(Towar.KolVo));

ListBox.Items.Add('Цена товара- '+IntToStr(Towar.Price));

ListBox.Items.Add('Дата поставки товара- '+DateToStr(Towar.Datum));

ListBox.Items.Add('************************************');

end;

Reset(Tow);

CloseFile(Tow);

end;

function TForm1.ReadTowar(const FileName: String; Price: Integer; Datum: TDate;

var ListBox: TListBox): TTowar;

var i: Integer;

begin

AssignFile(Tow, FileName);

Reset(Tow);

for i := 0 to FileSize(Tow) - 1 do

begin

Seek(Tow, i);

Read(Tow, Towar);

if (Towar.Price > Price) and ((Towar.Datum - 30) < Date) then

begin // вывод по сравнению

ListBox.Items.Add(Номер товара - '+IntToStr(Towar.TowarNum));

ListBox.Items.Add('Название товара - '+Towar.Name);

ListBox.Items.Add(' Количесво товара- '+IntToStr(Towar.KolVo));

ListBox.Items.Add('Цена товара- '+IntToStr(Towar.Price));

ListBox.Items.Add('Дата поставки товара- '+DateToStr(Towar.Datum));

ListBox.Items.Add('************************************');

end;

end;

Reset(Tow);

CloseFile(Tow);

end;

procedure TForm1.WriteTowar(const FileName: String);

begin

AssignFile(Tow, FileName);

Reset(Tow);

Seek(Tow, FileSize(Tow));

Towar.TowarNum := FileSize(Tow)+1;

Towar.Name := Edit1.Text;

Towar.KolVo := StrToInt(Edit2.Text);

Towar.Price := StrToInt(Edit3.Text);

Towar.Datum := StrToDate(MaskEdit1.Text);

Write(Tow, Towar);

Reset(Tow);

CloseFile(Tow);

end;

end.

Листинг А.22 – Графические примитивы и иллюстрации

unit Unit1;

interface

uses

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

Dialogs, ExtCtrls;

type

TForm1 = class(TForm)

Image1: TImage;

procedure FormActivate(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormActivate(Sender: TObject);

begin

image1.Canvas.Brush.style:=bsclear;

image1.Canvas.Ellipse(100,100,50,50); //круг1

image1.Canvas.Ellipse(100,150,50,100); // круг2

image1.Canvas.Ellipse(150,150,100,100); // круг3

image1.Canvas.Ellipse(150,100,100,50); // круг4

image1.Canvas.Ellipse(125,125,75,75); // круг5

end;

end.

Листинг А.23 – Работа с БД

unit Unit1;

interface

uses

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

Dialogs, DB, DBTables, Grids, DBGrids, StdCtrls, ExtCtrls, DBCtrls;

type

TForm1 = class(TForm)

ds1: TDataSource;

dbgrd1: TDBGrid;

tbl1: TTable;

dbmmoA: TDBMemo;

dbnvgr1: TDBNavigator;

edt1: TEdit;

edt2: TEdit;

edt3: TEdit;

btn1: TButton;

strngrd1: TStringGrid;

Label1: TLabel;

Label2: TLabel;

Label3: TLabel;

Label4: TLabel;

procedure FormCreate(Sender: TObject);

procedure btn1Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject); // Добавление полей в массив

begin

strngrd1.Cells[0,0]:='Истец';

strngrd1.Cells[1,0]:='Обвиняемый';

strngrd1.Cells[2,0]:='Номер телефона';

end;

procedure TForm1.btn1Click(Sender: TObject);

var i,j,k,max:Integer;

begin

max:=tbl1.RecordCount;

if (Edt1.text='') and (Edt2.text='') and (Edt3.text='') then Exit;

strngrd1.RowCount:=1;

k:=1;

tbl1.First;

for i:=1 to max do begin // функция поиска

if (Edt1.text=Copy(tbl1.FieldByName('ISTEC').AsString,1,Length(Edt1.Text)))

and (Edt2.text=Copy(tbl1.FieldByName('OBVINIEMIY').AsString,1,Length(Edt2.Text)))

and (Edt3.text=Copy(tbl1.FieldByName('TELEFONA').AsString,1,Length(Edt3.Text)))

then begin

with strngrd1 do begin

strngrd1.RowCount:=strngrd1.RowCount+1;// заполнение массива

Cells[0,k]:=tbl1.fieldbyname('ISTEC').AsString;

Cells[1,k]:=tbl1.fieldbyname('OBVINIEMIY').AsString;

Cells[2,k]:=tbl1.fieldbyname('TELEFONA').AsString;

k:=k+1;

end;

end;

tbl1.Next;

end;

end;

end.