Разработка приложения «Турфирма»

 

Приложение

Листинг модуля данных (Data Module)

unit UnitDM;

interface

uses SysUtils, Classes, DB, ADODB;

type

  TDM = class(TDataModule)

    ADOConnection1: TADOConnection;

    Contry: TADOTable;

    Tur: TADOTable;

    Putevka: TADOTable;

    Zakaz: TADOTable;

    Operator: TADOTable;

    DSContry: TDataSource;

    DSTur: TDataSource;

    DSPutevka: TDataSource;

    DSZakaz: TDataSource;

    DSOperator: TDataSource;

    ContryDSDesigner: TAutoIncField;

    ContryDSDesigner2: TWideStringField;

    ContryDSDesigner3: TBooleanField;

    Tur_: TAutoIncField;

    Tur_2: TIntegerField;

    Tur_3: TIntegerField;

    TurDSDesigner: TWideStringField;

    TurDSDesigner2: TMemoField;

    TurField: TStringField;

    TurField2: TStringField;

    TurField3: TStringField;

    Putevka_: TAutoIncField;

    Putevka_2: TIntegerField;

    PutevkaDSDesigner: TIntegerField;

    PutevkaDSDesigner2: TBooleanField;

    PutevkaDSDesigner3: TBooleanField;

    PutevkaDSDesigner4: TBCDField;

    PutevkaDSDesigner5: TBooleanField;

    PutevkaDSDesigner6: TIntegerField;

    PutevkaDSDesigner7: TBCDField;

    Zakaz_: TAutoIncField;

    Zakaz_2: TIntegerField;

    ZakazDSDesigner: TWideStringField;

    ZakazDSDesigner2: TBooleanField;

    ZakazField: TIntegerField;

    ZakazField2: TStringField;

    ZakazField3: TIntegerField;

    ZakazField4: TIntegerField;

    ZakazField5: TIntegerField;

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

      DisplayText: Boolean);

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

      DisplayText: Boolean);

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

      DisplayText: Boolean);

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

      DisplayText: Boolean);

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

      DisplayText: Boolean);

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

      DisplayText: Boolean);

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

      DisplayText: Boolean);

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

      DisplayText: Boolean);

  private

    { Private declarations }

  public

    { Public declarations }

  end;

 

var

  DM: TDM;

 

implementation

 

{$R *.dfm}

 

procedure TDM.ContryDSDesigner3GetText(Sender: TField; var Text: String;

  DisplayText: Boolean);

begin

if Contry.Fields[2].AsBoolean then Text:= 'необходима'

  else Text:= 'не нужна';

end;

 

procedure TDM.TurField2GetText(Sender: TField; var Text: String;

  DisplayText: Boolean);

begin

if Tur.Fields[6].AsBoolean then Text:= 'да'

  else Text:= 'нет';

end;

 

procedure TDM.PutevkaDSDesigner2GetText(Sender: TField; var Text: String;

  DisplayText: Boolean);

begin

if Putevka.Fields[3].AsBoolean then Text:='Включено';

end;

 

procedure TDM.PutevkaDSDesigner3GetText(Sender: TField; var Text: String;

  DisplayText: Boolean);

begin

if Putevka.Fields[4].AsBoolean then Text:='Включено';

end;

 

procedure TDM.PutevkaDSDesigner5GetText(Sender: TField; var Text: String;

  DisplayText: Boolean);

begin

if Putevka.fields[6].AsBoolean then Text:= 'ДА';

end;

 

procedure TDM.PutevkaDSDesigner7GetText(Sender: TField; var Text: String;

  DisplayText: Boolean);

begin

if Putevka.Fields[7].AsString='' then Text:= FloatToStr(Putevka.Fields[5].AsInteger)

else

Text:= FloatToStr(Putevka.Fields[5].AsInteger*(1-Putevka.Fields[7].AsInteger/100));

end;

 

procedure TDM.ZakazDSDesigner2GetText(Sender: TField; var Text: String;

  DisplayText: Boolean);

begin

