mORMot Open Source

  TMarkActionEvent = procedure (Sender : TObject; const aRecordClass : TSqLRecordClass; aSQLAction : TSQLAction) or object;

private
    FOnMarkAction: TMarkActionEvent;
public
    property OnMarkAction: TMarkActionEvent read FOnMarkAction write FOnMarkAction;

begin
  if fReportDetailedIndex<0 then
    exit; // avoid recursive call after GB.Down := false below
  aAction := isActionButton(Sender);
  case A of
    actNoAction: exit;
    actUnMarkAll:
      // (un)marking are standard actions
      TableToGrid.SetMark(A);
    actMark:
      if Sender.InheritsFrom(TSynToolButton) then
        Btn.DoDropDown else
      if Sender.InheritsFrom(TMenuItem) then begin
        // actMarkAllEntries..actMarkBeforeOneYear are regrouped in
        // the only one aAction=actMark button
        TableToGrid.SetMark(TSQLAction(TMenuItem(Sender).Tag));
        if Assigned(FOnMarkAction) then
          FOnMarkAction(Sender, fClass, TSQLAction(TMenuItem(Sender).Tag));
      end
    else begin

etc.

procedure TSQLRibbon.ChangeColorScheme(const ColorScheme: TToolBarStyle;
  PanelStyler: TAdvPanelStyler; StatusBarStyler: TAdvOfficeStatusBarOfficeStyler;
  CustomStyle: TMemoryStream);
var
  PreviewStyle: TPreviewMenuStyle;
  StatusStyle: TOfficeStatusBarStyle;
  TBStyler: TAdvToolBarOfficeStyler;
  i, curr: integer;
  C: TComponent;
begin
  if not fToolBar.ToolBarStyler.InheritsFrom(TAdvToolBarOfficeStyler) then
    exit;
  TBStyler := TAdvToolBarOfficeStyler(ToolBar.ToolBarStyler);
  if TBStyler = nil then
    exit;
  TBStyler.Style := ColorScheme;
  case ColorScheme of // bulky TMS styles don't match :(
    bsCustom: begin
        if CustomStyle <> nil then begin
          CustomStyle.Seek(0, soFromBeginning);
          CustomStyle.ReadComponent(TBStyler);
        end;
        PreviewStyle := AdvPreviewMenuStylers.psOffice2003Olive;
        StatusStyle := AdvOfficeStatusBarStylers.psOffice2003Olive;
      end;
    bsOffice2007Silver: begin
        PreviewStyle := AdvPreviewMenuStylers.psOffice2007Silver;
        StatusStyle := AdvOfficeStatusBarStylers.psOffice2007Silver;
      end;
    bsOfficeXP: begin
        PreviewStyle := AdvPreviewMenuStylers.psOfficeXP;
        StatusStyle := AdvOfficeStatusBarStylers.psWindowsXP;
      end;
    bsWindowsVista .. high(TToolBarStyle): begin
        PreviewStyle := TPreviewMenuStyle(ColorScheme);
        StatusStyle := TOfficeStatusBarStyle(pred(ColorScheme));
      end;
  else begin
      PreviewStyle := TPreviewMenuStyle(ColorScheme);
      StatusStyle := TOfficeStatusBarStyle(ColorScheme);
    end;
  end;
  if (PreviewMenu <> nil) and PreviewMenu.Styler.InheritsFrom(TAdvPreviewMenuOfficeStyler) then
    TAdvPreviewMenuOfficeStyler(PreviewMenu.Styler).Style := PreviewStyle;
  if StatusBarStyler <> nil then
    StatusBarStyler.Style := StatusStyle;
  if PanelStyler <> nil then
    PanelStyler.Style := TToolBarStyleToPanel[ColorScheme];
  TBStyler.CaptionAppearance.Assign(TBStyler.GroupAppearance.CaptionAppearance);
  with TBStyler.GroupAppearance.TabAppearance do begin
    TBStyler.PagerCaption.TextColor := TextColor;
    TBStyler.PagerCaption.TextColorExtended := TextColorSelected;
  end;
//** Change here
  if (Body <> nil) and Body.AdvOfficePagerStyler.InheritsFrom(TAdvOfficePagerOfficeStyler) then
    TAdvOfficePagerOfficeStyler(Body.AdvOfficePagerStyler).Style := TOfficePagerStyle(StatusStyle);
    // update colors for windows
  for i := 0 to Application.ComponentCount - 1 do begin
    C := Application.Components[i];
    if C.InheritsFrom(TCustomForm) then
      SetStyle(C, TBStyler); // will set style for all embedded components
  end;
    // update report colors on every ribbon page
  curr := fToolBar.ActivePageIndex;
  for i := 0 to high(Page) do
    with Page[i] do begin
      if Report <> nil then
        Report.Color := TBStyler.QATAppearance.ColorTo;
      if i = curr then
        List.Invalidate; // repaint list first row with new colors
    end;
  if Form <> nil then
    Form.Invalidate; // whole form redraw
