UML в эконометрическом проектировании

MySh.Range['A5'].value:='Наименование товара';

MySh.Range['B5'].value:='Количество';

MySh.Range['C5'].value:='Гарантия';

MySh.Range['D5'].value:='Цена закупки';

MySh.Range['E5'].value:='Цена реализации';

Range:=MySh.Range['A5:E5'];

Range.Font.Bold:=true;

Border:=Range.Borders;

Border.Color:=clBlack;

Border.Weight:=2;

n:=DataShop.ListGroups.Count;

r:=6;

Col:=0;

for i:=0 to n-1 do

begin

TekGroup:=DataShop.ListGroups.ObjectList.Elements[i] as TGroup;

DataShop.ListGroups.CurrentIndex:=i;

m:=DataShop.ListGroupTovar.Count;

if m<>0 then

begin

MySh.Cells[r,1]:=TekGroup.Gname;

Range:=MySh.Range['A'+inttostr(r)+':E'+inttostr(r)];

Range.Font.Italic:=true;

Range.Font.Size:=14;

Range.Interior.color:=$77FFFF{clYellow};

r:=r+1;

Range:=MySh.Range['A'+inttostr(r)+':E'+inttostr(r+m-1)];

Border:=Range.Borders;

Border.Color:=clBlack;

Border.Weight:=2;

for j:=0 to m-1 do

begin

TekMTov:=DataShop.ListGroupTovar.ObjectList.Elements[j] as TTov_mag;

MySh.Cells[r,1]:=TekMTov.Tname;

MySh.Cells[r,2]:=TekMTov.TMcount;

MySh.Cells[r,3]:=TekMTov.Tgarant;

MySh.Cells[r,4]:=TekMTov.Tprice;

MySh.Cells[r,5]:=TekMTov.TMprice;

r:=r+1;

col:=col+TekMTov.TMcount;

end;

end;

end.

//Пометка на заказ товара

procedure TMainform.BoldAsStringRenderer1SetColor(Element: TBoldElement;

var AColor: TColor; Representation: Integer; Expression: String);

var st: string;

begin

st:=Element.EvaluateExpressionAsString('zakazCount.asString',1);

if st<>'0' then AColor:=$77FFFF{clLime};

end;

//Заказ товара

procedure TMainform.BoldSortingGrid4DblClick(Sender: TObject);

begin

TekBTov:=DataShop.ListBaseGroupTovar.ObjectList.Elements[DataShop.ListBaseGroupTovar.CurrentIndex] as TTov_base;

if TekBTov.TBcount>0 then

if TekBTov.TBcount<>1 then

ZakazForm.ShowModal

else

begin

if (messagedlg('Заказать товар "'+TekBTov.Tname+'"'+#13+

'в количестве 1 единицы?',mtConfirmation,[mbYes,mbNo],0)=mrYes) then

begin

TekBTov.ZakazCount:=1;

SpeedButton35.Enabled:=true;

FlagZakaz:=true;

BoldSortingGrid4.Repaint;

end;

end

else

MessageDlg('Невозможно заказать товар с нулевым остатком!',mtError,[mbOK],0);

end;

//Отмена заказа

procedure TMainform.SpeedButton34Click(Sender: TObject);

begin

if MessageDlg('Отменить заказ товара?',mtInformation,[mbYes, mbNo],0)=mrYes then

OtmenaZakaza;

end;

procedure TMainform.SpeedButton34MouseMove(Sender: TObject;

Shift: TShiftState; X, Y: Integer);

begin

StatusBar1.Panels[0].Text:='Отменить заказ товара';

end;

procedure Tmainform.Clear_status;

begin

StatusBar1.Panels[0].Text:='';

end;

procedure TMainform.TabSheet7MouseMove(Sender: TObject; Shift: TShiftState;

X, Y: Integer);

begin

Clear_status;

end;

procedure TMainform.SpeedButton36MouseMove(Sender: TObject;

Shift: TShiftState; X, Y: Integer);

begin

StatusBar1.Panels[0].Text:='Пометить товар на заказ';

end;

procedure TMainform.SpeedButton35MouseMove(Sender: TObject;

Shift: TShiftState; X, Y: Integer);

begin

StatusBar1.Panels[0].Text:='Заказать в магазин выбранный товар';

end;

//Заказ товара

procedure TMainform.SpeedButton35Click(Sender: TObject);

var i,j,n,step, t_index, zak, number,gr: integer;

NewMTovar: TTov_mag;

begin

n:=DataShop.ListBaseTovar.Count-1;

j:=0;

for i:=0 to n do

begin

TekBTov:=DataShop.ListBaseTovar.ObjectList.Elements[i] as TTov_base;

if TekBTov.ZakazCount>0 then

inc(j);

end;

step:=ProgressBar1.Max div j;

DataShop.ListZakupkaOtchet.Last;

i:=DataShop.ListZakupkaOtchet.CurrentIndex;

if i<>-1 then

begin

TekZTov:=DataShop.ListZakupkaOtchet.ObjectList.Elements[i] as TZakaz;

number:=TekZTov.Znumber;

end;

if i<>-1 then

zak:=number+1

else

zak:=1;

for i:=0 to n do

begin

TekBTov:=DataShop.ListBaseTovar.ObjectList.Elements[i] as TTov_base;

if TekBTov.ZakazCount>0 then

begin

NewZTov:=TZakaz.Create(nil);

NewZTov.Znumber:=zak;

NewZTov.Zdate:=Now;

NewZTov.Zname:=TekBTov.Tname;

NewZTov.Zprice:=TekBTov.Tprice;

NewZTov.Zcount:=TekBTov.ZakazCount;

TekGroup:=TekBTov.BPrinadlezhit;

if FindTovarShop(NewZTov.Zname,TekGroup.gname,t_index) then

begin

TekMTov:=DataShop.ListTovar.ObjectList.Elements[t_index] as TTov_mag;

TekMTov.TMcount:=TekMTov.TMcount+NewZTov.Zcount;

end

else

begin

NewMagTovar(TekBTov.Tname,TekBTov.Tprice,TekBTov.Tgarant,TekBTov.ZakazCount,TekBTov.BPrinadlezhit,NewMTovar);

end;

TekBTov.TBcount:=TekBTov.TBcount-TekBTov.ZakazCount;

TekBTov.ZakazCount:=0;

BoldSortingGrid4.Repaint;

if i<>j then

ProgressBar1.Position:=ProgressBar1.Position+step

else

ProgressBar1.Position:=ProgressBar1.Max;

end;

end;

if ProgressBar1.Position=ProgressBar1.Max then

begin

MessageDlg('Заказ товара успешно завершен!',mtInformation,[mbOK],0);

if MessageDlg('Создать накладную заказа?',mtInformation,[mbYes, mbNo],0)=mrYes then

if SaveWord.Execute then

begin

DataShop.BoldSystemHandleShop.UpdateDatabase;

DataShop.BoldSystemHandleShop.Active:=false;

DataShop.BoldPersistenceHandleFileXMLShop.FileName:=DirApplication;

DataShop.BoldSystemHandleShop.Active:=true;

if not FileExists(SaveWord.FileName) then

begin

NakladnayaZakaz(SaveWord.FileName,zak);

end

else

