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

  Panel2: TPanel;

  bbtSearch: TBitBtn;

  DBNavigator1: TDBNavigator;

  bbtPrint: TBitBtn;

  bbtClose: TBitBtn;

  Panel3: TPanel;

  Label1: TLabel;

  Label2: TLabel;

  Label3: TLabel;

  Label5: TLabel;

  Label6: TLabel;

  Label9: TLabel;

  Label10: TLabel;

  Label4: TLabel;

  Label8: TLabel;

  Label11: TLabel;

  Label7: TLabel;

  DBLookupComboBox1: TDBLookupComboBox;

  dblcbType: TDBLookupComboBox;

  DBLookupComboBox3: TDBLookupComboBox;

  DBLookupComboBox4: TDBLookupComboBox;

  DBEdit5: TDBEdit;

  DBCheckBox1: TDBCheckBox;

  DBLookupComboBox5: TDBLookupComboBox;

  DBMemo1: TDBMemo;

  DBEdit1: TDBEdit;

  DBEdit2: TDBEdit;

  lbWarning: TLabel;

  procedure FormShow(Sender: TObject);

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

  procedure bbtCloseClick(Sender: TObject);

  procedure bbtPrintClick(Sender: TObject);

  procedure bbtSearchClick(Sender: TObject);

  procedure FormCreate(Sender: TObject);

  procedure DBEdit1Enter(Sender: TObject);

  procedure DBEdit1Exit(Sender: TObject);

  procedure sgResultDblClick(Sender: TObject);

private

  { Private declarations }

public

  { Public declarations }

end;

var

fmReqCard: TfmReqCard;

implementation

uses uDM, uDocs, DB, ADODB, uCard;

{$R *.dfm}

procedure TfmReqCard.FormShow(Sender: TObject);

var

i: Integer;

begin

DM.dstReqSpecific.Open;

DM.dstRequest.Open;

DM.dstSpecific.Sort := 'Характеристика';

if DM.dstRequest.State <> dsInsert then

  bbtSearchClick(Self)

else

begin

  //Очистка таблицы результатов поиска:

  sgResult.RowCount := 2;

  for i:= 1 to sgResult.RowCount-1 do

    sgResult.Rows[i].Clear;

end;

end;

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

begin

//Сохранение внесенных данных:

if DM.dstReqSpecific.State in [dsEdit, dsInsert] then

  DM.dstReqSpecific.Post;

if DM.dstRequest.State in [dsEdit, dsInsert] then

  DM.dstRequest.Post;

DM.dstReqSpecific.Close;

end;

procedure TfmReqCard.bbtCloseClick(Sender: TObject);

begin

Close;

end;

procedure TfmReqCard.bbtPrintClick(Sender: TObject);

begin

DocCardRequest;

end;

procedure TfmReqCard.bbtSearchClick(Sender: TObject);

var

i: Integer;

Value1, Value2: Double;

SpecResult, SearchResult: Boolean;

begin

//Очистка таблицы результатов поиска:

sgResult.RowCount := 2;

for i:= 1 to sgResult.RowCount-1 do

  sgResult.Rows[i].Clear;

i := 0;

//Отбор объектов в базе по основным параметрам:

DM.dstRealty.Filter := 'Актуально = True and ТипНедвижID = ' +

  DM.dstRequest.FieldByName('ТипНедвижID').AsString + ' and ТипСделкиID = ' +

  DM.dstRequest.FieldByName('ТипСделкиID').AsString + ' and Цена <= ' +

  DM.dstRequest.FieldByName('ЦенаДо').AsString;

if (DM.dstRequest.FieldByName('Район').AsString <> 'Любой') then

  DM.dstRealty.Filter := DM.dstRealty.Filter + ' and РайонID = ' +

    DM.dstRequest.FieldByName('РайонID').AsString;

DM.dstRealty.Filtered := True;

DM.dstRealty.Open;

DM.dstRealtySpecific.Open;

DM.dstRealty.First;

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

while not DM.dstRealty.Eof do

begin

  //Отбор объектов в базе по дополнительным характеристикам:

  DM.dstReqSpecific.First;

  SearchResult := True; //Результат сранения объекта по всем характеристикам

  //Цикл по характеристикам объекта в заявке:

  while not DM.dstReqSpecific.Eof do

  begin

    //Если у текущего объекта в базе есть текущая характеристика по заявке, то

    //производится сравнение:

    if DM.dstRealtySpecific.Locate('ХарактID', DM.dstReqSpecific.FieldByName('ХарактID').AsInteger, []) then

    begin

      SpecResult := False; //Результат сранения объекта по текущей характеристике

      //Если в заявке задано конкретное значение характеристики, производится сравнение:

      if not DM.dstReqSpecific.FieldByName('Значение').IsNull then

        SpecResult := DM.dstRealtySpecific.FieldByName('Значение').Value =

    DM.dstReqSpecific.FieldByName('Значение').Value

      else

      begin

        //Если в заявке задан диапазон значений характеристики, производится перевод в числа:

        if TryStrToFloat(DM.dstRealtySpecific.FieldByName('Значение').AsString, Value1) then