end;

  /// standard actions for User Interface generation
  TSQLAction = (
    /// action not defined
    actNoAction,
    /// Mark rows (standard action)
    // - display sub-menu with actmarkAllEntries..actmarkBeforeOneYear items
    actMark,
    /// UnMark all rows (standard action)
    actUnmarkAll,
    /// Mark all rows
    actmarkAllEntries,
    /// Mark rows for today
    actMarkForToday,
    /// Mark rows for This Week
    actMarkForThisWeek,
    /// Mark rows for this month
    actMarkForThisMonth,
    /// Mark rows for today
    actMarkForYestday,
    /// Mark rows for Last Week
    actMarkForLastWeek,
    /// Mark rows for Last month
    actMarkForLastMonth,
    /// Mark rows After one day
    actmarkOlderThanOneDay,
    /// Mark rows older than one week
    actmarkOlderThanOneWeek,
    /// Mark rows older than one month
    actmarkOlderThanOneMonth,
    /// Mark rows older than one half year
    actmarkOlderThanSixMonths,
    /// Mark rows older than one year
    actmarkOlderThanOneYear,
    /// Inverse Mark values (ON->OFF, OFF->ON)
    actmarkInverse);

procedure TSQLTableToGrid.SetMark(aAction: TSQLAction);
var
  i: integer;
  V, Time: Int64;
  Time2: Int64;
const
  DIFFTIME: array [actMarkOlderThanOneDay .. actMarkOlderThanOneYear] of double = (1, 7, 31, 183,
    365); // 183 = more or less half a year
begin
  if NotDefined then
    Exit;
  with TDrawGrid(Owner) do
    case aAction of
      actmarkAllEntries:
        for i := 1 to RowCount do
          Marked[i] := true;
      actUnmarkAll:
        if fMarked <> nil then
          Finalize(fMarked);
      actmarkInverse:
        for i := 1 to RowCount do
          Marked[i] := not Marked[i];
      actMarkForToday, actMarkForThisWeek, actMarkForThisMonth, actMarkForYestday,
        actMarkForLastWeek, actMarkForLastMonth: begin
          case aAction of
            actMarkForToday: begin
                PTimeLogBits(@Time)^.From(Date, true);
                PTimeLogBits(@Time2)^.From(Date + 1, true);
              end;
            actMarkForThisWeek: begin
                PTimeLogBits(@Time)^.From(StartOfTheWeek(Date), true);
                PTimeLogBits(@Time2)^.From(EndOfTheWeek(Date) + 1, true);
              end;
            actMarkForThisMonth: begin
                PTimeLogBits(@Time)^.From(StartOfTheMonth(Date), true);
                PTimeLogBits(@Time2)^.From(EndOfTheMonth(Date) + 1, true);
              end;
            actMarkForYestday: begin
                PTimeLogBits(@Time)^.From(Date - 1, true);
                PTimeLogBits(@Time2)^.From(Date, true);
              end;
            actMarkForLastWeek: begin
                PTimeLogBits(@Time)^.From(IncWeek(StartOfTheWeek(Date), -1), true);
                PTimeLogBits(@Time2)^.From(StartOfTheWeek(Date), true);
              end;
            actMarkForLastMonth: begin
                PTimeLogBits(@Time)^.From(IncMonth(StartOfTheMonth(Date), -1), true);
                PTimeLogBits(@Time2)^.From(StartOfTheMonth(Date), true);
              end;
          end;
          if FieldIndexTimeLogForMark >= 0 then begin
            for i := 1 to RowCount do begin
              SetInt64(Table.Get(i, fFieldIndexTimeLogForMark), V);
              if (V >= Time) and (V <= Time2) then
                Marked[i] := true;
            end;
          end;
        end;
      actMarkOlderThanOneDay .. actMarkOlderThanOneYear:
        if FieldIndexTimeLogForMark >= 0 then begin
          // use TDateTime calculation because TTimeLog is not duration compatible
          PTimeLogBits(@Time)^.From(Now - DIFFTIME[aAction], true);
          for i := 1 to RowCount do begin
            SetInt64(Table.Get(i, fFieldIndexTimeLogForMark), V);
            if (V > 0) and (V <= Time) then
              Marked[i] := true;
          end;
        end;
    else
      Exit;
    end;
  TDrawGrid(Owner).Invalidate; // refresh screen
end;