Продолжая тему упрощения процесса создания программ, хочется поделиться с вами еще одним блоком кода, позволяющим выбирать требуемый временной период. Для этого создадим новую модальную форму frmPeriod (желательно типа TfrmModal (КГ №32)).

Добавим два элемента TDateTimePicker для выбора даты и TactionList, в котором создадим события, см. пример кода:

uses
  dmuImages, BS_LIB, DateUtil, StrUtils;
// Функция формирования диалогового окна выбора
// периода данных. True – если сделан выбор
// aPeriodFrom –начало и aPeriodTo –конец периода
function ChangePeriod(var aPeriodFrom, aPeriodTo:TDateTime):boolean;
var
  oldShortDateFormat, oldLongDateFormat : String;
  oldDateSeparator:Char;
begin
  oldShortDateFormat:=ShortDateFormat;
  oldLongDateFormat:=LongDateFormat;
  oldDateSeparator:=DateSeparator;
  ShortDateFormat:='DD/MM/YYYY';
  LongDateFormat:='DD/MM/YYYY';
  DateSeparator:='/';
  try
    if Not Assigned(frmPeriod) then
      frmPeriod:=TfrmPeriod.Create(Application);
    frmPeriod.dePeriodFrom.DateTime:=aPeriodFrom;
    frmPeriod.dePeriodTo.DateTime:=aPeriodTo;
    if frmPeriod.ShowModal=mrOk  then
      begin
        aPeriodFrom:=CutTime(frmPeriod.dePeriodFrom.DateTime);
        aPeriodTo:=CutTime(frmPeriod.dePeriodTo.DateTime);
        Result:=True;
      end
    else
      Result:=False;
  finally
    ShortDateFormat:=oldShortDateFormat;
    LongDateFormat:=oldLongDateFormat;
    DateSeparator:=oldDateSeparator;
    FreeAndNil(frmPeriod);
  end;
end;

//Обработка нажатия кнопки oK
procedure TfrmPeriod.bbtnApplyClick(Sender: TObject);
var  errorStatus:boolean;
begin
  errorStatus:=False;
  if frmPeriod.dePeriodFrom.DateTime > frmPeriod.dePeriodTo.DateTime then
    begin
        errorStatus:=True;
        frmPeriod.dePeriodFrom.DateTime:=frmPeriod.dePeriodTo.DateTime;
    end;

  if Not(errorStatus) then
    ModalResult:=mrOk
  else  
    begin
      Application.ProcessMessages;
      frmPeriod.SetFocus;
    end;
end;

//Нажатие кнопки «текущий день»
procedure TfrmPeriod.actTodayFilterExecute(Sender: TObject);
begin
  frmPeriod.dePeriodFrom.DateTime:=CutTime(Now);
  frmPeriod.dePeriodTo.DateTime:=CutTime(Now);
end;

//Нажатие кнопки «текущий месяц»
procedure TfrmPeriod.actMonthFilterExecute(Sender: TObject);
begin
  frmPeriod.dePeriodFrom.DateTime:=BS_FirstDayCurMonth;
  frmPeriod.dePeriodTo.DateTime:=BS_LastDayCurMonth;
end;

//Нажатие кнопки «сброс периода отбора»
procedure TfrmPeriod.actFullPeriodFilterExecute(Sender: TObject);
begin
  frmPeriod.dePeriodFrom.DateTime:=0;
  frmPeriod.dePeriodTo.DateTime:=BS_LastDayCurMonth;
end;

//Нажатие кнопки «предыдущий месяц»
procedure TfrmPeriod.actPrevMonthExecute(Sender: TObject);
begin
  frmPeriod.dePeriodFrom.DateTime:=BS_FirstDay(IncMonth(frmPeriod.dePeriodTo.DateTime,-1));
  frmPeriod.dePeriodTo.DateTime:=BS_LastDay(frmPeriod.dePeriodFrom.DateTime);
end;

//Нажатие кнопки «следующий месяц»
procedure TfrmPeriod.actNextMonthExecute(Sender: TObject);
begin
  frmPeriod.dePeriodFrom.DateTime:=BS_FirstDay(IncMonth(frmPeriod.dePeriodTo.DateTime,1));
  frmPeriod.dePeriodTo.DateTime:=BS_LastDay(frmPeriod.dePeriodFrom.DateTime);
end;

Окончательным штрихом будет панель кнопок TtoolBar с привязанным к ней набором картинок компоненты TImageList. Добавим в эту панель пять кнопок для быстрого выбора заданных интервалов и кнопку подтверждения btnOk. Пример возможного дизайна диалога выбора показан на рисунке. Пример вызова данной функции достаточно тривиален:

procedure TfrmPayDoc.actPayDocSetPeriodExecute(Sender: TObject);
begin
  if ChangePeriod(gPeriodFrom,gPeriodTo) then
    begin
      cdsPayDoc.Close;
      cdsPayDoc.Params[0].Value:=gPeriodFrom;
      cdsPayDoc.Params[1].Value:=gPeriodTo;
      cdsPayDoc.Open;
      Self.Caption:=’Платежные документы ’
      + BS_GetBetweenDateCaptionStr(gPeriodFrom,gPeriodTo);
    end;
end;

Скачать модуль bs_lib