7. Листинг программы

unit EconomInfo;

interface

uses

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

Dialogs, Grids, Menus, StdCtrls,shellapi;

type

TForm1 = class(TForm)

sg1: TStringGrid;

MainMenu1: TMainMenu;

N1: TMenuItem;

N2: TMenuItem;

N3: TMenuItem;

N4: TMenuItem;

N5: TMenuItem;

N6: TMenuItem;

N7: TMenuItem;

N9: TMenuItem;

N10: TMenuItem;

N11: TMenuItem;

Memo1: TMemo;

Edit1: TEdit;

Edit2: TEdit;

Edit3: TEdit;

Edit4: TEdit;

Edit5: TEdit;

Button1: TButton;

Button3: TButton;

Button4: TButton;

Button5: TButton;

Button6: TButton;

OpenDialog1: TOpenDialog;

SaveDialog1: TSaveDialog;

N8: TMenuItem;

procedure FormShow(Sender: TObject);

procedure cleansg(Sender: TObject);

procedure cleanedit(Sender:TObject);

procedure Button4Click(Sender: TObject);

procedure Button1Click(Sender: TObject);

procedure autorachet(Sender: TObject);

procedure Button6Click(Sender: TObject);

procedure Button5Click(Sender: TObject);

procedure Button3Click(Sender: TObject);

procedure sg1Click(Sender: TObject);

procedure N8Click(Sender: TObject);

procedure N5Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.dfm}

type zap=record // объявление типа записи

prod:string[80];

onng:longint;

plan:longint;

onkg:longint;

svocep:extended;

end;

var

Mzap:array[1..200] of zap; //объявление типа массива записей

filezap: file of zap;

filenamezap:string;

//процедура выполнения действий при загрузке формы

procedure TForm1.FormShow(Sender: TObject);

begin

with sg1 do begin

Cells[0,0]:='Наименование продукции';

Cells[1,0]:='ОнНГ';

Cells[2,0]:='ПВ';

Cells[3,0]:='ОнКГ';

Cells[4,0]:='ОР, шт';

Cells[5,0]:='СвОЦЕП, руб';

Cells[6,0]:='СвОЦВОР, т.руб';

end;

memo1.Lines.Insert(0,DateTimeToStr(Now)+' - Программа запущена!');

end;

//процедура очистки стринггрида

procedure Tform1.cleansg(Sender: TObject);

var n2:integer;

begin

with sg1 do begin

for n2:=1 to RowCount do begin

Rows[n2].Clear;

end;

end;

end;

//процедура очистки эдитов

procedure Tform1.cleanedit(Sender: TObject);

begin

edit1.Clear;

edit2.Clear;

edit3.Clear;

edit4.Clear;

edit5.Clear;

end;

//Создание новой базы

procedure TForm1.Button4Click(Sender: TObject);

begin

if messagedlg('Все несохраненные данные текушей базы будут стерты!',mtconfirmation,mbYesNoCancel,0)=mrYes then begin

cleansg(Sender);

memo1.Lines.Insert(0,DateTimeToStr(Now)+' - Новая база создана. Пожалуйста сохраните, задав новое имя.');

end;

end;

//добавление записи

procedure TForm1.Button1Click(Sender: TObject);

var n,k,l:integer;o:extended;

begin

//проверка на пустые поля edit-ов

if (edit1.Text<>'') and (edit2.Text<>'') and (edit3.Text<>'') and (edit4.Text<>'') and (edit5.Text<>'') then

begin

try

n:=strtoint(edit2.text);

n:=strtoint(edit3.text);

n:=strtoint(edit4.text);

o:=strtofloat(edit5.text);

except

on EConvertError do messagedlg('Поля 2..5 должны быть числом!',mterror,mbOKCancel,1);

end;

//цикл очистки массива записей

n:=0;

repeat

Mzap[n].prod:='';

Mzap[n].onng:=0;

Mzap[n].plan:=0;

Mzap[n].onkg:=0;

