Dragging an FMX list box item to a grid without superfluous highlighting

This a somewhat specific problem, but anyhow, I have an FMX application I’m writing in which I was wanting to be able to drag a list box item to a grid. Now, the FMX TListBox has an AutoDrag property to allow its items to be dragged, and FMX controls – like VCL ones – have OnDragOver and OnDragDrop events in which the former allows you to say whether the control will accept a dragged object and the latter allows the control to actually accept it. While a TListBox’s AutoDrag property is geared to allowing the user to reorder its items internally, setting it to True allows the user to drag an item outside the list box as well.

All in all then, the core functionality I required was implemented by the framework. However, by default, the behaviour wasn’t quite what I wanted:

• While making it no effort to have a list box item draggable outside its parent was great, I didn’t want the accompanying reordering visuals when the dragged item was still within the list box bounds.
• Most FMX controls visually indicate that they will accept an object being dragged over them regardless of any OnDragOver handler being set. So, if the form has a list box, a grid and a panel, and a list box item is being dragged, all three controls, together with the remaining list box items, will appear to accept the item as the item is dragged over it. (In the list box’s case, the entire list box is highlighted if you aren’t hovering over a specific item.)
• In the case of a grid, each column header will indicate acceptance individually as well. Worse, they also support dragging and dropping between themselves to reorder and dragging to somewhere outside the grid with no obvious way to turn either ability off! Speaking for myself, this means I find it pretty easy to reorder the columns of a FMX grid without intending to. Moreover, the fact you can drag a grid header outside the grid is just confusing:

In looking to fix these issues, the first thing I discovered was that the annoying visual acceptance effect is controlled by the EnableDragHighlight property, as introduced with public visibility (and a default setting of True!) in TControl, and subsequently published by most descendants. This property has zero connection to the OnDragOver event, which means that regardless of what you do in an OnDragOver handler, or indeed whether you have a handler for that event at all, by default, a control will visually indicate it accepts anything and everything being dragged over it. Nonetheless, if you have a number of controls that will never accept a dragged object, the easy fix is just to select them all at design time and toggle their EnableDragHighlight property to False. In my case that meant selecting everything on the form, deselecting the popup menus (which don’t have an EnableDragHighlight property), toggling the property in the Object Inspector, then individually putting the property back on a case-by-case basis.

This was also the fix for removing the reordering visuals from the list box, since TListBoxItem is one of the TControl descendants that publish EnableDragHighlight. In principle, you should still need to remove the actual reordering if an internal drag and drop happens accidentally. However, due to an oversight in the FMX source, the actual reordering doesn’t happen – the items are repositioned in the internal list of child objects, but their positions on screen are not switched similarly. Assuming that bug will one day be fixed though, the way to prevent any reordering is to handle the list box’s OnDragChange event and set the Allow parameter to False:

procedure TForm1.ListBox1DragChange(SourceItem,
  DestItem: TListBoxItem; var Allow: Boolean);
begin
  Allow := False;
end;

So, that left the grid headers… oh, and the listbox itself, since while setting EnableDragHighlight to False in the Object Inspector worked for individual list box items, it stubbornly wasn’t for their parent control:

Looking at the source, the reason stemmed from the AutoDrag property setter forceably setting EnableDragHighlight to True. Why? Who knows, but anyhow, where EnableDragHighlight is published by an ancestor class, TScrollBox, AllowDrag is published by TCustomListBox. Ergo, the persisted value of AllowDrag will be read back in after the persisted value of EnableDragHighlight, causing the former to override the latter. The fix is therefore to set the list box’s EnableDragHighlight property to False at runtime in (say) the form’s OnCreate handler:

procedure TForm1.FormCreate(Sender: TObject);
begin
  ListBox1.EnableDragHighlight := False;
end;

This just left getting rid of the grid column headers’ default draggability. Since a FMX grid’s header is defined by its style, the place to tweak the settings of it is in a handler for the grid’s OnApplyStyleLookup event. In terms of what needed to be done there, initially I thought of EnableDragHighlight again, but that wouldn’t solve the problem of the header items being themselves draggable. I then realised that the columns themselves were child controls of the grid just as much as the header, and they didn’t have independent draggability (so to speak). The reason for that, it became clear, was because their HitTest properties are set to False by the grid. So, the fix for the header was just to set both the header and its own child control’s HitTest properties to False likewise:

procedure TForm1.Grid1ApplyStyleLookup(Sender: TObject);
var
  StyleObj: TFmxObject;
  ChildObj: TControl;
begin
  StyleObj := (Sender as TCustomGrid).FindStyleResource('header');
  if StyleObj is THeader then
  begin
    THeader(StyleObj).HitTest := False;
    for ChildObj in THeader(StyleObj).Controls do
      ChildObj.HitTest := False;
  end;
end;

This of course means the user cannot click on a header item. If you want to have that, assign the header items’ OnClick handlers as desired, set their DragMode properties to TDragMode.dmManual, and their EnableDragHighlight properties to False:

procedure TForm1.Grid1ApplyStyleLookup(Sender: TObject);
var
  StyleObj: TFmxObject;
  ChildObj: TControl;
begin
  StyleObj := (Sender as TCustomGrid).FindStyleResource('header');
  if StyleObj is THeader then
  begin
    THeader(StyleObj).HitTest := False;
    for ChildObj in THeader(StyleObj).Controls do
    begin
      ChildObj.DragMode := TDragMode.dmManual;
      ChildObj.EnableDragHighlight := False;
      if ChildObj is THeaderItem then
        THeaderItem(ChildObj).OnClick := MyHeaderItemClick;
    end;
  end;
end;

(As an aside, you will frequently find the FMX source doing an Assigned check before using the ‘is’ operator – if the above code were written by an FMX author or maintainer, you would therefore expect to see ‘if Assigned(StyleObj) and (StyleObj is THeader) then’ rather than just ‘if StyleObj is THeader then’. This is completely unnecessary however, since the ‘is’ operator checks for nil itself.)