MessageDlg('Файл с таким именем уже существует!'+#13+'Введите другое имя файла!',mtError,[mbOK],0);

end;

end

else

MessageDlg('При заказе товара произошла ошибка!',mtError,[mbOK],0);

ProgressBar1.Position:=ProgressBar1.Min;

SpeedButton35.Enabled:=false;

FlagZakaz:=false;

end;

procedure TMainform.SpeedButton37MouseMove(Sender: TObject;

Shift: TShiftState; X, Y: Integer);

begin

StatusBar1.Panels[0].Text:='Найти товар';

end;

procedure TMainform.SpeedButton37Click(Sender: TObject);

var p: integer;

begin

if Edit11.Text<>'' then

if PoiskTovarBase(Edit11.Text,False,p) then

DataShop.ListBaseGroupTovar.CurrentIndex:=p

else

if (MessageDlg('Просмотр данных завершен! Повторить поиск сначала?',mtInformation,[mbYes,mbNo],0)=mrYes) then

if PoiskTovarBase(Edit11.Text,true,p) then

DataShop.ListBaseGroupTovar.CurrentIndex:=p;

end;

procedure TMainform.SpeedButton38MouseMove(Sender: TObject;

Shift: TShiftState; X, Y: Integer);

begin

StatusBar1.Panels[0].Text:='Закрыть окно';

end;

procedure TMainform.SpeedButton38Click(Sender: TObject);

begin

if SpeedButton35.Enabled then

begin

if (MessageDlg('Заказанный товар не проведен. Если закрыть окно, заказ пропадет'+#13+

'Хотите закрыть окно?',mtInformation,[mbYes,mbNo],0)=mrYes) then

begin

SpeedButton34Click(nil);

Edit11.Clear;

SpeedButton35.Enabled:=false;

SpeedButton34.Enabled:=true;

SpeedButton36.Enabled:=true;

TabSheet7.TabVisible:=False;

CheckBox3.Checked:=false;

DataShop.ListBaseGroupTovar.Expression:='bHranit';

end;

end

else

begin

Edit11.Clear;

SpeedButton35.Enabled:=false;

SpeedButton34.Enabled:=true;

SpeedButton36.Enabled:=true;

TabSheet7.TabVisible:=False;

CheckBox3.Checked:=false;

DataShop.ListBaseGroupTovar.Expression:='bHranit';

end;

end;

procedure TMainform.FormCreate(Sender: TObject);

begin

FlagZakaz:=false;

end;

procedure TMainform.SpeedButton39Click(Sender: TObject);

var p: integer;

begin

if Edit12.Text<>'' then

if PoiskTovarShop(Edit12.Text,False,p) then

DataShop.ListTovar.CurrentIndex:=p

else

if (MessageDlg('Просмотр данных завершен! Повторить поиск сначала?',mtInformation,[mbYes,mbNo],0)=mrYes) then

if PoiskTovarShop(Edit12.Text,true,p) then

DataShop.ListTovar.CurrentIndex:=p;

end;

procedure TMainform.SpeedButton40Click(Sender: TObject);

var p: integer;

begin

if Edit13.Text<>'' then

if PoiskTovarShopGroup(Edit13.Text,False,p) then

DataShop.ListOtdelsGroupTovar.CurrentIndex:=p

else

if (MessageDlg('Просмотр данных завершен! Повторить поиск сначала?',mtInformation,[mbYes,mbNo],0)=mrYes) then

if PoiskTovarShopGroup(Edit13.Text,true,p) then

DataShop.ListOtdelsGroupTovar.CurrentIndex:=p;

end;

procedure TMainform.SpeedButton16MouseMove(Sender: TObject;

Shift: TShiftState; X, Y: Integer);

begin

StatusBar1.Panels[0].Text:='Закрыть окно';

end;

procedure TMainform.SpeedButton41Click(Sender: TObject);

var s: string;

flag: boolean;

begin

flag:=true;

S:='';

TekMTov:=DataShop.ListOtdelsGroupTovar.ObjectList.Elements[DataShop.ListOtdelsGroupTovar.CurrentIndex] as TTov_mag;

if MessageDlg('Продать товар "'+TekMTov.Tname+'"',mtInformation,[mbYes, mbNo],0)=mrYes then

while flag do

begin

s:=InputBox('Продажа товара','Укажите количество продаваемого товара "'+

TekMTov.Tname+'" с ценой реализации:'+floattostr(TekMTov.TMprice)+

#13+'Количество товара в магазине: '+inttostr(TekMTov.TMcount)+' (ед.)','0');

if s<>'' then

begin

try

Kol:=StrToInt(s);

except

ShowMessage('Неверно указано количество продаваемого товара!'+#13+'Повторите ввод количества товара!');

end;

if ((kol>0)and(kol<=TekMTov.TMcount))or(kol=0) then

flag:=false

else

ShowMessage('Количество товара должно быть больше нуля, но не больше общего количества!'+#13+

'Повторите ввод цены реализации');

end

else

ShowMessage('Укажите количество продаваемого товара (ед.)!');

end; // while

if kol<>0 then

begin

TekMTov.Prodcount:=TekMTov.Prodcount+kol;

BoldSortingGrid1.Repaint;

SpeedButton45.Enabled:=true;

end;

end;

procedure TMainform.SpeedButton46MouseMove(Sender: TObject;

Shift: TShiftState; X, Y: Integer);

begin

StatusBar1.Panels[0].Text:=SpeedButton46.Hint;

end;

procedure TMainform.GroupBox26MouseMove(Sender: TObject;

Shift: TShiftState; X, Y: Integer);

begin

StatusBar1.Panels[0].Text:='';

end;

procedure TMainform.SpeedButton47Click(Sender: TObject);

begin

TabSheet8.TabVisible:=false;

Label55.Caption:='0';

Label56.Caption:='0';

Label57.Caption:='0';

end;

procedure TMainform.TabSheet8MouseMove(Sender: TObject; Shift: TShiftState;

X, Y: Integer);

begin

StatusBar1.Panels[0].Text:='';

end;

procedure TMainform.SpeedButton49MouseMove(Sender: TObject;

Shift: TShiftState; X, Y: Integer);

begin

StatusBar1.Panels[0].Text:=SpeedButton49.Hint;

end;

procedure TMainform.SpeedButton48MouseMove(Sender: TObject;

Shift: TShiftState; X, Y: Integer);

begin

StatusBar1.Panels[0].Text:=SpeedButton48.Hint;

end;

procedure TMainform.SpeedButton48Click(Sender: TObject);

var p: integer;

begin

if Edit14.Text<>'' then

if PoiskTovarProd(Edit14.Text,False,p) then

DataShop.ListProdazha.CurrentIndex:=p

else

if (MessageDlg('Просмотр данных завершен! Повторить поиск сначала?',mtInformation,[mbYes,mbNo],0)=mrYes) then

if PoiskTovarProd(Edit14.Text,true,p) then

DataShop.ListProdazha.CurrentIndex:=p;

end;

//Фильтрация по дате

procedure TMainform.SpeedButton49Click(Sender: TObject);

var bdate,edate: TDate;

BYear, BMonth, BDay, EYear, EMonth, EDay: Word;

Bs, Es, BMs, EMs, BDs, EDs: string;

begin

bdate:=trunc(DateTimePicker3.Date);

edate:=trunc(DateTimePicker4.Date);

DecodeDate(bdate,BYear, BMonth, BDay);

DecodeDate(edate,EYear, EMonth, EDay);

if BMonth in [1..9] then

BMs:='0'+inttostr(BMonth)

else

BMs:=inttostr(BMonth);

if EMonth in [1..9] then

EMs:='0'+inttostr(EMonth)

else

EMs:=inttostr(EMonth);

if BDay in [1..9] then

BDs:='0'+inttostr(BDay)

else

BDs:=inttostr(BDay);

if EDay in [1..9] then

EDs:='0'+inttostr(EDay)

else

EDs:=inttostr(EDay);

Bs:='#'+inttostr(BYear)+'-'+BMs+'-'+BDs;

Es:='#'+inttostr(EYear)+'-'+EMs+'-'+EDs;

if bdate<=edate then

DataShop.ListProdazha.Expression:='Prodazha.allInstances->select((pdate>='+Bs+') and (pdate<='+Es+'))';

end;

procedure TMainform.SpeedButton50Click(Sender: TObject);

var p: integer;

begin

if Edit15.Text<>'' then

if PoiskTovarZakaz(Edit15.Text,False,p) then

DataShop.ListZakupka.CurrentIndex:=p

else

if (MessageDlg('Просмотр данных завершен! Повторить поиск сначала?',mtInformation,[mbYes,mbNo],0)=mrYes) then

if PoiskTovarZakaz(Edit15.Text,true,p) then

DataShop.ListZakupka.CurrentIndex:=p;

end;

procedure TMainform.SpeedButton51Click(Sender: TObject);

var bdate,edate: TDate;

BYear, BMonth, BDay, EYear, EMonth, EDay: Word;

Bs, Es, BMs, EMs, BDs, EDs: string;

begin

bdate:=trunc(DateTimePicker5.Date);

edate:=trunc(DateTimePicker6.Date);

DecodeDate(bdate,BYear, BMonth, BDay);

DecodeDate(edate,EYear, EMonth, EDay);

if BMonth in [1..9] then

BMs:='0'+inttostr(BMonth)

else

BMs:=inttostr(BMonth);

if EMonth in [1..9] then

EMs:='0'+inttostr(EMonth)

else

EMs:=inttostr(EMonth);

if BDay in [1..9] then

BDs:='0'+inttostr(BDay)

else

BDs:=inttostr(BDay);

if EDay in [1..9] then

EDs:='0'+inttostr(EDay)

else

EDs:=inttostr(EDay);

Bs:='#'+inttostr(BYear)+'-'+BMs+'-'+BDs;

Es:='#'+inttostr(EYear)+'-'+EMs+'-'+EDs;

if bdate<=edate then

DataShop.ListZakupka.Expression:='Zakaz.allInstances->select((zdate>='+Bs+') and (zdate<='+Es+'))';

end;

procedure TMainform.N7Click(Sender: TObject);

begin

my.ShowModal;

end;

procedure TMainform.SpeedButton52Click(Sender: TObject);

begin

Edit14.Clear;

TabSheet9.TabVisible:=false;

end;

procedure TMainform.SpeedButton53Click(Sender: TObject);

begin

Edit15.Clear;

TabSheet10.TabVisible:=false;

end;

procedure TMainform.SpeedButton54Click(Sender: TObject);

begin

Edit12.Clear;

CheckBox1.Checked:=false;

DataShop.ListTovar.Expression:='Tov_mag.allInstances->select(tMcount<>0)';

TabSheet4.TabVisible:=false;

end;

procedure TMainform.SpeedButton55Click(Sender: TObject);

begin

SpeedButton28Click(nil);

TabSheet5.TabVisible:=false;

end;

procedure TMainform.SpeedButton33Click(Sender: TObject);

begin

SpeedButton30Click(nil);

TabSheet6.TabVisible:=false;

end;

procedure TMainform.SpeedButton29MouseMove(Sender: TObject;

Shift: TShiftState; X, Y: Integer);

begin

StatusBar1.Panels[0].Text:=SpeedButton29.Hint;

end;

procedure TMainform.SpeedButton30MouseMove(Sender: TObject;

Shift: TShiftState; X, Y: Integer);

begin

StatusBar1.Panels[0].Text:=SpeedButton30.Hint;

end;

procedure TMainform.SpeedButton32MouseMove(Sender: TObject;

Shift: TShiftState; X, Y: Integer);

begin

StatusBar1.Panels[0].Text:=SpeedButton32.Hint;

end;

procedure TMainform.SpeedButton31MouseMove(Sender: TObject;

Shift: TShiftState; X, Y: Integer);

begin

StatusBar1.Panels[0].Text:=SpeedButton31.Hint;

end;

procedure TMainform.SpeedButton43MouseMove(Sender: TObject;

Shift: TShiftState; X, Y: Integer);

begin

StatusBar1.Panels[0].Text:=SpeedButton43.Hint;

end;

procedure TMainform.SpeedButton8MouseMove(Sender: TObject;

Shift: TShiftState; X, Y: Integer);

begin

StatusBar1.Panels[0].Text:=SpeedButton8.Hint;

end;

procedure TMainform.SpeedButton9MouseMove(Sender: TObject;

Shift: TShiftState; X, Y: Integer);

begin

StatusBar1.Panels[0].Text:=SpeedButton9.Hint;

end;

procedure TMainform.SpeedButton10MouseMove(Sender: TObject;

Shift: TShiftState; X, Y: Integer);

begin

StatusBar1.Panels[0].Text:=SpeedButton10.Hint;

end;

procedure TMainform.SpeedButton11MouseMove(Sender: TObject;

Shift: TShiftState; X, Y: Integer);

begin

StatusBar1.Panels[0].Text:=SpeedButton11.Hint;

end;

procedure TMainform.SpeedButton12MouseMove(Sender: TObject;

Shift: TShiftState; X, Y: Integer);

begin

StatusBar1.Panels[0].Text:=SpeedButton12.Hint;

end;

procedure TMainform.SpeedButton13MouseMove(Sender: TObject;

Shift: TShiftState; X, Y: Integer);

begin

StatusBar1.Panels[0].Text:=SpeedButton13.Hint;

end;

procedure TMainform.SpeedButton3MouseMove(Sender: TObject;

Shift: TShiftState; X, Y: Integer);

begin

StatusBar1.Panels[0].Text:=SpeedButton3.Hint;

end;

procedure TMainform.SpeedButton4MouseMove(Sender: TObject;

Shift: TShiftState; X, Y: Integer);

begin

StatusBar1.Panels[0].Text:=SpeedButton4.Hint;

end;

procedure TMainform.SpeedButton5MouseMove(Sender: TObject;

Shift: TShiftState; X, Y: Integer);

begin

StatusBar1.Panels[0].Text:=SpeedButton5.Hint;

end;

procedure TMainform.SpeedButton6MouseMove(Sender: TObject;

Shift: TShiftState; X, Y: Integer);

begin

StatusBar1.Panels[0].Text:=SpeedButton6.Hint;

end;

procedure TMainform.SpeedButton7MouseMove(Sender: TObject;

Shift: TShiftState; X, Y: Integer);

begin

StatusBar1.Panels[0].Text:=SpeedButton7.Hint;

end;

procedure TMainform.SpeedButton14MouseMove(Sender: TObject;

Shift: TShiftState; X, Y: Integer);

begin

StatusBar1.Panels[0].Text:=SpeedButton14.Hint;

end;

procedure TMainform.SpeedButton15MouseMove(Sender: TObject;

Shift: TShiftState; X, Y: Integer);

begin

StatusBar1.Panels[0].Text:=SpeedButton15.Hint;

end;

procedure TMainform.SpeedButton21MouseMove(Sender: TObject;

Shift: TShiftState; X, Y: Integer);

begin

StatusBar1.Panels[0].Text:=SpeedButton21.Hint;

end;

procedure TMainform.SpeedButton22MouseMove(Sender: TObject;

Shift: TShiftState; X, Y: Integer);

begin

StatusBar1.Panels[0].Text:=SpeedButton22.Hint;

end;

procedure TMainform.SpeedButton23MouseMove(Sender: TObject;

Shift: TShiftState; X, Y: Integer);

begin

StatusBar1.Panels[0].Text:=SpeedButton23.Hint;

end;

procedure TMainform.SpeedButton20MouseMove(Sender: TObject;

Shift: TShiftState; X, Y: Integer);

begin

StatusBar1.Panels[0].Text:=SpeedButton20.Hint;

end;

procedure TMainform.SpeedButton18MouseMove(Sender: TObject;

Shift: TShiftState; X, Y: Integer);

begin

StatusBar1.Panels[0].Text:=SpeedButton18.Hint;

end;

procedure TMainform.SpeedButton19MouseMove(Sender: TObject;

Shift: TShiftState; X, Y: Integer);

begin

StatusBar1.Panels[0].Text:=SpeedButton19.Hint;

end;

procedure TMainform.CheckBox1Click(Sender: TObject);

begin

if CheckBox1.Checked then

DataShop.ListTovar.Expression:='Tov_mag.allInstances'

else

DataShop.ListTovar.Expression:='Tov_mag.allInstances->select(tMcount<>0)';

end;

procedure TMainform.CheckBox1MouseMove(Sender: TObject; Shift: TShiftState;

X, Y: Integer);

begin

StatusBar1.Panels[0].Text:=CheckBox1.Hint;

end;

procedure TMainform.CheckBox2Click(Sender: TObject);

begin

if CheckBox2.Checked then

DataShop.ListOtdelsGroupTovar.Expression:='soderzhit'

else

DataShop.ListOtdelsGroupTovar.Expression:='soderzhit->select(tMcount<>0)';

end;

procedure TMainform.CheckBox3Click(Sender: TObject);

begin

if CheckBox3.Checked then

DataShop.ListBaseGroupTovar.Expression:='bHranit'

else

DataShop.ListBaseGroupTovar.Expression:='bHranit->select(tBcount<>0)';

end;

procedure TMainform.N12Click(Sender: TObject);

begin

TabSheet4.TabVisible:=true;

PageControl1.ActivePage:=TabSheet4;

end;

procedure TMainform.N15Click(Sender: TObject);

begin

TabSheet5.TabVisible:=true;

PageControl1.ActivePage:=TabSheet5;

end;

procedure TMainform.N19Click(Sender: TObject);

begin

TabSheet7.TabVisible:=true;

PageControl1.ActivePage:=TabSheet7;

end;

procedure TMainform.N18Click(Sender: TObject);

begin

TabSheet8.TabVisible:=true;

PageControl1.ActivePage:=TabSheet8;

end;

procedure TMainform.N20Click(Sender: TObject);

begin

TabSheet9.TabVisible:=true;

PageControl1.ActivePage:=TabSheet9;

end;

procedure TMainform.N21Click(Sender: TObject);

begin

TabSheet10.TabVisible:=true;

PageControl1.ActivePage:=TabSheet10;

end;

procedure TMainform.ToolButton1MouseMove(Sender: TObject;

Shift: TShiftState; X, Y: Integer);

begin

StatusBar1.Panels[0].Text:='Просмотр основных сведений о магазине';

end;

procedure TMainform.FormMouseMove(Sender: TObject; Shift: TShiftState; X,

Y: Integer);

begin

StatusBar1.Panels[0].Text:='';

end;

procedure TMainform.ToolButton3MouseMove(Sender: TObject;

Shift: TShiftState; X, Y: Integer);

begin

StatusBar1.Panels[0].Text:='Просмотр статистических данных по магазину';

end;

procedure TMainform.ToolButton4MouseMove(Sender: TObject;

Shift: TShiftState; X, Y: Integer);

begin

StatusBar1.Panels[0].Text:='Добавление в магазин нового отдела или группы в одел';

end;

procedure TMainform.ToolButton5MouseMove(Sender: TObject;

Shift: TShiftState; X, Y: Integer);

begin

StatusBar1.Panels[0].Text:='Добавить новую закупочную базу';

end;

procedure TMainform.ToolButton6MouseMove(Sender: TObject;

Shift: TShiftState; X, Y: Integer);

begin

StatusBar1.Panels[0].Text:='Выполнение различных оперций с товаром (продажа, редактирование...)';

end;

procedure TMainform.ToolButton7MouseMove(Sender: TObject;

Shift: TShiftState; X, Y: Integer);

begin

StatusBar1.Panels[0].Text:='Посмотреть все остатки товара магазина';

end;

procedure TMainform.ToolButton8MouseMove(Sender: TObject;

Shift: TShiftState; X, Y: Integer);

begin

StatusBar1.Panels[0].Text:='Добавление товара в закупочные базы';

end;

procedure TMainform.ToolButton9MouseMove(Sender: TObject;

Shift: TShiftState; X, Y: Integer);

begin

StatusBar1.Panels[0].Text:='Заказ товара в магазин';

end;

procedure TMainform.ToolButton11MouseMove(Sender: TObject;

Shift: TShiftState; X, Y: Integer);

begin

StatusBar1.Panels[0].Text:='Просмотр всех продаж магазина';

end;

procedure TMainform.ToolButton12MouseMove(Sender: TObject;

Shift: TShiftState; X, Y: Integer);

begin

StatusBar1.Panels[0].Text:='Просмотр всех закупок магазина';

end;

procedure TMainform.ToolButton14MouseMove(Sender: TObject;

Shift: TShiftState; X, Y: Integer);

begin

StatusBar1.Panels[0].Text:='Руководство пользователя';

end;

procedure TMainform.SpeedButton43Click(Sender: TObject);

begin

if SaveExcel.Execute then

begin

DataShop.BoldSystemHandleShop.UpdateDatabase;

DataShop.BoldSystemHandleShop.Active:=false;

DataShop.BoldPersistenceHandleFileXMLShop.FileName:=DirApplication;

DataShop.BoldSystemHandleShop.Active:=true;

if not(FileExists(SaveExcel.FileName)) then

ExportOstatki(SaveExcel.FileName)

else

MessageDlg('Файл с таким именем уже существует!'+#13+'Введите другое имя файла!',mtError,[mbOK],0);

end;

end;

procedure TMainform.N24Click(Sender: TObject);

begin

if SaveExcel.Execute then

begin

DataShop.BoldSystemHandleShop.UpdateDatabase;

DataShop.BoldSystemHandleShop.Active:=false;

DataShop.BoldPersistenceHandleFileXMLShop.FileName:=DirApplication;

DataShop.BoldSystemHandleShop.Active:=true;

if not(FileExists(SaveExcel.FileName)) then

ExportOstatkiBase(SaveExcel.FileName)

else

MessageDlg('Файл с таким именем уже существует!'+#13+'Введите другое имя файла!',mtError,[mbOK],0);

end;

end;

procedure TMainform.BitBtn1Click(Sender: TObject);

begin

NakladnayaProdazha('primer.doc',9);

end;

procedure TMainform.VremyaTimer(Sender: TObject);

begin

StatusBar1.Panels[1].Text:='Сегодня: '+DateTimeToStr(now);

end;

procedure TMainform.ToolBar1MouseMove(Sender: TObject; Shift: TShiftState;

X, Y: Integer);

begin

StatusBar1.Panels[0].Text:='';

end;

procedure TMainform.Timer1Timer(Sender: TObject);

begin

if Mainform.AlphaBlendValue>250 then

begin

Timer1.Enabled:=false;

MainForm.AlphaBlend:=false;

end

else

Mainform.AlphaBlendValue:=Mainform.AlphaBlendValue+5

end;

procedure TMainform.ToolButton15MouseMove(Sender: TObject;

Shift: TShiftState; X, Y: Integer);

begin

StatusBar1.Panels[0].Text:='Экспорт остатков товара в магазине в Excel';

end;

procedure TMainform.ToolButton16MouseMove(Sender: TObject;

Shift: TShiftState; X, Y: Integer);

begin

StatusBar1.Panels[0].Text:='Экспорт остатков товара на базах в Excel';

end;

procedure TMainform.CheckBox4Click(Sender: TObject);

begin

if CheckBox4.Checked then

DataShop.ListBaseGroupTovar.Expression:='bHranit'

else

DataShop.ListBaseGroupTovar.Expression:='bHranit->select(tBcount<>0)';

end;

procedure TMainform.ToolButton14Click(Sender: TObject);

begin

Application.HelpCommand(HelpContext,1);

end;

procedure TMainform.N6Click(Sender: TObject);

begin

Application.HelpCommand(HelpContext,1);

end;

procedure TMainform.N25Click(Sender: TObject);

begin

TabSheet11.TabVisible:=True;

PageControl1.ActivePage:=TabSheet11;

end;

procedure TMainform.SpeedButton56Click(Sender: TObject);

begin

SpeedButton13Click(nil);

TabSheet11.TabVisible:=false;

end;

end.

Модуль описание классов бизнес-модели

unit BusinessClasses;

{$DEFINE BusinessClasses_unitheader}

{$INCLUDE BusinessClasses_Interface.inc}

{Includefile for methodimplementations }

const

BoldMemberAssertInvalidObjectType: string = 'Object of singlelink (%s.%s) is of wrong type (is %s, should be %s)';

{TBusinessClassesRoot }

procedure TBusinessClassesRootList.Add(NewObject: TBusinessClassesRoot);

begin

if Assigned(NewObject) then

AddElement(NewObject);

end;

function TBusinessClassesRootList.IndexOf(anObject: TBusinessClassesRoot): Integer;

begin

result := IndexOfElement(anObject);

end;

function TBusinessClassesRootList.Includes(anObject: TBusinessClassesRoot) : Boolean;

begin

result := IncludesElement(anObject);

end;

function TBusinessClassesRootList.AddNew: TBusinessClassesRoot;

begin

result := TBusinessClassesRoot(InternalAddNew);

end;

procedure TBusinessClassesRootList.Insert(index: Integer; NewObject: TBusinessClassesRoot);

begin

if assigned(NewObject) then

InsertElement(index, NewObject);

end;

function TBusinessClassesRootList.GetBoldObject(index: Integer): TBusinessClassesRoot;

begin

result := TBusinessClassesRoot(GetElement(index));

end;

procedure TBusinessClassesRootList.SetBoldObject(index: Integer; NewObject: TBusinessClassesRoot);

begin;

SetElement(index, NewObject);

end;

{TAdmin}

function TAdmin._Get_M_Afam: TBAString;

begin

assert(ValidateMember('TAdmin', 'Afam', 0, TBAString));

Result := TBAString(BoldMembers[0]);

end;

function TAdmin._GetAfam: String;

begin

Result := M_Afam.AsString;

end;

procedure TAdmin._SetAfam(const NewValue: String);

begin

M_Afam.AsString := NewValue;

end;

function TAdmin._Get_M_Aname: TBAString;

begin

assert(ValidateMember('TAdmin', 'Aname', 1, TBAString));

Result := TBAString(BoldMembers[1]);

end;

function TAdmin._GetAname: String;

begin

Result := M_Aname.AsString;

end;

procedure TAdmin._SetAname(const NewValue: String);

begin

M_Aname.AsString := NewValue;

end;

function TAdmin._Get_M_Asname: TBAString;

begin

assert(ValidateMember('TAdmin', 'Asname', 2, TBAString));

Result := TBAString(BoldMembers[2]);

end;

function TAdmin._GetAsname: String;

begin

Result := M_Asname.AsString;

end;

procedure TAdmin._SetAsname(const NewValue: String);

begin

M_Asname.AsString := NewValue;

end;

function TAdmin._Get_M_Adr: TBADate;

begin

assert(ValidateMember('TAdmin', 'Adr', 3, TBADate));

Result := TBADate(BoldMembers[3]);

end;

function TAdmin._GetAdr: TDate;

begin

Result := M_Adr.AsDate;

end;

procedure TAdmin._SetAdr(const NewValue: TDate);

begin

M_Adr.AsDate := NewValue;

end;

function TAdmin._Get_M_Zaveduet: TBoldObjectReference;

begin

assert(ValidateMember('TAdmin', 'Zaveduet', 4, TBoldObjectReference));

Result := TBoldObjectReference(BoldMembers[4]);

end;

function TAdmin._GetZaveduet: TOtdel;

begin

assert(not assigned(M_Zaveduet.BoldObject) or (M_Zaveduet.BoldObject is TOtdel), SysUtils.format(BoldMemberAssertInvalidObjectType, [ClassName, 'Zaveduet', M_Zaveduet.BoldObject.ClassName, 'TOtdel']));

Result := TOtdel(M_Zaveduet.BoldObject);

end;

procedure TAdmin._SetZaveduet(const value: TOtdel);

begin

M_Zaveduet.BoldObject := value;

end;

procedure TAdminList.Add(NewObject: TAdmin);

begin

if Assigned(NewObject) then

AddElement(NewObject);

end;

function TAdminList.IndexOf(anObject: TAdmin): Integer;

begin

result := IndexOfElement(anObject);

end;

function TAdminList.Includes(anObject: TAdmin) : Boolean;

begin

result := IncludesElement(anObject);

end;

function TAdminList.AddNew: TAdmin;

begin

result := TAdmin(InternalAddNew);

end;

procedure TAdminList.Insert(index: Integer; NewObject: TAdmin);

begin

if assigned(NewObject) then

InsertElement(index, NewObject);

end;

function TAdminList.GetBoldObject(index: Integer): TAdmin;

begin

result := TAdmin(GetElement(index));

end;

procedure TAdminList.SetBoldObject(index: Integer; NewObject: TAdmin);

begin;

SetElement(index, NewObject);

end;

{TGroup}

function TGroup._Get_M_Gname: TBAString;

begin

assert(ValidateMember('TGroup', 'Gname', 0, TBAString));

Result := TBAString(BoldMembers[0]);

end;

function TGroup._GetGname: String;

begin

Result := M_Gname.AsString;

end;

procedure TGroup._SetGname(const NewValue: String);

begin

M_Gname.AsString := NewValue;

end;

function TGroup._Get_M_Prinadlezhit: TBoldObjectReference;

begin

assert(ValidateMember('TGroup', 'Prinadlezhit', 1, TBoldObjectReference));

Result := TBoldObjectReference(BoldMembers[1]);

end;

function TGroup._GetPrinadlezhit: TOtdel;

begin

assert(not assigned(M_Prinadlezhit.BoldObject) or (M_Prinadlezhit.BoldObject is TOtdel), SysUtils.format(BoldMemberAssertInvalidObjectType, [ClassName, 'Prinadlezhit', M_Prinadlezhit.BoldObject.ClassName, 'TOtdel']));

Result := TOtdel(M_Prinadlezhit.BoldObject);

end;

procedure TGroup._SetPrinadlezhit(const value: TOtdel);

begin

M_Prinadlezhit.BoldObject := value;

end;

function TGroup._GetSoderzhit: TTov_magList;

begin

assert(ValidateMember('TGroup', 'Soderzhit', 2, TTov_magList));

Result := TTov_magList(BoldMembers[2]);

end;

function TGroup._Get_M_Zakupaetsya: TBoldObjectReference;

begin

assert(ValidateMember('TGroup', 'Zakupaetsya', 3, TBoldObjectReference));

Result := TBoldObjectReference(BoldMembers[3]);

end;

function TGroup._GetZakupaetsya: TBase;

begin

assert(not assigned(M_Zakupaetsya.BoldObject) or (M_Zakupaetsya.BoldObject is TBase), SysUtils.format(BoldMemberAssertInvalidObjectType, [ClassName, 'Zakupaetsya', M_Zakupaetsya.BoldObject.ClassName, 'TBase']));

Result := TBase(M_Zakupaetsya.BoldObject);

end;

procedure TGroup._SetZakupaetsya(const value: TBase);

begin

M_Zakupaetsya.BoldObject := value;

end;

function TGroup._GetBHranit: TTov_baseList;

begin

assert(ValidateMember('TGroup', 'BHranit', 4, TTov_baseList));

Result := TTov_baseList(BoldMembers[4]);

end;

procedure TGroupList.Add(NewObject: TGroup);

begin

if Assigned(NewObject) then

AddElement(NewObject);

end;

function TGroupList.IndexOf(anObject: TGroup): Integer;

begin

result := IndexOfElement(anObject);

end;

function TGroupList.Includes(anObject: TGroup) : Boolean;

begin

result := IncludesElement(anObject);

end;

function TGroupList.AddNew: TGroup;

begin

result := TGroup(InternalAddNew);

end;

procedure TGroupList.Insert(index: Integer; NewObject: TGroup);

begin

if assigned(NewObject) then

InsertElement(index, NewObject);

end;

function TGroupList.GetBoldObject(index: Integer): TGroup;

begin

result := TGroup(GetElement(index));

end;

procedure TGroupList.SetBoldObject(index: Integer; NewObject: TGroup);

begin;

SetElement(index, NewObject);

end;

{TZakaz}

function TZakaz._Get_M_Zdate: TBADate;

begin

assert(ValidateMember('TZakaz', 'Zdate', 0, TBADate));

Result := TBADate(BoldMembers[0]);

end;

function TZakaz._GetZdate: TDate;

begin

Result := M_Zdate.AsDate;

end;

procedure TZakaz._SetZdate(const NewValue: TDate);

begin

M_Zdate.AsDate := NewValue;

end;

function TZakaz._Get_M_Zname: TBAString;

begin

assert(ValidateMember('TZakaz', 'Zname', 1, TBAString));

Result := TBAString(BoldMembers[1]);

end;

function TZakaz._GetZname: String;

begin

Result := M_Zname.AsString;

end;

procedure TZakaz._SetZname(const NewValue: String);

begin

M_Zname.AsString := NewValue;

end;

function TZakaz._Get_M_Zcount: TBAInteger;

begin

assert(ValidateMember('TZakaz', 'Zcount', 2, TBAInteger));

Result := TBAInteger(BoldMembers[2]);

end;

function TZakaz._GetZcount: Integer;

begin

Result := M_Zcount.AsInteger;

end;

procedure TZakaz._SetZcount(const NewValue: Integer);

begin

M_Zcount.AsInteger := NewValue;

end;

function TZakaz._Get_M_Zprice: TBAFloat;

begin

assert(ValidateMember('TZakaz', 'Zprice', 3, TBAFloat));

Result := TBAFloat(BoldMembers[3]);

end;

function TZakaz._GetZprice: double;

begin

Result := M_Zprice.AsFloat;

end;

procedure TZakaz._SetZprice(const NewValue: double);

begin

M_Zprice.AsFloat := NewValue;

end;

function TZakaz._Get_M_Znumber: TBAInteger;

begin

assert(ValidateMember('TZakaz', 'Znumber', 4, TBAInteger));

Result := TBAInteger(BoldMembers[4]);

end;

function TZakaz._GetZnumber: Integer;

begin

Result := M_Znumber.AsInteger;

end;

procedure TZakaz._SetZnumber(const NewValue: Integer);

begin

M_Znumber.AsInteger := NewValue;

end;

procedure TZakazList.Add(NewObject: TZakaz);

begin

if Assigned(NewObject) then

AddElement(NewObject);

end;

function TZakazList.IndexOf(anObject: TZakaz): Integer;

begin

result := IndexOfElement(anObject);

end;

function TZakazList.Includes(anObject: TZakaz) : Boolean;

begin

result := IncludesElement(anObject);

end;

function TZakazList.AddNew: TZakaz;

begin

result := TZakaz(InternalAddNew);

end;

procedure TZakazList.Insert(index: Integer; NewObject: TZakaz);

begin

if assigned(NewObject) then

InsertElement(index, NewObject);

end;

function TZakazList.GetBoldObject(index: Integer): TZakaz;

begin

result := TZakaz(GetElement(index));

end;

procedure TZakazList.SetBoldObject(index: Integer; NewObject: TZakaz);

begin;

SetElement(index, NewObject);

end;

{TShop}

function TShop._Get_M_Shname: TBAString;

begin

assert(ValidateMember('TShop', 'Shname', 0, TBAString));

Result := TBAString(BoldMembers[0]);

end;

function TShop._GetShname: String;

begin

Result := M_Shname.AsString;

end;

procedure TShop._SetShname(const NewValue: String);

begin

M_Shname.AsString := NewValue;

end;

function TShop._Get_M_Shclass: TBAString;

begin

assert(ValidateMember('TShop', 'Shclass', 1, TBAString));

Result := TBAString(BoldMembers[1]);

end;

function TShop._GetShclass: String;

begin

Result := M_Shclass.AsString;

end;

procedure TShop._SetShclass(const NewValue: String);

begin

M_Shclass.AsString := NewValue;

end;

function TShop._Get_M_Shnumber: TBAString;

begin

assert(ValidateMember('TShop', 'Shnumber', 2, TBAString));

Result := TBAString(BoldMembers[2]);

end;

function TShop._GetShnumber: String;

begin

Result := M_Shnumber.AsString;

end;

procedure TShop._SetShnumber(const NewValue: String);

begin

M_Shnumber.AsString := NewValue;

end;

function TShop._Get_M_ShAddress: TBAString;

begin

assert(ValidateMember('TShop', 'ShAddress', 3, TBAString));

Result := TBAString(BoldMembers[3]);

end;

function TShop._GetShAddress: String;

begin

Result := M_ShAddress.AsString;

end;

procedure TShop._SetShAddress(const NewValue: String);

begin

M_ShAddress.AsString := NewValue;

end;

function TShop._Get_M_ShINN: TBAString;

begin

assert(ValidateMember('TShop', 'ShINN', 4, TBAString));

Result := TBAString(BoldMembers[4]);

end;

function TShop._GetShINN: String;

begin

Result := M_ShINN.AsString;

end;

procedure TShop._SetShINN(const NewValue: String);

begin

M_ShINN.AsString := NewValue;

end;

function TShop._Get_M_ShPhone: TBAString;

begin

assert(ValidateMember('TShop', 'ShPhone', 5, TBAString));

Result := TBAString(BoldMembers[5]);

end;

function TShop._GetShPhone: String;

begin

Result := M_ShPhone.AsString;

end;

procedure TShop._SetShPhone(const NewValue: String);

begin

M_ShPhone.AsString := NewValue;

end;

function TShop._Get_M_ShMail: TBAString;

begin

assert(ValidateMember('TShop', 'ShMail', 6, TBAString));

Result := TBAString(BoldMembers[6]);

end;

function TShop._GetShMail: String;

begin

Result := M_ShMail.AsString;

end;

procedure TShop._SetShMail(const NewValue: String);

begin

M_ShMail.AsString := NewValue;

end;

function TShop._GetSostoit: TOtdelList;

begin

assert(ValidateMember('TShop', 'Sostoit', 7, TOtdelList));

Result := TOtdelList(BoldMembers[7]);

end;

function TShop._GetImeet: TBaseList;

begin

assert(ValidateMember('TShop', 'Imeet', 8, TBaseList));

Result := TBaseList(BoldMembers[8]);

end;

procedure TShopList.Add(NewObject: TShop);

begin

if Assigned(NewObject) then

AddElement(NewObject);

end;

function TShopList.IndexOf(anObject: TShop): Integer;

begin

result := IndexOfElement(anObject);

end;

function TShopList.Includes(anObject: TShop) : Boolean;

begin

result := IncludesElement(anObject);

end;

function TShopList.AddNew: TShop;

begin

result := TShop(InternalAddNew);

end;

procedure TShopList.Insert(index: Integer; NewObject: TShop);

begin

if assigned(NewObject) then

InsertElement(index, NewObject);

end;

function TShopList.GetBoldObject(index: Integer): TShop;

begin

result := TShop(GetElement(index));

end;

procedure TShopList.SetBoldObject(index: Integer; NewObject: TShop);

begin;

SetElement(index, NewObject);

end;

{TOtdel}

function TOtdel._Get_M_Oname: TBAString;

begin

assert(ValidateMember('TOtdel', 'Oname', 0, TBAString));

Result := TBAString(BoldMembers[0]);

end;

function TOtdel._GetOname: String;

begin

Result := M_Oname.AsString;

end;

procedure TOtdel._SetOname(const NewValue: String);

begin

M_Oname.AsString := NewValue;

end;

function TOtdel._Get_M_Prinadlezhit: TBoldObjectReference;

begin

assert(ValidateMember('TOtdel', 'Prinadlezhit', 1, TBoldObjectReference));

Result := TBoldObjectReference(BoldMembers[1]);

end;

function TOtdel._GetPrinadlezhit: TShop;

begin

assert(not assigned(M_Prinadlezhit.BoldObject) or (M_Prinadlezhit.BoldObject is TShop), SysUtils.format(BoldMemberAssertInvalidObjectType, [ClassName, 'Prinadlezhit', M_Prinadlezhit.BoldObject.ClassName, 'TShop']));

Result := TShop(M_Prinadlezhit.BoldObject);

end;

procedure TOtdel._SetPrinadlezhit(const value: TShop);

begin

M_Prinadlezhit.BoldObject := value;

end;

function TOtdel._GetVkluchaet: TGroupList;

begin

assert(ValidateMember('TOtdel', 'Vkluchaet', 2, TGroupList));

Result := TGroupList(BoldMembers[2]);

end;

function TOtdel._Get_M_Upravlyaetsya: TBoldObjectReference;

begin

assert(ValidateMember('TOtdel', 'Upravlyaetsya', 3, TBoldObjectReference));

Result := TBoldObjectReference(BoldMembers[3]);

end;

function TOtdel._GetUpravlyaetsya: TAdmin;

begin

assert(not assigned(M_Upravlyaetsya.BoldObject) or (M_Upravlyaetsya.BoldObject is TAdmin), SysUtils.format(BoldMemberAssertInvalidObjectType, [ClassName, 'Upravlyaetsya', M_Upravlyaetsya.BoldObject.ClassName, 'TAdmin']));

Result := TAdmin(M_Upravlyaetsya.BoldObject);

end;

procedure TOtdel._SetUpravlyaetsya(const value: TAdmin);

begin

M_Upravlyaetsya.BoldObject := value;

end;

procedure TOtdelList.Add(NewObject: TOtdel);

begin

if Assigned(NewObject) then

AddElement(NewObject);

end;

function TOtdelList.IndexOf(anObject: TOtdel): Integer;

begin

result := IndexOfElement(anObject);

end;

function TOtdelList.Includes(anObject: TOtdel) : Boolean;

begin

result := IncludesElement(anObject);

end;

function TOtdelList.AddNew: TOtdel;

begin

result := TOtdel(InternalAddNew);

end;

procedure TOtdelList.Insert(index: Integer; NewObject: TOtdel);

begin

if assigned(NewObject) then

InsertElement(index, NewObject);

end;

function TOtdelList.GetBoldObject(index: Integer): TOtdel;

begin

result := TOtdel(GetElement(index));

end;

procedure TOtdelList.SetBoldObject(index: Integer; NewObject: TOtdel);

begin;

SetElement(index, NewObject);

end;

{TProdazha}

function TProdazha._Get_M_Pdate: TBADate;

begin

assert(ValidateMember('TProdazha', 'Pdate', 0, TBADate));

Result := TBADate(BoldMembers[0]);

end;

function TProdazha._GetPdate: TDate;

begin

Result := M_Pdate.AsDate;

end;

procedure TProdazha._SetPdate(const NewValue: TDate);

begin

M_Pdate.AsDate := NewValue;

end;

function TProdazha._Get_M_PZtov_name: TBAString;

begin

assert(ValidateMember('TProdazha', 'PZtov_name', 1, TBAString));

Result := TBAString(BoldMembers[1]);

end;

function TProdazha._GetPZtov_name: String;

begin

Result := M_PZtov_name.AsString;

end;

procedure TProdazha._SetPZtov_name(const NewValue: String);

begin

M_PZtov_name.AsString := NewValue;

end;

function TProdazha._Get_M_Pcount: TBAInteger;

begin

assert(ValidateMember('TProdazha', 'Pcount', 2, TBAInteger));

Result := TBAInteger(BoldMembers[2]);

end;

function TProdazha._GetPcount: Integer;

begin

Result := M_Pcount.AsInteger;

end;

procedure TProdazha._SetPcount(const NewValue: Integer);

begin

M_Pcount.AsInteger := NewValue;

end;

function TProdazha._Get_M_Pprice: TBAFloat;

begin

assert(ValidateMember('TProdazha', 'Pprice', 3, TBAFloat));

Result := TBAFloat(BoldMembers[3]);

end;

function TProdazha._GetPprice: double;

begin

Result := M_Pprice.AsFloat;

end;

procedure TProdazha._SetPprice(const NewValue: double);

begin

M_Pprice.AsFloat := NewValue;

end;

function TProdazha._Get_M_PRprice: TBAFloat;

begin

assert(ValidateMember('TProdazha', 'PRprice', 4, TBAFloat));

Result := TBAFloat(BoldMembers[4]);

end;

function TProdazha._GetPRprice: double;

begin

Result := M_PRprice.AsFloat;

end;

procedure TProdazha._SetPRprice(const NewValue: double);

begin

M_PRprice.AsFloat := NewValue;

end;

function TProdazha._Get_M_Psumma: TBAFloat;

begin

assert(ValidateMember('TProdazha', 'Psumma', 5, TBAFloat));

Result := TBAFloat(BoldMembers[5]);

end;

function TProdazha._GetPsumma: double;

begin

Result := M_Psumma.AsFloat;

end;

function TProdazha._Get_M_Pnumber: TBAInteger;

begin

assert(ValidateMember('TProdazha', 'Pnumber', 6, TBAInteger));

Result := TBAInteger(BoldMembers[6]);

end;

function TProdazha._GetPnumber: Integer;

begin

Result := M_Pnumber.AsInteger;

end;

procedure TProdazha._SetPnumber(const NewValue: Integer);

begin

M_Pnumber.AsInteger := NewValue;

end;

procedure TProdazhaList.Add(NewObject: TProdazha);

begin

if Assigned(NewObject) then

AddElement(NewObject);

end;

function TProdazhaList.IndexOf(anObject: TProdazha): Integer;

begin

result := IndexOfElement(anObject);

end;

function TProdazhaList.Includes(anObject: TProdazha) : Boolean;

begin

result := IncludesElement(anObject);

end;

function TProdazhaList.AddNew: TProdazha;

begin

result := TProdazha(InternalAddNew);

end;

procedure TProdazhaList.Insert(index: Integer; NewObject: TProdazha);

begin

if assigned(NewObject) then

InsertElement(index, NewObject);

end;

function TProdazhaList.GetBoldObject(index: Integer): TProdazha;

begin

result := TProdazha(GetElement(index));

end;

procedure TProdazhaList.SetBoldObject(index: Integer; NewObject: TProdazha);

begin;

SetElement(index, NewObject);

end;

{TTovar}

function TTovar._Get_M_Tname: TBAString;

begin

assert(ValidateMember('TTovar', 'Tname', 0, TBAString));

Result := TBAString(BoldMembers[0]);

end;

function TTovar._GetTname: String;

begin

Result := M_Tname.AsString;

end;

procedure TTovar._SetTname(const NewValue: String);

begin

M_Tname.AsString := NewValue;

end;

function TTovar._Get_M_Tprice: TBAFloat;

begin

assert(ValidateMember('TTovar', 'Tprice', 1, TBAFloat));

Result := TBAFloat(BoldMembers[1]);

end;

function TTovar._GetTprice: double;

begin

Result := M_Tprice.AsFloat;

end;

procedure TTovar._SetTprice(const NewValue: double);

begin

M_Tprice.AsFloat := NewValue;

end;

function TTovar._Get_M_Tgarant: TBAByte;

begin

assert(ValidateMember('TTovar', 'Tgarant', 2, TBAByte));

Result := TBAByte(BoldMembers[2]);

end;

function TTovar._GetTgarant: Byte;

begin

Result := M_Tgarant.AsByte;

end;

procedure TTovar._SetTgarant(const NewValue: Byte);

begin

M_Tgarant.AsByte := NewValue;

end;

procedure TTovarList.Add(NewObject: TTovar);

begin

if Assigned(NewObject) then

AddElement(NewObject);

end;

function TTovarList.IndexOf(anObject: TTovar): Integer;

begin

result := IndexOfElement(anObject);

end;

function TTovarList.Includes(anObject: TTovar) : Boolean;

begin

result := IncludesElement(anObject);

end;

function TTovarList.AddNew: TTovar;

begin

result := TTovar(InternalAddNew);

end;

procedure TTovarList.Insert(index: Integer; NewObject: TTovar);

begin

if assigned(NewObject) then

InsertElement(index, NewObject);

end;

function TTovarList.GetBoldObject(index: Integer): TTovar;

begin

result := TTovar(GetElement(index));

end;

procedure TTovarList.SetBoldObject(index: Integer; NewObject: TTovar);

begin;

SetElement(index, NewObject);

end;

{TBase}

function TBase._Get_M_Bname: TBAString;

begin

assert(ValidateMember('TBase', 'Bname', 0, TBAString));

Result := TBAString(BoldMembers[0]);

end;

function TBase._GetBname: String;

begin

Result := M_Bname.AsString;

end;

procedure TBase._SetBname(const NewValue: String);

begin

M_Bname.AsString := NewValue;

end;

function TBase._Get_M_Baddress: TBAString;

begin

assert(ValidateMember('TBase', 'Baddress', 1, TBAString));

Result := TBAString(BoldMembers[1]);

end;

function TBase._GetBaddress: String;

begin

Result := M_Baddress.AsString;

end;

procedure TBase._SetBaddress(const NewValue: String);

begin

M_Baddress.AsString := NewValue;

end;

function TBase._Get_M_Imeetsya: TBoldObjectReference;

begin

assert(ValidateMember('TBase', 'Imeetsya', 2, TBoldObjectReference));

Result := TBoldObjectReference(BoldMembers[2]);

end;

function TBase._GetImeetsya: TShop;

begin

assert(not assigned(M_Imeetsya.BoldObject) or (M_Imeetsya.BoldObject is TShop), SysUtils.format(BoldMemberAssertInvalidObjectType, [ClassName, 'Imeetsya', M_Imeetsya.BoldObject.ClassName, 'TShop']));

Result := TShop(M_Imeetsya.BoldObject);

end;

procedure TBase._SetImeetsya(const value: TShop);

begin

M_Imeetsya.BoldObject := value;

end;

function TBase._GetSoderzhit: TTov_baseList;

begin

assert(ValidateMember('TBase', 'Soderzhit', 3, TTov_baseList));

Result := TTov_baseList(BoldMembers[3]);

end;

function TBase._GetHranit: TGroupList;

begin

assert(ValidateMember('TBase', 'Hranit', 4, TGroupList));

Result := TGroupList(BoldMembers[4]);

end;

procedure TBaseList.Add(NewObject: TBase);

begin

if Assigned(NewObject) then

AddElement(NewObject);

end;

function TBaseList.IndexOf(anObject: TBase): Integer;

begin

result := IndexOfElement(anObject);

end;

function TBaseList.Includes(anObject: TBase) : Boolean;

begin

result := IncludesElement(anObject);

end;

function TBaseList.AddNew: TBase;

begin

result := TBase(InternalAddNew);

end;

procedure TBaseList.Insert(index: Integer; NewObject: TBase);

begin

if assigned(NewObject) then

InsertElement(index, NewObject);

end;

function TBaseList.GetBoldObject(index: Integer): TBase;

begin

result := TBase(GetElement(index));

end;

procedure TBaseList.SetBoldObject(index: Integer; NewObject: TBase);

begin;

SetElement(index, NewObject);

end;

{TTov_mag}

function TTov_mag._Get_M_TMcount: TBAInteger;

begin

assert(ValidateMember('TTov_mag', 'TMcount', 3, TBAInteger));

Result := TBAInteger(BoldMembers[3]);

end;

function TTov_mag._GetTMcount: Integer;

begin

Result := M_TMcount.AsInteger;

end;

procedure TTov_mag._SetTMcount(const NewValue: Integer);

begin

M_TMcount.AsInteger := NewValue;

end;

function TTov_mag._Get_M_TMprice: TBAFloat;

begin

assert(ValidateMember('TTov_mag', 'TMprice', 4, TBAFloat));

Result := TBAFloat(BoldMembers[4]);

end;

function TTov_mag._GetTMprice: double;

begin

Result := M_TMprice.AsFloat;

end;

procedure TTov_mag._SetTMprice(const NewValue: double);

begin

M_TMprice.AsFloat := NewValue;

end;

function TTov_mag._Get_M_Prodcount: TBAInteger;

begin

assert(ValidateMember('TTov_mag', 'Prodcount', 5, TBAInteger));

Result := TBAInteger(BoldMembers[5]);

end;

function TTov_mag._GetProdcount: Integer;

begin

Result := M_Prodcount.AsInteger;

end;

procedure TTov_mag._SetProdcount(const NewValue: Integer);

begin

M_Prodcount.AsInteger := NewValue;

end;

function TTov_mag._Get_M_TMsumma: TBAFloat;

begin

assert(ValidateMember('TTov_mag', 'TMsumma', 6, TBAFloat));

Result := TBAFloat(BoldMembers[6]);

end;

function TTov_mag._GetTMsumma: double;

begin

Result := M_TMsumma.AsFloat;

end;

function TTov_mag._Get_M_Prinadlezhit: TBoldObjectReference;

begin

assert(ValidateMember('TTov_mag', 'Prinadlezhit', 7, TBoldObjectReference));

Result := TBoldObjectReference(BoldMembers[7]);

end;

function TTov_mag._GetPrinadlezhit: TGroup;

begin

assert(not assigned(M_Prinadlezhit.BoldObject) or (M_Prinadlezhit.BoldObject is TGroup), SysUtils.format(BoldMemberAssertInvalidObjectType, [ClassName, 'Prinadlezhit', M_Prinadlezhit.BoldObject.ClassName, 'TGroup']));

Result := TGroup(M_Prinadlezhit.BoldObject);

end;

procedure TTov_mag._SetPrinadlezhit(const value: TGroup);

begin

M_Prinadlezhit.BoldObject := value;

end;

procedure TTov_magList.Add(NewObject: TTov_mag);

begin

if Assigned(NewObject) then

AddElement(NewObject);

end;

function TTov_magList.IndexOf(anObject: TTov_mag): Integer;

begin

result := IndexOfElement(anObject);

end;

function TTov_magList.Includes(anObject: TTov_mag) : Boolean;

begin

result := IncludesElement(anObject);

end;

function TTov_magList.AddNew: TTov_mag;

begin

result := TTov_mag(InternalAddNew);

end;

procedure TTov_magList.Insert(index: Integer; NewObject: TTov_mag);

begin

if assigned(NewObject) then

InsertElement(index, NewObject);

end;

function TTov_magList.GetBoldObject(index: Integer): TTov_mag;

begin

result := TTov_mag(GetElement(index));

end;

procedure TTov_magList.SetBoldObject(index: Integer; NewObject: TTov_mag);

begin;

SetElement(index, NewObject);

end;

{TTov_base}

function TTov_base._Get_M_TBcount: TBAInteger;

begin

assert(ValidateMember('TTov_base', 'TBcount', 3, TBAInteger));

Result := TBAInteger(BoldMembers[3]);

end;

function TTov_base._GetTBcount: Integer;

begin

Result := M_TBcount.AsInteger;

end;

procedure TTov_base._SetTBcount(const NewValue: Integer);

begin

M_TBcount.AsInteger := NewValue;

end;

function TTov_base._Get_M_ZakazCount: TBAInteger;

begin

assert(ValidateMember('TTov_base', 'ZakazCount', 4, TBAInteger));

Result := TBAInteger(BoldMembers[4]);

end;

function TTov_base._GetZakazCount: Integer;

begin

Result := M_ZakazCount.AsInteger;

end;

procedure TTov_base._SetZakazCount(const NewValue: Integer);

begin

M_ZakazCount.AsInteger := NewValue;

end;

function TTov_base._Get_M_Hranitsya: TBoldObjectReference;

begin

assert(ValidateMember('TTov_base', 'Hranitsya', 5, TBoldObjectReference));

Result := TBoldObjectReference(BoldMembers[5]);

end;

function TTov_base._GetHranitsya: TBase;

begin

assert(not assigned(M_Hranitsya.BoldObject) or (M_Hranitsya.BoldObject is TBase), SysUtils.format(BoldMemberAssertInvalidObjectType, [ClassName, 'Hranitsya', M_Hranitsya.BoldObject.ClassName, 'TBase']));

Result := TBase(M_Hranitsya.BoldObject);

end;

procedure TTov_base._SetHranitsya(const value: TBase);

begin

M_Hranitsya.BoldObject := value;

end;

function TTov_base._Get_M_BPrinadlezhit: TBoldObjectReference;

begin

assert(ValidateMember('TTov_base', 'BPrinadlezhit', 6, TBoldObjectReference));

Result := TBoldObjectReference(BoldMembers[6]);

end;

function TTov_base._GetBPrinadlezhit: TGroup;

begin

assert(not assigned(M_BPrinadlezhit.BoldObject) or (M_BPrinadlezhit.BoldObject is TGroup), SysUtils.format(BoldMemberAssertInvalidObjectType, [ClassName, 'BPrinadlezhit', M_BPrinadlezhit.BoldObject.ClassName, 'TGroup']));

Result := TGroup(M_BPrinadlezhit.BoldObject);

end;

procedure TTov_base._SetBPrinadlezhit(const value: TGroup);

begin

M_BPrinadlezhit.BoldObject := value;

end;

procedure TTov_baseList.Add(NewObject: TTov_base);

begin

if Assigned(NewObject) then

AddElement(NewObject);

end;

function TTov_baseList.IndexOf(anObject: TTov_base): Integer;

begin

result := IndexOfElement(anObject);

end;

function TTov_baseList.Includes(anObject: TTov_base) : Boolean;

begin

result := IncludesElement(anObject);

end;

function TTov_baseList.AddNew: TTov_base;

begin

result := TTov_base(InternalAddNew);

end;

procedure TTov_baseList.Insert(index: Integer; NewObject: TTov_base);

begin

if assigned(NewObject) then

InsertElement(index, NewObject);

end;

function TTov_baseList.GetBoldObject(index: Integer): TTov_base;

begin

result := TTov_base(GetElement(index));

end;

procedure TTov_baseList.SetBoldObject(index: Integer; NewObject: TTov_base);

begin;

SetElement(index, NewObject);

end;

function GeneratedCodeCRC: String;

begin

result := '1602220265';

end;

procedure InstallObjectListClasses(BoldObjectListClasses: TBoldGeneratedClassList);

begin

BoldObjectListClasses.AddObjectEntry('BusinessClassesRoot', TBusinessClassesRootList);

BoldObjectListClasses.AddObjectEntry('Admin', TAdminList);

BoldObjectListClasses.AddObjectEntry('Group', TGroupList);

BoldObjectListClasses.AddObjectEntry('Zakaz', TZakazList);

BoldObjectListClasses.AddObjectEntry('Shop', TShopList);

BoldObjectListClasses.AddObjectEntry('Otdel', TOtdelList);

BoldObjectListClasses.AddObjectEntry('Prodazha', TProdazhaList);

BoldObjectListClasses.AddObjectEntry('Tovar', TTovarList);

BoldObjectListClasses.AddObjectEntry('Base', TBaseList);

BoldObjectListClasses.AddObjectEntry('Tov_mag', TTov_magList);

BoldObjectListClasses.AddObjectEntry('Tov_base', TTov_baseList);

end;

procedure InstallBusinessClasses(BoldObjectClasses: TBoldGeneratedClassList);

begin

BoldObjectClasses.AddObjectEntry('BusinessClassesRoot', TBusinessClassesRoot);

BoldObjectClasses.AddObjectEntry('Admin', TAdmin);

BoldObjectClasses.AddObjectEntry('Group', TGroup);

BoldObjectClasses.AddObjectEntry('Zakaz', TZakaz);

BoldObjectClasses.AddObjectEntry('Shop', TShop);

BoldObjectClasses.AddObjectEntry('Otdel', TOtdel);

BoldObjectClasses.AddObjectEntry('Prodazha', TProdazha);

BoldObjectClasses.AddObjectEntry('Tovar', TTovar);

BoldObjectClasses.AddObjectEntry('Base', TBase);

BoldObjectClasses.AddObjectEntry('Tov_mag', TTov_mag);

BoldObjectClasses.AddObjectEntry('Tov_base', TTov_base);

end;

var

CodeDescriptor: TBoldGeneratedCodeDescriptor;

initialization

CodeDescriptor := GeneratedCodes.AddGeneratedCodeDescriptorWithFunc('BusinessClasses', InstallBusinessClasses, InstallObjectListClasses, GeneratedCodeCRC);

finalization

GeneratedCodes.Remove(CodeDescriptor);

end.

Модуль регистрации пользователя как директора

unit Ad_reg;

interface

uses

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