Mzap[n].svocep:=0;

n:=n+1;

until n>=200;

//цикл перевода строк stringgrid-a в массив записей

n:=1;

repeat

if sg1.Cells[0,n]<>'' then begin

Mzap[2*n].prod:=sg1.Cells[0,n];

Mzap[2*n].onng:=strtoint(sg1.cells[1,n]);

Mzap[2*n].plan:=strtoint(sg1.cells[2,n]);

Mzap[2*n].onkg:=strtoint(sg1.cells[3,n]);

Mzap[2*n].svocep:=strtofloat(sg1.cells[5,n]);

end;

n:=n+1;

until n>=sg1.RowCount;

//цикл нахождения количества записей больших добавляемого значения

n:=1;l:=0;

repeat

if (Mzap[2*n].prod<>'') and (CompareText(edit1.Text,Mzap[2*n].prod)>0) then l:=l+1;

n:=n+1;

until n>=200;

//междустрочная запись в массив

k:=2*l+1;

Mzap[k].prod:=edit1.Text;

Mzap[k].onng:=strtoint(edit2.text);

Mzap[k].plan:=strtoint(edit3.text);

Mzap[k].onkg:=strtoint(edit4.text);

Mzap[k].svocep:=strtofloat(edit5.text);

cleansg(sender); //вызов очистки стрингрида

//цикл перевода массива записей в стринггрид

n:=1;k:=1;

repeat

if Mzap[n].prod<>'' then begin

sg1.Cells[0,k]:=Mzap[n].prod;

sg1.Cells[1,k]:=inttostr(Mzap[n].onng);

sg1.Cells[2,k]:=inttostr(Mzap[n].plan);

sg1.Cells[3,k]:=inttostr(Mzap[n].onkg);

sg1.Cells[5,k]:=floattostr(Mzap[n].svocep);

k:=k+1;

end;

n:=n+1;

until n>=200;

cleanedit(Sender); //вызов очистки эдитов

autorachet(sender);

end

else messagedlg('Все поля обязательна для заполенения!',mterror,mbOKCancel,1); //вызов предупреждения

end;

//Процедура автоматического расчета

procedure Tform1.autorachet(Sender: TObject);

var n,l:longint; max:extended;

begin

n:=1;

max:=0;

repeat

with sg1 do begin

if cells[0,n]<>'' then begin

cells[4,n]:=inttostr(strtoint(cells[1,n])+strtoint(cells[2,n])-strtoint(cells[3,n]));

cells[6,n]:=floattostr(strtoint(cells[4,n])*strtofloat(cells[5,n])/1000);

if strtofloat(cells[6,n])>max then begin l:=n; max:=strtofloat(cells[6,n]);end;

end;

end;

n:=n+1;

until n>=sg1.rowCount;

memo1.Lines.Insert(0,DateTimeToStr(Now)+' - Расчет произведен. Максимальный СвОЦВОР '+floattostr(max)+' руб. у '+sg1.cells[0,l]);

end;

procedure TForm1.Button6Click(Sender: TObject);

var n:longint;

begin

with savedialog1 do begin

title:='Сохранение базы';

if execute then

begin

filenamezap:=filename;

assignfile(filezap,filenamezap);

rewrite(filezap);

n:=0;

repeat

Mzap[n].prod:='';

Mzap[n].onng:=0;

Mzap[n].plan:=0;

Mzap[n].onkg:=0;

Mzap[n].svocep:=0;

n:=n+1;

until n>=200;

n:=1;

repeat

if sg1.Cells[0,n]<>'' then begin

Mzap[n].prod:=sg1.Cells[0,n];

Mzap[n].onng:=strtoint(sg1.cells[1,n]);

Mzap[n].plan:=strtoint(sg1.cells[2,n]);

Mzap[n].onkg:=strtoint(sg1.cells[3,n]);

Mzap[n].svocep:=strtofloat(sg1.cells[5,n]);

end;

n:=n+1;

