Тема: Разработка автоматизированной системы для Бюро недвижимости «Баст-ЕТ» (стр. 19 )

  FileExit1: TFileExit;

  acDistrict: TAction;

  acRealtor: TAction;

  acContrag: TAction;

  BitBtn2: TBitBtn;

  acRealty: TAction;

  acSpecific: TAction;

  acRealtyTypeCpecific: TAction;

  acRequest: TAction;

  BitBtn7: TBitBtn;

  acDeal: TAction;

  BitBtn8: TBitBtn;

  acStat: TAction;

  BitBtn9: TBitBtn;

  Image1: TImage;

  procedure acDistrictExecute(Sender: TObject);

  procedure acRealtorExecute(Sender: TObject);

  procedure acContragExecute(Sender: TObject);

  procedure acRealtyExecute(Sender: TObject);

  procedure acSpecificExecute(Sender: TObject);

  procedure acRealtyTypeCpecificExecute(Sender: TObject);

  procedure acRequestExecute(Sender: TObject);

  procedure acDealExecute(Sender: TObject);

  procedure acStatExecute(Sender: TObject);

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

private

  { Private declarations }

public

  { Public declarations }

end;

var

fmMain: TfmMain;

implementation

uses uDistrict, uRealtor, uContrag, uRealty, uSpecific, uTypicalSpecific,

uRequest, uDeal, uStat, uLogin;

{$R *.dfm}

procedure TfmMain.acDistrictExecute(Sender: TObject);

begin

fmDistrict.Show;

end;

procedure TfmMain.acRealtorExecute(Sender: TObject);

begin

fmRealtor.Show;

end;

procedure TfmMain.acContragExecute(Sender: TObject);

begin

fmContrag.Show;

end;

procedure TfmMain.acRealtyExecute(Sender: TObject);

begin

fmRealty.Show;

end;

procedure TfmMain.acSpecificExecute(Sender: TObject);

begin

fmSpecific.Show;

end;

procedure TfmMain.acRealtyTypeCpecificExecute(Sender: TObject);

begin

fmTypicalSpecific.Show;

end;

procedure TfmMain.acRequestExecute(Sender: TObject);

begin

fmRequest.Show;

end;

procedure TfmMain.acDealExecute(Sender: TObject);

begin

fmDeal.Show;

end;

procedure TfmMain.acStatExecute(Sender: TObject);

begin

fmStat.Show;

end;

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

begin

fmLogin.Close;

end;

end.

Программный модуль uRealtor.pas

unit uRealtor;

interface

uses

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

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

type

TfmRealtor = class(TForm)

  DBGrid1: TDBGrid;

  Panel1: TPanel;

  DBNavigator1: TDBNavigator;

  bbtClose: TBitBtn;

  bbtPrint: TBitBtn;

  procedure FormShow(Sender: TObject);

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

  procedure bbtPrintClick(Sender: TObject);

  procedure bbtCloseClick(Sender: TObject);

private

  { Private declarations }

public

  { Public declarations }

end;

var

fmRealtor: TfmRealtor;

implementation

uses uDM, uDocs, uCard, uReqCard, uRequest, uRealty, uDeal;

{$R *.dfm}

procedure TfmRealtor.FormShow(Sender: TObject);

begin

DM.dstRealtor.Open;

DM.dstRealtor.Sort := 'ФИО';

end;

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

begin

//Если форма, на которой используется набор данных в данный момент закрыта, то

//набор данных также закрывается:

if (not fmCard.Showing) and (not fmReqCard.Showing) and (not fmRequest.Showing)

  and (not fmRealty.Showing) and (not fmDeal.Showing) then

  DM.dstRealtor.Close;

end;

procedure TfmRealtor.bbtPrintClick(Sender: TObject);

begin

DocAuto(DBGrid1, 1, Self.Caption);

end;

procedure TfmRealtor.bbtCloseClick(Sender: TObject);

begin

Close;

end;

end.

Программный модуль uRealty.pas

unit uRealty;

interface

uses

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

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

type

TfmRealty = class(TForm)

  DBGrid1: TDBGrid;

  Panel1: TPanel;

  DBNavigator1: TDBNavigator;

  bbtClose: TBitBtn;

  bbtPrint: TBitBtn;

  GroupBox1: TGroupBox;

  dblcbRealtyType: TDBLookupComboBox;

  dblcbDistrict: TDBLookupComboBox;

  edAdress: TEdit;

  dblcbDealType: TDBLookupComboBox;

  dtpDate1: TDateTimePicker;

  dtpDate2: TDateTimePicker;

  chbRealtyType: TCheckBox;

  chbDistrict: TCheckBox;

  chbAdress: TCheckBox;

  chbDealType: TCheckBox;

  chbDate1: TCheckBox;

  chbDate2: TCheckBox;

  chbActual: TCheckBox;

  chbRealtor: TCheckBox;

  dblcbRealtor: TDBLookupComboBox;

  bbtCard: TBitBtn;

  bbtOK: TBitBtn;

  procedure FormShow(Sender: TObject);

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

  procedure bbtPrintClick(Sender: TObject);

  procedure chbRealtyTypeClick(Sender: TObject);

  procedure FormCreate(Sender: TObject);

  procedure bbtCloseClick(Sender: TObject);

  procedure bbtCardClick(Sender: TObject);

  procedure DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect;

    DataCol: Integer; Column: TColumn; State: TGridDrawState);

