111
WorkSheet.Cells[1, 1]:='Список арендаторов не оплативших аренду за период с '+
DateToStr(dtp_dateN.Date)+' по '+DateToStr(dtp_dateK.Date);
// прохожу по договорам и проверяю его оплату в данном выбранном периоде
tab_qry_dogovor.Active:=True;
with tab_qry_dogovor do begin
Open;
if RecordCount<>0 then begin
First;
BeginRow := 6;
while not eof do begin // цикл по tab_qry_dogovor (запрос ЗапросДанныеДоговора в базе)
// выполняю запрос (запрос ЗапросДоговорОООплаты в базе) и фильтрую по номеру договора и периоду
// если записей ноль, то вывод арендатора
with qry_any do begin
Active:=false;
Close;
SQL.Clear; // очищаем текст запроса при каждом проходе цикла
SQL.Text:='SELECT Договора.КодДоговора as НомерДоговора, Арендаторы.Наименование as
Арендатор, Арендаторы.Телефон, Объекты.Наименование as Объект, ОплатаАренды.ДатОООплаты,
ОплатаАренды.Сумма '+
'FROM (Объекты INNER JOIN (Арендаторы INNER JOIN Договора ON Арендаторы.КодАрендатора
= Договора.КодАрендатора) ON Объекты.КодОбъекта = Договора.КодОбъекта) '+
'INNER JOIN ОплатаАренды ON Договора.КодДоговора = ОплатаАренды.КодДоговора '+
'WHERE ОплатаАренды.ДатОООплаты>=:dateN and ОплатаАренды.ДатОООплаты<=:dateK and
Договора.КодДоговора=:KodDogov '+
'ORDER BY Договора.КодДоговора, ОплатаАренды.ДатОООплаты ';
// объявляю параметры запроса
Parameters.ParamByName('dateN').Value:=DateToStr(dtp_dateN.Date);
Parameters.ParamByName('dateK').Value := DateToStr(dtp_dateK.Date);
Parameters.ParamByName('KodDogov').Value :=
IntToStr(tab_qry_dogovor['НомерДоговора']);//lnKodDogovora;
// выполнение запроса через обработчик ошибок
try {перехватчик ошибок}
Open ; {выполняем запрос и открываем набор данных}
if RecordCount=0 then begin
// копирую форматированную строку из шаблона
ExcelApp.Range[ExcelApp.ActiveSheet.Cells[5, 1], ExcelApp.ActiveSheet.Cells[5, 4]].Select;
ExcelApp.Selection.copy;
ExcelApp.Range[ExcelApp.ActiveSheet.Cells[BeginRow, 1], ExcelApp.ActiveSheet.Cells[BeginRow,
1]].Select;
ExcelApp.ActiveSheet.Paste;
// запись данных
WorkSheet.Cells[BeginRow, 1]:=tab_qry_dogovor['НомерДоговора'];
WorkSheet.Cells[BeginRow, 2]:=tab_qry_dogovor['Объект'];
WorkSheet.Cells[BeginRow, 3]:=tab_qry_dogovor['Арендатор'];
WorkSheet.Cells[BeginRow, 4]:=tab_qry_dogovor['Телефон'];
Inc(BeginRow);
end;
except {секция обработки ошибок}
On e : EDatabaseError do {e - новый дескриптор ошибки}
messageDlg(e.message,mtError,[mbOK],0); {показываем свойство message объекта e}
end; {окончание обработки ошибки}
end; // with
Next;
end; // while
end; // if
112
end; // with
// делаею Excel видимым
ExcelApp.Visible := true;
end; // with
end;
procedure TForm_otchet2.Button2Click(Sender: TObject);
begin
Form_otchet2.Close;
end;
end.
Программный модуль « Unit_otchet3.pas»
Предназначен для работы с отчетом «Список арендаторов, срок договора
которого истекает меньше чем за месяц выбранной даты».
unit Unit_otchet3;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ComCtrls, StdCtrls, ExtCtrls, DBCtrls, Grids, DBGrids, DB, ADODB,
DateUtils, OleServer, ComObj;
type
TForm_otchet3 = class(TForm)
Button1: TButton;
Label1: TLabel;
dtp_dateN: TDateTimePicker;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form_otchet3: TForm_otchet3;
implementation
{$R *.dfm}
uses unit_menu, unit_dm;
procedure TForm_otchet3.Button1Click(Sender: TObject);
begin
Form_otchet3.Close;
end;
procedure TForm_otchet3.Button2Click(Sender: TObject);
var
BeginRow: integer;
113
Base_path: string;
ExcelApp, Workbook, WorkSheet: Variant;
begin
// путь к файлу
Base_path := ExtractFilePath(ParamStr(0));
// данные по накладной в переменную
// создание 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);
// прохожу по договорам и проверяю его оплату в данном выбранном периоде
with DM.tab_qry_dogovor do begin
Active:=True;
//days:=DaysBetween(dtp_dateN, FieldByName('ДатОООкончания').Value);
//Filter:=IntToStr(DaysBetween(FieldByName('ДатОООкончания').Value,dtp_dateN.Date))+'<=30';
First;
BeginRow := 6;
while not eof do begin // цикл по tab_qry_dogovor (запрос ЗапросДанныеДоговора в базе)
If DaysBetween(FieldByName('ДатОООкончания').Value,dtp_dateN.Date) <= 30 then begin
// копирую форматированную строку из шаблона
ExcelApp.Range[ExcelApp.ActiveSheet.Cells[5, 1], ExcelApp.ActiveSheet.Cells[5, 5]].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;
Inc(BeginRow);
end;
Next;
end; // while
end; // with
// делаею Excel видимым
ExcelApp.Visible := true;
end;
end.
Программный модуль « Unit_otchet4.pas»
Предназначен для работы с отчетом «Перечень не сданных в аренду площадей
с группировкой по группам с отображением площадей (реализовать в виде
таблицы и гистограммы) за выбранный период».
114
unit Unit_otchet4;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, DBGrids, DB, ADODB, DateUtils, OleServer, ComObj;
type
TForm_otchet4 = class(TForm)
Button1: TButton;
Button2: TButton;
Label1: TLabel;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form_otchet4: TForm_otchet4;
implementation
{$R *.dfm}
uses unit_menu, unit_dm;
procedure TForm_otchet4.Button1Click(Sender: TObject);
begin
Form_otchet4.Close;
end;
procedure TForm_otchet4.Button2Click(Sender: TObject);
var
BeginRow, BeginRow_2, lnVsegoMetry, lnVsegoVid, ChartCount: integer;
Base_path, lcVidObject: string;
ExcelApp, Workbook, WorkSheet, WorkSheet_2, myChart: 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'];
WorkSheet_2:= WorkBook.WorkSheets.Item['Лист2']; // лист для данных диаграммы
// Определяю шапку
WorkSheet.Cells[1, 1]:='Перечень не сданных в аренду площадей с группировкой по группам с отображением
площадей';
115
// запрос на данные отчета табличная часть
with qry_any do begin
Active:=false;
Close;
SQL.Clear; // очищаем текст запроса при каждом проходе цикла
SQL.Text:='SELECT Объекты.КодОбъекта, Объекты.Наименование AS Объект, ЗапросАдреса.Адрес,
Объекты.Площадь, Объекты.Цена, Статусы.Наименование AS Статус, ВидыОбъекта.Наименование as
ВидОбъекта '+
'FROM ВидыОбъекта INNER JOIN (Статусы INNER JOIN (ЗапросАдреса INNER JOIN Объекты ON
ЗапросАдреса.КодАдреса = Объекты.КодАдреса) ON Статусы.КодСтатуса = Объекты.КодСтатуса) ON
ВидыОбъекта.КодОбъекта = Объекты.КодВидОООбъекта '+
'WHERE (((Объекты.КодСтатуса)=2 Or (Объекты.КодСтатуса)=3)) '+
'ORDER BY Объекты.КодВидОООбъекта, Объекты.Наименование ';
// выполнение запроса через обработчик ошибок
try {перехватчик ошибок}
Open ; {выполняем запрос и открываем набор данных}
if RecordCount<>0 then begin
First;
// координаты левого верхнего угла области, в которую будем выводить данные
BeginRow := 6; lnVsegoMetry:=0; lnVsegoVid:=0;
lcVidObject:=qry_any['ВидОбъекта'];
WorkSheet.Cells[BeginRow, 1]:=lcVidObject;
Inc(BeginRow);
while not eof do begin
if FieldByName('ВидОбъекта').value<>lcVidObject then begin
WorkSheet.Cells[BeginRow, 1]:='ВСЕГО ПО ВИДУ ОБЪЕКТА '+ lcVidObject;
WorkSheet.Cells[BeginRow, 4]:=lnVsegoVid;
lnVsegoVid:=0;
BeginRow:=BeginRow+2;
lcVidObject:=qry_any['ВидОбъекта'];
WorkSheet.Cells[BeginRow, 1]:=lcVidObject;
Inc(BeginRow);
end;
// копирую форматированную строку из шаблона
ExcelApp.Range[ExcelApp.ActiveSheet.Cells[5, 1], ExcelApp.ActiveSheet.Cells[5, 6]].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;
lnVsegoMetry:=lnVsegoMetry+FieldByName('Площадь').value;
lnVsegoVid:=lnVsegoVid+FieldByName('Площадь').value;
Inc(BeginRow);
Next; // на след запись
end; // while
// по последней группе
WorkSheet.Cells[BeginRow, 1]:='ВСЕГО ПО ВИДУ ОБЪЕКТА '+ lcVidObject;
WorkSheet.Cells[BeginRow, 4]:=lnVsegoVid;
Inc(BeginRow);
// всего
116
ExcelApp.Range[ExcelApp.ActiveSheet.Cells[5, 1], ExcelApp.ActiveSheet.Cells[5, 6]].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, 4]:=lnVsegoMetry;
end;
except {секция обработки ошибок}
On e : EDatabaseError do {e - новый дескриптор ошибки}
messageDlg(e.message,mtError,[mbOK],0); {показываем свойство message объекта e}
end; {окончание обработки ошибки}
//--------------------------------------------------
// новый запрос по сгруппированным данным
Active:=false;
Close;
SQL.Clear; // очищаем текст запроса при каждом проходе цикла
SQL.Text:='SELECT ЗапросСвободныеОбъекты.ВидОбъекта, Sum(ЗапросСвободныеОбъекты.Площадь) AS
Площадь '+
'FROM ЗапросСвободныеОбъекты '+
'GROUP BY ЗапросСвободныеОбъекты.ВидОбъекта '+
'ORDER BY ЗапросСвободныеОбъекты.ВидОбъекта ';
// выполнение запроса через обработчик ошибок
try {перехватчик ошибок}
Open ; {выполняем запрос и открываем набор данных}
if RecordCount<>0 then begin
First;
// первый проход для второго листа - данные для диаграммы
BeginRow_2:=2;
First;
while not eof do begin
// запись данных на второй лист для диаграммы
WorkSheet_2.Cells[BeginRow_2, 1]:=FieldByName('ВидОбъекта').value;
WorkSheet_2.Cells[BeginRow_2, 2]:=FieldByName('Площадь').value;
Inc(BeginRow_2);
Next;
end;
// обновляю диаграмму
ChartCount:=ExcelApp.ActiveWorkBook.ActiveSheet.ChartObjects.Count; // определяю кол -во диаграмм на
листе
myChart:=ExcelApp.ActiveWorkBook.ActiveSheet.ChartObjects(ChartCount).Chart; // нахожу мою
myChart.ChartWizard(ExcelApp.WorkBooks[1].Worksheets[2].Range[ExcelApp.WorkSheets.Item['Лист2'].Cells[1,
1], ExcelApp.WorkSheets.Item['Лист2'].Cells[BeginRow_2-1, 2]]); // обновляю данные
end; //if
except {секция обработки ошибок}
On e : EDatabaseError do {e - новый дескриптор ошибки}
messageDlg(e.message,mtError,[mbOK],0); {показываем свойство message объекта e}
end; {окончание обработки ошибки}
// делаею Excel видимым
ExcelApp.Visible := true;
end;
end;
end;
end.
117
Программный модуль « Activ_arenda.dpr»
Предназначен для инициализации проекта.
program activ_arenda;
{%File 'ModelSupport\Unit_menu\Unit_menu.txvpck'}
{%File 'ModelSupport\Unit_dm\Unit_dm.txvpck'}
{%File 'ModelSupport\default.txvpck'}
{%File 'ModelSupport\Unit2\Unit2.txvpck'}
{%File 'ModelSupport\Unit_shablon\Unit_shablon.txvpck'}
uses
Forms,
Unit_menu in 'Unit_menu.pas' {Form1},
Unit_dm in 'Unit_dm.pas' {DM: TDataModule},
Unit_gorod_st_ad in 'Unit_gorod_st_ad.pas' {Form_gorod_st_ad},
Unit_vid in 'Unit_vid.pas' {Form_vid},
Unit_comm in 'Unit_comm.pas' {Form_comm},
Unit_status in 'Unit_status.pas' {Form_status},
Unit_dolgn in 'Unit_dolgn.pas' {Form_dolgn},
Unit_sotrud in 'Unit_sotrud.pas' {Form_sotrud},
Unit_arendat in 'Unit_arendat.pas' {Form_arendat},
Unit_object in 'Unit_object.pas' {Form_object},
Unit_PassWord in 'Unit_PassWord.pas' {PasswordDlg},
Unit_customer in 'Unit_customer.pas' {Form_customer},
Unit_otchet1 in 'Unit_otchet1.pas' {Form_otchet1},
Unit_otchet2 in 'Unit_otchet2.pas' {Form_otchet2},
Unit_otchet3 in 'Unit_otchet3.pas' {Form_otchet3},
Unit_otchet4 in 'Unit_otchet4.pas' {Form_otchet4};
{$R *.res}
begin
Application.Initialize;
Application.CreateForm(TPasswordDlg, PasswordDlg);
Application.CreateForm(TForm1, Form1);
Application.CreateForm(TDM, DM);
Application.CreateForm(TForm_gorod_st_ad, Form_gorod_st_ad);
Application.CreateForm(TForm_vid, Form_vid);
Application.CreateForm(TForm_comm, Form_comm);
Application.CreateForm(TForm_status, Form_status);
Application.CreateForm(TForm_dolgn, Form_dolgn);
Application.CreateForm(TForm_sotrud, Form_sotrud);
Application.CreateForm(TForm_arendat, Form_arendat);
Application.CreateForm(TForm_object, Form_object);
Application.CreateForm(TForm_customer, Form_customer);
Application.CreateForm(TForm_otchet1, Form_otchet1);
Application.CreateForm(TForm_otchet2, Form_otchet2);
Application.CreateForm(TForm_otchet3, Form_otchet3);
Application.CreateForm(TForm_otchet4, Form_otchet4);
Application.Run;
end.