if Zakaz.Fields[3].AsBoolean then Text:= 'Оплачено'

        else Text:= 'не оплачено';

end;

 

procedure TDM.ZakazField3GetText(Sender: TField; var Text: String;

  DisplayText: Boolean);

begin

if Zakaz.Fields[8].AsString='' then Text:= floattostr(Zakaz.Fields[7].AsFloat)

else Text:= Floattostr(Zakaz.Fields[7].AsInteger*(1-Zakaz.Fields[8].AsInteger/100));

end;

end.

Листинг Главной формы  программы

unit Unit1;

interface

uses

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

  Dialogs, Menus;

type

  TForm1 = class(TForm)

    MainMenu1: TMainMenu;

    N1: TMenuItem;

    N2: TMenuItem;

    N3: TMenuItem;

    N4: TMenuItem;

    N5: TMenuItem;

    N6: TMenuItem;

    N7: TMenuItem;

    N8: TMenuItem;

    N9: TMenuItem;

    N10: TMenuItem;

    N11: TMenuItem;

    N12: TMenuItem;

    procedure FormCreate(Sender: TObject);

    procedure N11Click(Sender: TObject);

    procedure N5Click(Sender: TObject);

    procedure N4Click(Sender: TObject);

    procedure N9Click(Sender: TObject);

    procedure N10Click(Sender: TObject);

    procedure N12Click(Sender: TObject);

    procedure N7Click(Sender: TObject);

    procedure N8Click(Sender: TObject);

  private

    { Private declarations }

  public

    { Public declarations }

  end;

 

var

  Form1: TForm1;

 

implementation

 

uses UnitDM, UnitContry, UnitOperator, UnitTurPut, UnitTur, UnitPut,

  UnitZakaz, UnitOform;

 

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);

begin

Form1.Top:= 0;

Form1.Left:= 0;

Form1.Width:= Screen.Width;

Form1.Height:= Screen.Height - 100;

end;

 

procedure TForm1.N11Click(Sender: TObject);

begin

Application.Terminate;

end;

 

procedure TForm1.N5Click(Sender: TObject);

begin Form2:= TForm2.Create(Application); end;

 

procedure TForm1.N4Click(Sender: TObject);

begin Form3:= TForm3.Create(Application); end;

 

procedure TForm1.N9Click(Sender: TObject);

begin

Form4:= TForm4.Create(Application);

end;

 

procedure TForm1.N12Click(Sender: TObject);

begin Form6:= TForm6.Create(Application); end;

 

procedure TForm1.N7Click(Sender: TObject);

begin  Form7:= TForm7.Create(Application); end;

 

procedure TForm1.N8Click(Sender: TObject);

begin Form8:= TForm8.Create(Application); end;

end.

Листинг формы «Заказы»

unit UnitZakaz;

interface

uses

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

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

type

  TForm7 = class(TForm)

    DBGrid1: TDBGrid;

    Panel1: TPanel;

    BitBtn1: TBitBtn;

    BitBtn2: TBitBtn;

    BitBtn3: TBitBtn;

    procedure BitBtn1Click(Sender: TObject);

    procedure FormClose(Sender: TObject; var Action: TCloseAction);

    procedure BitBtn3Click(Sender: TObject);

    procedure BitBtn2Click(Sender: TObject);

  private     { Private declarations }   public

    end;

var

  Form7: TForm7;

implementation

uses UnitDM, UnitOform;

{$R *.dfm}

procedure TForm7.BitBtn1Click(Sender: TObject);

begin Close; end;

 

procedure TForm7.FormClose(Sender: TObject; var Action: TCloseAction);

begin Action:= caFree; end;

 

procedure TForm7.BitBtn3Click(Sender: TObject);

begin

if MessageBox(Handle,PChar('Удаление заказа'),PChar('Удалить заказ?'),mb_YesNo)=idYes

then DM.Zakaz.Delete;

end;

 

procedure TForm7.BitBtn2Click(Sender: TObject);

begin

Form8:= TForm8.Create(Application);

end;

end.