private

  { Private declarations }

public

  { Public declarations }

end;

var

fmRealty: TfmRealty;

implementation

uses uDM, uDocs, uCard, uDeal;

{$R *.dfm}

procedure TfmRealty.FormShow(Sender: TObject);

begin

DM.dstRealty.Open;

DM.dstContrag.Open;

DM.dstRealtyType.Open;

DM.dstDistrict.Open;

DM.dstRealtor.Open;

DM.dstDealType.Open;

DM.dstContrag.Sort := 'ФИО_Наименование';

chbRealtyTypeClick(Self);

end;

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

begin

//Если форма, на которой используется набор данных в данный момент закрыта, то

//набор данных также закрывается:

if not fmDeal.Showing then

begin

  DM.dstRealty.Close;

  DM.dstContrag.Close;

  DM.dstRealtyType.Close;

  DM.dstDistrict.Close;

  DM.dstRealtor.Close;

  DM.dstDealType.Close;

end;

end;

procedure TfmRealty.bbtPrintClick(Sender: TObject);

begin

DocAuto(DBGrid1, 11, Self.Caption);

end;

//Фильтрация списка объектов недвижимости по заданным критериям:

procedure TfmRealty.chbRealtyTypeClick(Sender: TObject);

var

Filter: string;

begin

Filter := '';

if chbAdress.Checked and (Trim(edAdress.Text) <> '') then

  Filter := 'Адрес like ' + QuotedStr('%' + Trim(edAdress.Text) + '%');

if chbDate1.Checked then

begin

  if Filter <> '' then

    Filter := Filter + ' and ';

  Filter := Filter + 'ДатаПредлож >= ' + QuotedStr(DateToStr(dtpDate1.Date));

end;

if chbDate2.Checked then

begin

  if Filter <> '' then

    Filter := Filter + ' and ';

  Filter := Filter + 'ДатаПредлож <= ' + QuotedStr(DateToStr(dtpDate2.Date));

end;

if chbActual.Checked then

begin

  if Filter <> '' then

    Filter := Filter + ' and ';

  Filter := Filter + 'Актуально = True';

end;

if chbRealtyType.Checked and (dblcbRealtyType.KeyValue <> Null) then

begin

  if Filter <> '' then

    Filter := Filter + ' and ';

  Filter := Filter + 'ТипНедвижID = ' + IntToStr(dblcbRealtyType.KeyValue);

end;

if chbRealtor.Checked and (dblcbRealtor.KeyValue <> Null) then

begin

  if Filter <> '' then

    Filter := Filter + ' and ';

  Filter := Filter + 'РиэлторID = ' + IntToStr(dblcbRealtor.KeyValue);

end;

if chbDistrict.Checked and (dblcbDistrict.KeyValue <> Null) then

begin

  if Filter <> '' then

    Filter := Filter + ' and ';

  Filter := Filter + 'РайонID = ' + IntToStr(dblcbDistrict.KeyValue);

end;

if chbDealType.Checked and (dblcbDealType.KeyValue <> Null) then

begin

  if Filter <> '' then

    Filter := Filter + ' and ';

  Filter := Filter + 'ТипСделкиID = ' + IntToStr(dblcbDealType.KeyValue);

end;

if Filter <> '' then

begin

  DM.dstRealty.Filter := Filter;

  DM.dstRealty.Filtered := True;

end

else

  DM.dstRealty.Filtered := False;

end;

procedure TfmRealty.FormCreate(Sender: TObject);

begin

dtpDate1.Date := Date - 60;

dtpDate2.Date := Date;

end;

procedure TfmRealty.bbtCloseClick(Sender: TObject);

begin

Close;

end;

procedure TfmRealty.bbtCardClick(Sender: TObject);

begin

fmCard.ShowModal;

end;

//Выделение цветом неактуальных записей:

procedure TfmRealty.DBGrid1DrawColumnCell(Sender: TObject;

const Rect: TRect; DataCol: Integer; Column: TColumn;

State: TGridDrawState);

begin

if not DM.dstRealty.FieldByName('Актуально').AsBoolean then

  DBGrid1.Canvas.Brush.Color := clGray;

DBGrid1.DefaultDrawColumnCell(Rect, DataCol, Column, State);

end;

end.

Программный модуль uReqCard.pas

unit uReqCard;

interface

uses

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

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

ExtDlgs;

type

TfmReqCard = class(TForm)

  sgResult: TStringGrid;

  Panel1: TPanel;

  Panel4: TPanel;

  DBGrid1: TDBGrid;