until n>=sg1.RowCount;

for n:=1 to 100 do write(filezap,mzap[n]);

closefile(filezap);

end;

end;

memo1.Lines.Insert(0,DateTimeToStr(Now)+' - База сохранена под именем '+filenamezap);

end;

rocedure TForm1.Button5Click(Sender: TObject);

var n,k:longint;

begin

with opendialog1 do begin

title:= 'Открытие базы';

if execute then

begin

filenamezap:=filename;

assignfile(filezap,filenamezap);

reset(filezap);

n:=0;

repeat

Mzap[n].prod:='';

Mzap[n].onng:=0;

Mzap[n].plan:=0;

Mzap[n].onkg:=0;

Mzap[n].svocep:=0;

n:=n+1;

until n>=200;

n:=1;

while not eof(filezap) do

begin

read(filezap,mzap[n]);

n:=n+1;

end;

cleansg(sender);

n:=0;k:=1;

repeat

if Mzap[n].prod<>'' then begin

sg1.Cells[0,k]:=Mzap[n].prod;

sg1.Cells[1,k]:=inttostr(Mzap[n].onng);

sg1.Cells[2,k]:=inttostr(Mzap[n].plan);

sg1.Cells[3,k]:=inttostr(Mzap[n].onkg);

sg1.Cells[5,k]:=floattostr(Mzap[n].svocep);

k:=k+1;

end;

n:=n+1;

until n>=200;

autorachet(sender);

end;

end;

memo1.Lines.Insert(0,DateTimeToStr(Now)+' - База '+filenamezap+ ' открыта');

end;

//процедура удаления записи

procedure TForm1.Button3Click(Sender: TObject);

var n,k:longint;

begin

sg1.Rows[sg1.Row].Clear;

n:=0;

repeat

Mzap[n].prod:='';

Mzap[n].onng:=0;

Mzap[n].plan:=0;

Mzap[n].onkg:=0;

Mzap[n].svocep:=0;

n:=n+1;

until n>=200;

n:=1;

repeat

if sg1.Cells[0,n]<>'' then begin

Mzap[n].prod:=sg1.Cells[0,n];

Mzap[n].onng:=strtoint(sg1.cells[1,n]);

Mzap[n].plan:=strtoint(sg1.cells[2,n]);

Mzap[n].onkg:=strtoint(sg1.cells[3,n]);

Mzap[n].svocep:=strtofloat(sg1.cells[5,n]);

end;

n:=n+1;

until n>=sg1.RowCount;

cleansg(sender);

n:=0;k:=1;

repeat

if Mzap[n].prod<>'' then begin

sg1.Cells[0,k]:=Mzap[n].prod;

sg1.Cells[1,k]:=inttostr(Mzap[n].onng);

sg1.Cells[2,k]:=inttostr(Mzap[n].plan);

sg1.Cells[3,k]:=inttostr(Mzap[n].onkg);

sg1.Cells[5,k]:=floattostr(Mzap[n].svocep);

k:=k+1;

cleanedit(Sender); //вызов очистки эдитов

end;

n:=n+1;

until n>=200;

autorachet(sender);

end;

procedure TForm1.sg1Click(Sender: TObject);

begin

edit1.Text:=sg1.Cells[0,sg1.Row];

edit2.Text:=sg1.Cells[1,sg1.Row];

edit3.Text:=sg1.Cells[2,sg1.Row];

edit4.Text:=sg1.Cells[3,sg1.Row];

edit5.Text:=sg1.Cells[5,sg1.Row];

memo1.Lines.Insert(0,DateTimeToStr(Now)+' - Запись № '+inttostr(sg1.Row)+ ' выбрана');

end;

procedure TForm1.N8Click(Sender: TObject);

begin

ShellExecute(form1.Handle, nil,PChar('mailto:ultrix@tut.by?Subject=EcoInfo'),'','', 0);

end;

procedure TForm1.N5Click(Sender: TObject);

begin

halt;

end;

end.