if (not DM.dstReqSpecific.FieldByName('ЗначениеОт').IsNull) and

   (TryStrToFloat(DM.dstReqSpecific.FieldByName('ЗначениеОт').AsString, Value2)) then

  SpecResult := Value1 >= Value2;

        //Если результат сравнения значения со значением "от" положительный, срасниваем со знчение "до":

        if SpecResult and (not DM.dstReqSpecific.FieldByName('ЗначениеДо').IsNull) and

(TryStrToFloat(DM.dstReqSpecific.FieldByName('ЗначениеДо').AsString, Value2)) then

  SpecResult := Value1 <= Value2;

      end;

      if not SpecResult then

        SearchResult := False;

    end; //if DM.dstRealtySpecific.Locate

    DM.dstReqSpecific.Next;

  end; //while not DM.dstReqSpecific.Eof

  //Добавление новой строки в таблицу результатов, если результат сравнения положительный:

  if SearchResult then

  begin

    Inc(i);

    if i <> 1 then

      sgResult.RowCount := sgResult.RowCount + 1;

    //Вывод в таблицу результатов поиска:

    sgResult.Cells[0,i] := DM.dstRealty.FieldByName('Описание').AsString;

    sgResult.Cells[1,i] := DM.dstRealty.FieldByName('Адрес').AsString;

    sgResult.Cells[2,i] := DM.dstRealty.FieldByName('Район').AsString;

    sgResult.Cells[3,i] := DM.dstRealty.FieldByName('Контрагент').AsString;

    sgResult.Cells[4,i] := FormatFloat('0.00', DM.dstRealty.FieldByName('Цена').AsFloat);

    sgResult.Cells[5,i] := DM.dstRealty.FieldByName('ДатаПредлож').AsString;

    sgResult.Cells[6,i] := DM.dstRealty.FieldByName('Риэлтор').AsString;

    sgResult.Cells[7,i] := FormatFloat('00000', DM.dstRealty.FieldByName('ID').AsFloat);

  end;

  DM.dstRealty.Next;

end; //while not DM.dstRealty.Eof

DM.dstRealty.Close;

DM.dstRealtySpecific.Close;

end;

procedure TfmReqCard.FormCreate(Sender: TObject);

begin

sgResult.Cells[0,0] := 'Описание';

sgResult.Cells[1,0] := 'Адрес';

sgResult.Cells[2,0] := 'Район';

sgResult.Cells[3,0] := 'Контрагент';

sgResult.Cells[4,0] := 'Цена, руб.';

sgResult.Cells[5,0] := 'Дата предложения';

sgResult.Cells[6,0] := 'Риэлтор';

sgResult.Cells[7,0] := 'Шифр объекта';

end;

//При получении фокуса поля ввода цены отображается уведомление:

procedure TfmReqCard.DBEdit1Enter(Sender: TObject);

begin

if dblcbType.Text = 'Аренда' then

  lbWarning.Visible := True;

end;

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

procedure TfmReqCard.DBEdit1Exit(Sender: TObject);

begin

lbWarning.Visible := False;

end;

procedure TfmReqCard.sgResultDblClick(Sender: TObject);

begin

DM.dstRealty.Open;

if DM.dstRealty.Locate('ID', StrToInt(sgResult.Cells[7, sgResult.Row]), []) then

  fmCard.Show;

end;

end.

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

unit uRequest;

interface

uses

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

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

type

TfmRequest = class(TForm)

  DBGrid1: TDBGrid;

  Panel1: TPanel;

  DBNavigator1: TDBNavigator;

  bbtClose: TBitBtn;

  bbtPrint: TBitBtn;

  GroupBox1: TGroupBox;

  dblcbRealtyType: TDBLookupComboBox;

  dblcbDistrict: TDBLookupComboBox;

  dblcbDealType: TDBLookupComboBox;

  dtpDate1: TDateTimePicker;

  dtpDate2: TDateTimePicker;

  chbRealtyType: TCheckBox;

  chbDistrict: TCheckBox;

  chbDealType: TCheckBox;

  chbDate1: TCheckBox;

  chbDate2: TCheckBox;

  chbActual: TCheckBox;

  chbRealtor: TCheckBox;

  dblcbRealtor: TDBLookupComboBox;

  bbtCard: 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

fmRequest: TfmRequest;

implementation

uses uDM, uDocs, uReqCard;

{$R *.dfm}