mORMot Open Source

kevinday

Member

Registered: 2015-10-28

Posts: 11

Suggest new Marked actions

Hi There,

I am not sure how the best way to contribute code.  I would like to add marked actions so that  TSQLAction in unit mORMot.pas would now look like:

  /// 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);

Then also in mORMotUI.pas - TSQLTableToGrid.SetMark() would look like:

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;

Thanks.  mORMot is a great framework!

Kevin Day

ab

Administrator

From: France

Registered: 2010-06-21

Posts: 14,266

Website

Re: Suggest new Marked actions

Should be included via http://synopse.info/fossil/info/5d3fba11b6

kevinday

Member

Registered: 2015-10-28

Posts: 11

Re: Suggest new Marked actions

Thank you Arnaud. 

Additional to this we also need to patch TSQLLister.SetToolBar() in mORMotToolBar

to change
if (A2<actmarkOlderThanOneDay) or (A2>actmarkOlderThanOneYear) or

to

if (A2<actmarkForToday) or (A2>actmarkOlderThanOneYear) or

Full Code:

function TSQLLister.SetToolBar(const aToolBarName: string; const aActions;
  ActionIsNotButton: pointer): TSynToolBar;
var TypeName: PShortString;
    A,iTB,iGB,iM,img: integer;
    GB: TSynToolButton;
    iAction: cardinal;
    M: TMenuItem;
    EN: boolean;
    A2: TSQLAction;
    ActionNames: TStringDynArray;
begin
  result := nil;
  if fPage=nil then
    exit;
  // on existing Toolbar: update its buttons from aActions, and exit
  for iTB := 0 to fPage.ToolBarCount-1 do
    // test exact match, not with SameText(), since Caption can be translated
    if fPage.ToolBars[iTB].Caption=aToolBarName then begin
      result := fPage.ToolBars[iTB];
      for iGB := 0 to result.ComponentCount-1 do begin
        GB := TSynToolButton(result.Components[iGB]);
        if isActionButton(GB)<>0 then begin
          img := GB.ImageIndex;
          EN := GetBit(aActions,img+1);
          GB.Enabled := EN;  // enable or disable buttons
          for iM := 0 to fMenu.Items.Count-1 do
          with fMenu.Items[iM] do
            if ImageIndex=img then
              Enabled := EN; // enable or disable popup menu item
        end;
      end;
      break;
    end;
  if result<>nil then
     exit; // we have found the toolbar
  // no Toolbar: create one with its buttons; also create associated popup menu
  EN := false;
  for A := 0 to fActionMax do
    if GetBit(aActions,A) then begin
      EN := true;
      break;
    end;
  if not EN then
    exit; // aActions=[] -> no toolbar to add
  if fMenu=nil then begin
    fMenu := TSynPopupMenu.Create(fGrid);
    fMenu.Images := ImageList16;
  end;
  result := fPage.CreateToolBar;
  try
{$ifdef USETMSPACK}
    result.BeginUpdate;
    result.AutoPositionControls := true;
    result.ShowOptionIndicator := false;
    result.AutoSize := true;
{$else}
    result.Images := ImageList32;
{$endif}
    result.Caption := aToolBarName;
    SetLength(ActionNames,fActionMax+1);
    TypeName := @fClient.Model.Actions^.NameList;
    for iAction := 0 to fActionMax do begin
      ActionNames[iAction] := fClass.CaptionNameFromRTTI(TypeName); // expanded caption
      inc(PByte(TypeName),ord(TypeName^[0])+1); // next enumerate value name
{$ifndef USETMSPACK}
    end;
    for iAction := fActionMax downto 0 do begin // TToolBar adds at 1st position
{$endif}
      if GetBit(aActions,iAction) then // is this enumerate value inside aActions?
        with result.CreateToolButton(ActionButtonClick,iAction,1,ActionNames[iAction],
           ActionHints,fShortCutUsed,60,ImageList32) do begin
          if GetBit(ActionIsNotButton,iAction) then
            Style := bsCheck;
          // create associated sub menu entry
          if Style<>bsCheck then begin
            NewMenuItem(fMenu,Caption,iAction-1);
            if TSQLAction(iAction)=actMark then
              // actMarkAllEntries..actMarkBeforeOneYear are regrouped in
              // an only one aAction=actMark
              with PTypeInfo(TypeInfo(TSQLAction))^.EnumBaseType^ do
              for A2 := actMarkAllEntries to actmarkInverse do
//                if (A2<actmarkOlderThanOneDay) or (A2>actmarkOlderThanOneYear) or
                if (A2<actmarkForToday) or (A2>actmarkOlderThanOneYear) or
                 (TableToGrid.FieldIndexTimeLogForMark>=0) then begin
                  if A2=actmarkInverse then
                    CreateSubMenuItem('-',iAction,nil);
                  CreateSubMenuItem(fClass.CaptionNameFromRTTI(GetEnumName(A2)),
                    iAction,nil,iAction-1,integer(A2));
                end;
          end;
        end;
    end;
    M := TMenuItem.Create(fMenu);
    M.Caption := '-';
    fMenu.Items.Add(M);
  finally
{$ifdef USETMSPACK}
    result.EndUpdate;
{$endif}
  end;
end;

kevinday

Member

Registered: 2015-10-28

Posts: 11

Re: Suggest new Marked actions

Hi Arnaud,

One more thing should Mark in the TSQLAction declarations be lower case to be consistent with the rest (I had missed that when I previously suggested the change)?  I notice that "actmark" is taken off when creating the  menu items but not "actMark" via use of TrimLeftLowerCase() in TSQLRecord.CaptionName().

Cheers,
Kevin Day.

ab

Administrator

From: France

Registered: 2010-06-21

Posts: 14,266

Website

Re: Suggest new Marked actions

Please try http://synopse.info/fossil/info/ebc7d05200