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

unit About;

interface

uses Windows, SysUtils, Classes, Graphics, Forms, Controls, StdCtrls,

Buttons, ExtCtrls;

type

TAboutBox = class(TForm)

Panel1: TPanel;

ProductName: TLabel;

Version: TLabel;

Comments: TLabel;

OKButton: TButton;

Label1: TLabel;

procedure OKButtonClick(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

AboutBox: TAboutBox;

implementation

uses Main, InformUnit;

{$R *.dfm}

procedure TAboutBox.OKButtonClick(Sender: TObject);

begin

close;

MainForm.Show;

InformForm.Show;

end;

end.

unit InformUnit;

interface

uses

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

Dialogs, ComCtrls, Grids, DBGrids, StdCtrls, ExtCtrls, DBCtrls, Buttons;

type

TInformForm = class(TForm)

PageControl1: TPageControl;

TabSheet1: TTabSheet;

TabSheet2: TTabSheet;

TabSheet3: TTabSheet;

DBGrid1: TDBGrid;

DBNavigator1: TDBNavigator;

GroupBox1: TGroupBox;

DBGrid2: TDBGrid;

GroupBox2: TGroupBox;

DBNavigator2: TDBNavigator;

DBGrid3: TDBGrid;

DBNavigator3: TDBNavigator;

GroupBox3: TGroupBox;

DBGrid4: TDBGrid;

DBNavigator4: TDBNavigator;

GroupBox4: TGroupBox;

GroupBox5: TGroupBox;

DBGrid5: TDBGrid;

DBNavigator5: TDBNavigator;

BitBtn1: TBitBtn;

Panel1: TPanel;

procedure BitBtn1Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

InformForm: TInformForm;

implementation

uses Main;

{$R *.dfm}

procedure TInformForm.BitBtn1Click(Sender: TObject);

begin

informform.Hide;

end;

end.

unit Main;

interface

uses

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

Dialogs, ComCtrls, StdCtrls, ExtCtrls, ToolWin, ActnMan,

ActnCtrls, Menus, Grids, DBGrids, DBCtrls, QuickRpt, QRCtrls, DBTables,

DB, AppEvnts, Buttons, jpeg;

type

TMainForm = class(TForm)

TreeView1: TTreeView;

WorkArea: TPanel;

Panel2: TPanel;

GroupBox1: TGroupBox;

Memo1: TMemo;

DS_spisokB: TDataSource;

T_typeB: TTable;

T_products: TTable;

T_EI: TTable;

T_ProdinRec: TTable;

T_spisokB: TTable;

DS_EI: TDataSource;

Session1: TSession;

DS_ProdinRec: TDataSource;

DS_products: TDataSource;

DS_TypeB: TDataSource;

T_productsIdP: TIntegerField;

T_productsNameProduct: TStringField;

T_productsKol_vo: TFloatField;

T_productsCenaP: TFloatField;

T_productsIdEI: TIntegerField;

T_productsRelatEI: TStringField;

T_spisokBIDB: TIntegerField;

T_spisokBNameB: TStringField;

T_spisokBCenaB: TFloatField;

T_spisokBIdTB: TIntegerField;

T_spisokBFlagCur: TBooleanField;

T_spisokBRelatTypeB: TStringField;

T_ProdinRecIDB: TIntegerField;

T_ProdinRecIDP: TIntegerField;

T_ProdinRecKol_voPvB: TFloatField;

T_ProdinRecRelatEIonP: TStringField;

T_ProdinRecRelatP: TStringField;

T_spisokBStoim: TFloatField;

T_ProdinRecRelatPCena: TFloatField;

DS_Zakaz: TDataSource;

T_zakaz: TTable;

T_zakazIDB: TIntegerField;

T_zakazKol_voZ: TIntegerField;

T_zakazRelatNB: TStringField;

T_EIIdEI: TIntegerField;

T_EINameEI: TStringField;

T_typeBIdTB: TIntegerField;

T_typeBNameTB: TStringField;

BitBtn1: TBitBtn;

Image1: TImage;

BitBtn2: TBitBtn;

FontDialog1: TFontDialog;

T_zakazLU_CEnaB: TVariantField;

T_zakazCalc_stoim: TVariantField;

procedure T_spisokBFlagCurGetText(Sender: TField; var Text: String;

DisplayText: Boolean);

procedure T_spisokBFlagCurSetText(Sender: TField; const Text: String);

procedure T_spisokBCalcFields(DataSet: TDataSet);

procedure T_zakazRelatNBSetText(Sender: TField; const Text: String);

procedure T_zakazKol_voZSetText(Sender: TField; const Text: String);

procedure T_zakazAfterInsert(DataSet: TDataSet);

procedure T_zakazAfterPost(DataSet: TDataSet);

procedure T_spisokBAfterInsert(DataSet: TDataSet);

procedure T_spisokBBeforeInsert(DataSet: TDataSet);

procedure T_spisokBAfterPost(DataSet: TDataSet);

procedure T_productsBeforeInsert(DataSet: TDataSet);

procedure T_productsAfterInsert(DataSet: TDataSet);

procedure T_productsAfterPost(DataSet: TDataSet);

procedure T_EIBeforeInsert(DataSet: TDataSet);

procedure T_EIAfterInsert(DataSet: TDataSet);

procedure T_EIAfterPost(DataSet: TDataSet);

procedure T_typeBBeforeInsert(DataSet: TDataSet);

procedure T_typeBAfterInsert(DataSet: TDataSet);

procedure BitBtn2Click(Sender: TObject);

procedure FormShow(Sender: TObject);

procedure TreeView1Click(Sender: TObject);

procedure FormActivate(Sender: TObject);

procedure T_zakazCalcFields(DataSet: TDataSet);

private

{ Private declarations }

public

{ Public declarations }

end;

var

MainForm: TMainForm;

flager:byte;

mkeyvalue:integer;

implementation

uses InformUnit, RepMenu, ZakazUnit, RepZakaz, About;

{$R *.dfm}

procedure TMainForm.T_spisokBFlagCurGetText(Sender: TField; var Text: String;

DisplayText: Boolean);

begin

If T_spisokBFlagCur.Value then text:='+'

else text:='-';

end;

procedure TMainForm.T_spisokBFlagCurSetText(Sender: TField;

const Text: String);

begin

T_spisokBFlagCur.Value:=false;

if text='+' then T_spisokBFlagCur.Value:=True;

if text='-' then T_spisokBFlagCur.Value:=False;

end;

{Подсчет стоимости блюда}

procedure TMainForm.T_spisokBCalcFields(DataSet: TDataSet);

var s1:real;

begin

s1:=0;

While not (T_ProdinRec.Eof) do begin

S1:=S1+T_ProdinRecRelatPCena.value*T_ProdinRecKol_voPvB.Value;

T_ProdinRec.Next;

end;

T_spisokBStoim.value:=T_spisokBCenaB.value+S1;

end;

procedure TMainForm.T_zakazRelatNBSetText(Sender: TField; const Text: String);

begin

With T_spisokB do

if Locate('NameB',Text,[]) then begin

T_zakazIDB.value:=T_spisokBIDB.Value;

T_zakazIDB.RefreshLookupList;

end;

end;

{**********************************************************8}

procedure TMainForm.T_zakazKol_voZSetText(Sender: TField; const Text: String);

var number:integer;prodZak:real;flag:boolean;

begin

flag:=true;

number:=strtoint(Text);

ZakazForm.memo1.Clear;

If not(strtoInt(Text) in [1..50]) then ZakazForm.memo1.Lines.Text:='Количество блюд превзошло разумные пределы!'

else begin

T_spisokB.locate('IDB',T_zakazIDB.value,[]); {Нашли блюдо}

T_ProdinRec.First;

{Оценивающий цикл}

{} While not(T_ProdinRec.Eof) and flag do begin {Ищем запись продукта}

if T_products.Locate('IDP',T_ProdinRecIDP.Value,[]) then

{Сравниваем заказанное и наличествующее}

{} begin

ProdZak:=T_ProdinRecKol_voPvB.Value*number;

if ProdZak<T_productsKol_vo.Value then flag:=true

else flag:=false;

end;

T_ProdinRec.Next;

end;

{Проверка}

T_ProdinRec.First;

if flag then

{} begin

{Редактирующий цикл}

{} While not(T_ProdinRec.Eof) do begin {Ищем запись продукта}

if T_products.Locate('IDP',T_ProdinRecIDP.Value,[]) then

{} begin

ProdZak:=T_ProdinRecKol_voPvB.Value*(number-T_zakazKol_voZ.Value);

T_products.Edit;

T_productsKol_vo.Value:=T_productsKol_vo.Value-ProdZak;

T_products.Post;

end;

T_ProdinRec.Next;

end;

T_zakazKol_voZ.Value:=number

end

else begin

ZakazForm.memo1.Lines.Text:='Заказ превысил количество продуктов! Пожалуйста, повторите ввод';

T_zakazKol_voZ.Value:=1;

ZakazForm.DBGrid1.Refresh;

end;

end;

end;

procedure TMainForm.T_zakazAfterInsert(DataSet: TDataSet);

begin

T_zakazKol_voZ.Value:=1;

end;

procedure TMainForm.T_zakazAfterPost(DataSet: TDataSet);

var money,sum:real;MMark:TBookMark;

begin

try

money:=strtofloat(ZakazForm.MaskEdit1.Text);

except

ZakazForm.maskEdit1.Text:='';

ZakazForm.maskEdit1.ReadOnly:=True;

ZakazForm.maskEdit1.Color:=clBtnFace;

end;

sum:=0;

if money<>0 then begin

MMark:=T_zakaz.GetBookmark;

T_zakaz.First;

while not(T_zakaz.Eof) do begin

T_spisokB.locate('IDB',T_zakazIDB.value,[]); {Нашли блюдо}

sum:=T_spisokBStoim.Value*T_zakazKol_voZ.value+sum;

T_zakaz.Next;

end;

if T_zakaz.BookmarkValid(mmark) then T_zakaz.GotoBookmark(mmark);

if T_zakaz.BookmarkValid(mmark) then T_zakaz.FreeBookmark(mmark);

if sum>money then ZakazForm.memo1.Lines.Text:='Заказ превысил денежный предел!'

else ZakazForm.memo1.Clear;

end;

end;

{****************************SpisokB**********************888}

procedure TMainForm.T_spisokBAfterInsert(DataSet: TDataSet);

begin

T_spisokB.edit;

T_spisokBIDB.Value:=MKeyvalue;

T_spisokBFlagCur.Value:=false;

T_spisokBIdTB.Value:=1;

T_spisokB.Post;

InformForm.DBGrid1.Refresh;

end;

procedure TMainForm.T_spisokBBeforeInsert(DataSet: TDataSet);

begin

MKeyvalue:=0;

repeat

MKeyvalue:=MKeyvalue+1;

until varType(T_spisokB.lookup('IDB',MKeyvalue,'IDB'))=varnull;

end;

procedure TMainForm.T_spisokBAfterPost(DataSet: TDataSet);

begin

T_spisokB.Refresh;

end;

{****************************Products********************888}

procedure TMainForm.T_productsBeforeInsert(DataSet: TDataSet);

begin

MKeyvalue:=0;

repeat

MKeyvalue:=MKeyvalue+1;

until varType(T_products.lookup('IDP',MKeyvalue,'IDP'))=varnull;

end;

procedure TMainForm.T_productsAfterInsert(DataSet: TDataSet);

begin

T_products.edit;

T_productsIDP.Value:=MKeyvalue;

T_productsIdEI.Value:=1;

T_products.Post;

InformForm.DBGrid3.Refresh;

end;

procedure TMainForm.T_productsAfterPost(DataSet: TDataSet);

begin

T_products.Refresh;

end;

{*********************TypeB****************************}

procedure TMainForm.T_EIBeforeInsert(DataSet: TDataSet);

begin

MKeyvalue:=0;

repeat

MKeyvalue:=MKeyvalue+1;

until varType(T_EI.lookup('IdEI',MKeyvalue,'IdEI'))=varnull;

end;

procedure TMainForm.T_EIAfterInsert(DataSet: TDataSet);

begin

T_EI.edit;

T_EIIdEI.Value:=MKeyvalue;

T_EINameEI.Value:=' ';

T_EI.Post;

InformForm.DBGrid5.Refresh;

end;

procedure TMainForm.T_EIAfterPost(DataSet: TDataSet);

begin

T_EI.Refresh;

end;

{*********************TypeB****************************}

procedure TMainForm.T_typeBBeforeInsert(DataSet: TDataSet);

begin

MKeyvalue:=0;

repeat

MKeyvalue:=MKeyvalue+1;

until varType(T_typeB.lookup('IdTB',MKeyvalue,'IdTB'))=varnull;

end;

procedure TMainForm.T_typeBAfterInsert(DataSet: TDataSet);

begin

T_typeB.edit;

T_typeBIdTB.Value:=MKeyvalue;

T_typeBNameTB.Value:=' ';

T_typeB.Post;

InformForm.DBGrid4.Refresh;

end;

procedure TMainForm.BitBtn2Click(Sender: TObject);

begin

AboutBox.showmodal;

end;

procedure TMainForm.FormShow(Sender: TObject);

begin

memo1.Text:='Добро пожаловать в программу "Ресторан"';

end;

{-------------------------------------------------}

procedure TMainForm.TreeView1Click(Sender: TObject);

var F:integer;

begin

{определение текущей выделеннки}

for f:=0 to 15 do if TreeView1.Items[f].Selected then break;

memo1.Clear;

case f of

0:begin

ZakazForm.Show;

InformForm.Hide;

Aboutbox.Hide;

memo1.Text:='Ведение заказов';

end;

1:begin

InformForm.Show;Aboutbox.Hide;

InformForm.PageControl1.ActivePageIndex:=0;

InformForm.SetFocus;

memo1.Text:='Ведение справочников';

end;

2:begin

InformForm.PageControl1.ActivePageIndex:=0;

memo1.Text:='Определение меню, заполение списка блюд';

end;

3:begin //InformFrame1.PageControl1.ActivePageIndex:=1;

InformForm.PageControl1.ActivePageIndex:=1;

memo1.Text:='Ведение состояния продуктов';

end;

4:begin

InformForm.PageControl1.ActivePageIndex:=2;

memo1.Text:='Дополнительные справочники, типы ед. измерения, типы блюд';

end;

{Reports}

5:begin

InformForm.Hide;

Aboutbox.Hide;

ZakazForm.Hide;

memo1.Text:='Отчеты';

end;

{Menu} 6:begin

MenuForm.QuickRep1.Refresh;

memo1.Text:='Просмотр меню, печать';

end;

{Preview}7:begin

memo1.Text:='Просмотр меню';

MenuForm.Query1.Close;

MenuForm.Query1.Open;

MenuForm.QuickRep1.Preview;

end;

{Print}8:begin

memo1.Text:='Печать меню';

MenuForm.Query1.Close;

MenuForm.Query1.Open;

MenuForm.QuickRep1.Print;

end;

{Zakaz} 9:FRepZakaz.QuickRep1.Preview;

10: begin

memo1.Text:='Настройка шрифта меню';

FontDialog1.Font := MainForm.Font;

if FontDialog1.Execute then TreeView1.font:=FontDialog1.Font

end;

end;

end;

procedure TMainForm.FormActivate(Sender: TObject);

begin

T_EI.open;

T_Prodinrec.open;

T_products.open;

T_spisokB.open;

T_zakaz.open;

T_typeB.open;

end;

procedure TMainForm.T_zakazCalcFields(DataSet: TDataSet);

begin

T_zakazCalc_stoim.AsCurrency:=T_zakazKol_voZ.AsCurrency + T_zakazLU_CEnaB.AsCurrency

end;

end.

unit RepMenu;

interface

uses

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

Dialogs, StdCtrls, QuickRpt, QRCtrls, ExtCtrls, DB, DBTables;

type

TMenuForm = class(TForm)

QuickRep1: TQuickRep;

QRBand1: TQRBand;

QRLabel1: TQRLabel;

Query1: TQuery;

DataSource1: TDataSource;

QRDBText1: TQRDBText;

QRDBText2: TQRDBText;

QRBand2: TQRBand;

QRDBText3: TQRDBText;

QRDBText4: TQRDBText;

QRDBText5: TQRDBText;

QRDBText6: TQRDBText;

QRBand3: TQRBand;

QRExpr1: TQRExpr;

QRDBText7: TQRDBText;

QRLabel2: TQRLabel;

QRLabel3: TQRLabel;

QRLabel4: TQRLabel;

QRExpr2: TQRExpr;

QRLabel5: TQRLabel;

QRLabel6: TQRLabel;

QRShape2: TQRShape;

QRShape3: TQRShape;

QRShape4: TQRShape;

QRLabel7: TQRLabel;

QRShape5: TQRShape;

QRShape1: TQRShape;

QRShape6: TQRShape;

private

{ Private declarations }

public

{ Public declarations }

end;

var

MenuForm: TMenuForm;

implementation

{$R *.dfm}

end.

unit RepZakaz;

interface

uses

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

Dialogs, QuickRpt, QRCtrls, ExtCtrls;

type

TFRepZakaz = class(TForm)

QuickRep1: TQuickRep;

QRBand1: TQRBand;

QRBand2: TQRBand;

QRDBText1: TQRDBText;

QRDBText2: TQRDBText;

QRLabel1: TQRLabel;

QRBand3: TQRBand;

QRLabel2: TQRLabel;

QRLabel3: TQRLabel;

QRShape1: TQRShape;

private

{ Private declarations }

public

{ Public declarations }

end;

var

FRepZakaz: TFRepZakaz;

implementation

uses Main;

{$R *.dfm}

end.

unit ZakazUnit;

interface

uses

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

Dialogs, ExtCtrls, DBCtrls, Grids, DBGrids, StdCtrls, Buttons, Mask;

type

TZakazForm = class(TForm)

DBGrid1: TDBGrid;

DBNavigator1: TDBNavigator;

BitBtn1: TBitBtn;

Clear: TBitBtn;

Panel1: TPanel;

Preview: TBitBtn;

Print: TBitBtn;

Memo1: TMemo;

MaskEdit1: TEdit;

procedure ClearClick(Sender: TObject);

procedure PreviewClick(Sender: TObject);

procedure PrintClick(Sender: TObject);

procedure FormActivate(Sender: TObject);

procedure BitBtn1Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

ZakazForm: TZakazForm;

implementation

uses Main, RepZakaz;

{$R *.dfm}

procedure TZakazForm.ClearClick(Sender: TObject);

begin

MainForm.T_zakaz.close;

MainForm.T_zakaz.EmptyTable;

MainForm.T_zakaz.Open;

end;

procedure TZakazForm.PreviewClick(Sender: TObject);

begin

FRepZakaz.QuickRep1.Preview;

end;

procedure TZakazForm.PrintClick(Sender: TObject);

begin

FRepZakaz.QuickRep1.Print;

end;

procedure TZakazForm.FormActivate(Sender: TObject);

begin

if not(MainForm.T_zakaz.Active) then MainForm.T_zakaz.Open;

end;

procedure TZakazForm.BitBtn1Click(Sender: TObject);

begin

ZakazForm.Hide;

end;

end.