101
procedure TForm_gorod_st_ad.Edit4KeyPress(Sender: TObject; var Key: Char);
var
lnKod:integer;
begin
// сначала ищу в справочнике улиц наименование,
// потом получаю код улицы, далее ищу по коду улицы улицу в адресах
if Key=#13 then
if not DM.tab_street.Locate('Наименование', Edit4.Text, [loCaseInsensitive, loPartialKey]) then
ShowMessage('Запись по улице не найдена!')
else begin
lnKod:=DM.tab_street.FieldByName('КодУлицы').Value;
if not DM.tab_adres.Locate('КодУлицы', lnKod, [loCaseInsensitive, loPartialKey]) then
ShowMessage('Запись по улице не найдена!')
else
DBGrid3.SetFocus;
end;
end;
end.
Программный модуль « Unit_object.pas»
Предназначен для работы со справочником объектов.
unit Unit_object;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, DBCtrls, Grids, DBGrids, DB, ADODB, DBCGrids,
Buttons;
type
TForm_object = class(TForm)
Label1: TLabel;
DBGrid1: TDBGrid;
DBNavigator1: TDBNavigator;
Edit1: TEdit;
Button1: TButton;
DBMemo1: TDBMemo;
Label7: TLabel;
Label2: TLabel;
Edit2: TEdit;
DBGrid2: TDBGrid;
DBNavigator2: TDBNavigator;
Label3: TLabel;
DBGrid3: TDBGrid;
DBNavigator3: TDBNavigator;
Label4: TLabel;
GroupBox1: TGroupBox;
DBLookupCB_vid: TDBLookupComboBox;
DBLookupCB_status: TDBLookupComboBox;
CheckBox_vid: TCheckBox;
CheckBox_status: TCheckBox;
BitBtn1: TBitBtn;
BitBtn2: TBitBtn;
102
DBGrid4: TDBGrid;
DBNavigator4: TDBNavigator;
Label5: TLabel;
procedure DBGrid1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure DBGrid1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure DBGrid1KeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure DBGrid1KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure BitBtn2Click(Sender: TObject);
procedure BitBtn1Click(Sender: TObject);
procedure CheckBox_statusClick(Sender: TObject);
procedure CheckBox_vidClick(Sender: TObject);
procedure Edit2KeyPress(Sender: TObject; var Key: Char);
procedure Edit1KeyPress(Sender: TObject; var Key: Char);
procedure Button1Click(Sender: TObject);
procedure NaimCaption();
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form_object: TForm_object;
implementation
{$R *.dfm}
uses unit_menu, unit_dm;
procedure TForm_object.Button1Click(Sender: TObject);
begin
Form_object.Close;
end;
procedure TForm_object.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
if Key=#13 then
if not DM.tab_object.Locate('КодОбъекта', Edit1.Text, [loCaseInsensitive, loPartialKey]) then
ShowMessage('Запись не найдена!')
else
DBGrid1.SetFocus;
end;
procedure TForm_object.Edit2KeyPress(Sender: TObject; var Key: Char);
var
lnKod:integer;
begin
// поиск по адресу через ввод значения в одно поле
// сначала ищу в справочнике городов наименование,
// потом получаю код города, далее ищу по коду города город в адресах
if Key=#13 then
if not DM.tab_gorod.Locate('Наименование', Edit2.Text, [loCaseInsensitive, loPartialKey]) then
// тогда ищу в справочнике улиц наименование,
if not DM.tab_street.Locate('Наименование', Edit2.Text, [loCaseInsensitive, loPartialKey]) then
103
ShowMessage('Запись по городу не найдена!')
else begin
lnKod:=DM.tab_street.FieldByName('КодУлицы').Value;
if not DM.tab_adres.Locate('КодУлицы', lnKod, [loCaseInsensitive, loPartialKey]) then
ShowMessage('Запись по улице не найдена!')
else begin
lnKod:=DM.tab_adres.FieldByName('КодАдреса').Value;
if not DM.tab_object.Locate('КодАдреса', lnKod, [loCaseInsensitive, loPartialKey]) then
ShowMessage('Запись по городу не найдена!')
else
DBGrid1.SetFocus;
end;
end
else begin
lnKod:=DM.tab_gorod.FieldByName('КодГорода').Value;
if not DM.tab_adres.Locate('КодГорода', lnKod, [loCaseInsensitive, loPartialKey]) then
ShowMessage('Запись по городу не найдена!')
else begin
lnKod:=DM.tab_adres.FieldByName('КодАдреса').Value;
if not DM.tab_object.Locate('КодАдреса', lnKod, [loCaseInsensitive, loPartialKey]) then
ShowMessage('Запись по городу не найдена!')
else
DBGrid1.SetFocus;
end;
end;
end;
procedure TForm_object.CheckBox_vidClick(Sender: TObject);
begin
if CheckBox_vid.Checked=false then
DBLookupCB_vid.Enabled:=false
else
DBLookupCB_vid.Enabled:=true;
end;
procedure TForm_object.CheckBox_statusClick(Sender: TObject);
begin
if CheckBox_status.Checked=false then
DBLookupCB_status.Enabled:=false
else
DBLookupCB_status.Enabled:=true;
end;
procedure TForm_object.BitBtn1Click(Sender: TObject);
begin
// устанавливаю фильтр, если все галочки снять, то фильтр удаляется
DM.tab_object.Filtered:=false;
if (CheckBox_vid.Checked=true) AND (CheckBox_status.Checked=true) then
if (DBLookupCB_vid.KeyValue<>null) and (DBLookupCB_status.KeyValue<>null) then
DM.tab_object.Filter:='КодВидОООбъекта='+IntToStr(DM.tab_vid['КодОбъекта'])+
' AND КодСтатуса='+IntToStr(DM.tab_status['КодСтатуса'])
else
ShowMessage('Одно из полей фильтра не заполнено!')
else
if (CheckBox_vid.Checked=true) AND (CheckBox_status.Checked=false) then
104
if DBLookupCB_vid.KeyValue<>null then
DM.tab_object.Filter:='КодВидОООбъекта='+IntToStr(DM.tab_vid['КодОбъекта'])
else
ShowMessage('Не выбрано значение для фильтра по виду объекта!')
else
if (CheckBox_vid.Checked=false) AND (CheckBox_status.Checked=true) then
if DBLookupCB_status.KeyValue<>null then
DM.tab_object.Filter:='КодСтатуса='+IntToStr(DM.tab_status['КодСтатуса'])
else
ShowMessage('Не выбрано значение для фильтра по статусу объекта!')
else
DM.tab_object.Filtered:=false;
DM.tab_object.Filtered:=true;
end;
procedure TForm_object.BitBtn2Click(Sender: TObject);
begin
// удаляю фильтр
DM.tab_object.Filtered:=false;
end;
procedure TForm_object.DBGrid1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
NaimCaption;
end;
procedure TForm_object.DBGrid1KeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
NaimCaption;
end;
procedure TForm_object.DBGrid1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y:
Integer);
begin
NaimCaption;
end;
procedure TForm_object.DBGrid1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y:
Integer);
begin
NaimCaption;
end;
procedure TForm_object.NaimCaption();
begin
if DM.tab_object['Наименование'] <> null then
Form_object.Caption:='ОБЪЕКТ '+ DM.tab_object['Наименование']
else
Form_object.Caption:='ОБЪЕКТЫ';
end;
end.
105
Программный модуль « Unit_sotrud.pas»
Предназначен для работы со справочником сотрудников арендатора.
unit Unit_sotrud;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, DBCtrls, Grids, DBGrids, DB, ADODB;
type
TForm_sotrud = class(TForm)
Label1: TLabel;
DBGrid1: TDBGrid;
DBNavigator1: TDBNavigator;
Edit1: TEdit;
Button1: TButton;
procedure Edit1KeyPress(Sender: TObject; var Key: Char);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form_sotrud: TForm_sotrud;
implementation
{$R *.dfm}
uses unit_menu, unit_dm;
procedure TForm_sotrud.Button1Click(Sender: TObject);
begin
Form_sotrud.Close;
end;
procedure TForm_sotrud.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
if Key=#13 then
if not DM.tab_sotr.Locate('Фамилия', Edit1.Text, [loCaseInsensitive, loPartialKey]) then
ShowMessage('Запись не найдена!')
else
DBGrid1.SetFocus;
end;
end.
Программный модуль « Unit_status.pas»
Предназначен для работы со справочником статусов объекта.
106
unit Unit_status;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, DBCtrls, Grids, DBGrids, DB, ADODB;
type
TForm_status = class(TForm)
Label1: TLabel;
DBGrid1: TDBGrid;
DBNavigator1: TDBNavigator;
Edit1: TEdit;
Button1: TButton;
procedure Edit1KeyPress(Sender: TObject; var Key: Char);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form_status: TForm_status;
implementation
{$R *.dfm}
uses unit_menu, unit_dm;
procedure TForm_status.Button1Click(Sender: TObject);
begin
Form_status.Close;
end;
procedure TForm_status.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
if Key=#13 then
if not DM.tab_status.Locate('Наименование', Edit1.Text, [loCaseInsensitive, loPartialKey]) then
ShowMessage('Запись не найдена!')
else
DBGrid1.SetFocus;
end;
end.
Программный модуль « Unit_vid.pas»
Предназначен для работы со справочником видов объекта.
unit Unit_vid;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, DBCtrls, Grids, DBGrids, DB, ADODB;
type
107
TForm_vid = class(TForm)
Label1: TLabel;
DBGrid1: TDBGrid;
DBNavigator1: TDBNavigator;
Edit1: TEdit;
Button1: TButton;
procedure Edit1KeyPress(Sender: TObject; var Key: Char);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form_vid: TForm_vid;
implementation
{$R *.dfm}
uses unit_menu, unit_dm;
procedure TForm_vid.Button1Click(Sender: TObject);
begin
Form_vid.Close;
end;
procedure TForm_vid.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
if Key=#13 then
if not DM.tab_vid.Locate('Наименование', Edit1.Text, [loCaseInsensitive, loPartialKey]) then
ShowMessage('Запись не найдена!')
else
DBGrid1.SetFocus;
end;
end.
Программный модуль « Unit_otchet1.pas»
Предназначен для работы с отчетом «Перечень заключенных договоров за
выбранный период времени с отображением стоимостью аренды и итоговой
суммой по всем отображенным договорам».
unit Unit_otchet1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComCtrls, OleServer, ComObj, DB, ADODB;
type
TForm_otchet1 = class(TForm)
Label1: TLabel;
Label2: TLabel;
dtp_dateN: TDateTimePicker;
108
dtp_dateK: TDateTimePicker;
Button1: TButton;
Button2: TButton;
procedure Button2Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form_otchet1: TForm_otchet1;
implementation
{$R *.dfm}
uses unit_menu, unit_dm;
// формирую отчет
procedure TForm_otchet1.Button1Click(Sender: TObject);
var
BeginRow: integer;
Base_path: string;
ExcelApp, Workbook, WorkSheet: Variant;
lnVsegoSuma : currency;
lnVsegoMetry: Double;
begin
// путь к файлу
Base_path := ExtractFilePath(ParamStr(0));
// данные по накладной в переменную
with DM do begin
// создание Excel
ExcelApp := CreateOleObject('Excel.Application');
// подключаем реакцию Excel на события, чтобы ускорить вывод информации
ExcelApp.Application.EnableEvents := false;
// создаем нигу (Workbook), заполн¤ем шаблон
Workbook := ExcelApp.WorkBooks.Add(Base_path+'ПереченьЗаключенныхДоговоров.xlsx');
// ссылка на лист
WorkSheet:= WorkBook.WorkSheets.Item['Лист1'];
// Определяю шапку
WorkSheet.Cells[1, 1]:='Перечень заключенных договоров за период с '+
DateToStr(dtp_dateN.Date)+' по '+DateToStr(dtp_dateK.Date);
// запрос на данные отчета табличная часть
with qry_any do begin
Active:=false;
Close;
SQL.Clear; // очищаем текст запроса при каждом проходе цикла
SQL.Text:='SELECT Договора.КодДоговора as НомерДоговора, Объекты.Наименование as Объект,
Арендаторы.Наименование as Арендатор, Договора.ДатаНачала, Договора.ДатОООкончания,
Договора.Метры, Договора.Стоимость '+
'FROM Арендаторы INNER JOIN (Объекты INNER JOIN Договора ON Объекты.КодОбъекта =
Договора.КодОбъекта) ON Арендаторы.КодАрендатора = Договора.КодАрендатора '+
'WHERE Договора.ДатаНачала>=:dateN and Договора.ДатаНачала<=:dateK '+
'ORDER BY Договора.ДатаНачала, Объекты.Наименование, Арендаторы.Наименование ';
109
// объявляю параметры запроса
Parameters.ParamByName('dateN').Value:=DateToStr(dtp_dateN.Date);
Parameters.ParamByName('dateK').Value := DateToStr(dtp_dateK.Date);
// выполнение запроса через обработчик ошибок
try {перехватчик ошибок}
Open ; {выполняем запрос и открываем набор данных}
if RecordCount<>0 then begin
First;
// координаты левого верхнего угла области, в которую будем выводить данные
BeginRow := 6; lnVsegoSuma:=0; lnVsegoMetry:=0;
while not eof do begin
// копирую форматированную строку из шаблона
ExcelApp.Range[ExcelApp.ActiveSheet.Cells[5, 1], ExcelApp.ActiveSheet.Cells[5, 7]].Select;
ExcelApp.Selection.copy;
ExcelApp.Range[ExcelApp.ActiveSheet.Cells[BeginRow, 1], ExcelApp.ActiveSheet.Cells[BeginRow, 1]].Select;
ExcelApp.ActiveSheet.Paste;
// запись данных
WorkSheet.Cells[BeginRow, 1]:=FieldByName('НомерДоговора').value;
WorkSheet.Cells[BeginRow, 2]:=FieldByName('Объект').value;
WorkSheet.Cells[BeginRow, 3]:=FieldByName('Арендатор').value;
WorkSheet.Cells[BeginRow, 4]:=FieldByName('ДатаНачала').value;
WorkSheet.Cells[BeginRow, 5]:=FieldByName('ДатОООкончания').value;
WorkSheet.Cells[BeginRow, 6]:=FieldByName('Метры').value;
WorkSheet.Cells[BeginRow, 7]:=FieldByName('Стоимость').value;
lnVsegoSuma:=lnVsegoSuma+FieldByName('Стоимость').value;
lnVsegoMetry:=lnVsegoMetry+FieldByName('Метры').value;
Inc(BeginRow);
Next; // на след запись
end; // while
// всего
ExcelApp.Range[ExcelApp.ActiveSheet.Cells[5, 1], ExcelApp.ActiveSheet.Cells[5, 7]].Select;
ExcelApp.Selection.copy;
ExcelApp.Range[ExcelApp.ActiveSheet.Cells[BeginRow, 1], ExcelApp.ActiveSheet.Cells[BeginRow, 1]].Select;
ExcelApp.ActiveSheet.Paste;
WorkSheet.Cells[BeginRow, 1]:='ВСЕГО:';
WorkSheet.Cells[BeginRow, 6]:=lnVsegoMetry;
WorkSheet.Cells[BeginRow, 7]:=lnVsegoSuma;
end; //if
except {секция обработки ошибок}
On e : EDatabaseError do {e - новый дескриптор ошибки}
messageDlg(e.message,mtError,[mbOK],0); {показываем свойство message объекта e}
end; {окончание обработки ошибки}
end;
// делаею Excel видимым
ExcelApp.Visible := true;
end;
end;
procedure TForm_otchet1.Button2Click(Sender: TObject);
begin
Form_otchet1.Close;
end;
end.
110
Программный модуль « Unit_otchet2.pas»
Предназначен для работы с отчетом «Список арендаторов не оплативших
аренду в выбранном периоде с отображением их телефонов для обзвона».
unit Unit_otchet2;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComCtrls, OleServer, ComObj, DB, ADODB;
type
TForm_otchet2 = class(TForm)
Label1: TLabel;
Label2: TLabel;
dtp_dateN: TDateTimePicker;
dtp_dateK: TDateTimePicker;
Button1: TButton;
Button2: TButton;
procedure Button2Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form_otchet2: TForm_otchet2;
implementation
{$R *.dfm}
uses unit_menu, unit_dm;
procedure TForm_otchet2.Button1Click(Sender: TObject);
var
BeginRow: integer;
Base_path: string;
ExcelApp, Workbook, WorkSheet: Variant;
begin
// путь к файлу
Base_path := ExtractFilePath(ParamStr(0));
// данные по накладной в переменную
with DM do begin
// создание Excel
ExcelApp := CreateOleObject('Excel.Application');
// подключаем реакцию Excel на события, чтобы ускорить вывод информации
ExcelApp.Application.EnableEvents := false;
// создаем нигу (Workbook), заполн¤ем шаблон
Workbook := ExcelApp.WorkBooks.Add(Base_path+'АрендаторыНеОплатившиеАренду.xlsx');
// ссылка на лист
WorkSheet:= WorkBook.WorkSheets.Item['Лист1'];
// Определяю шапку