Posts from November 2012

File Management in MonkeyStyler

A quick video of file management features in MonkeyStyler

Fixing Drag and Drop in a FireMonkey Tree View

I’ve been preparing to add some drag and drop support to MonkeyStyler, chiefly revolving around a couple of tree views. So, I set out to investigate drag/drop for a TTreeView. I figured the automatic drag/drop support wouldn’t be enough for me but I started with it to see how things worked, and what I’d need to adapt.

What I found wasn’t a pretty picture. The issues I found where:
* It takes two clicks to start a drag operation: one to select an item, another to pick it up ans start dragging QC 110783.
* You can’t drop onto another tree view if it the destination’s Selected = nil QC 110646.
* The built in code selects the wrong item when hovering or dropping unless the tree view’s Position is at (0,0) on the form QC 110721.
all of which make the built in support unusable.

And finally comes the enhancements I need to use for MonkeyStyler:
* The built in behaviour is to move a TTreeViewItem from one location to another but I also need to be able to manage the data structures behind the tree view.
* I want the ability to copy an item (and related back end data).
* I want to be able to move items other than TTreeViewItems (at present that means dragging an class from a palette and creating an instance of that class on dropping).

So I set about fixing the broken stuff and adding support for what I neeed.

The code attached to this post is a child component of TTreeView which reworks the default drag/drop behaviour to fix the issues above. Much of it is simply a cut/paste of the existing code with bug fixes added plus some rather nasty hacks to remove default behaviour and access a private field which is needed.

Behaviour of the new code is:
* Added an EnableDrag property which replaces the AllowDrag property. Set EnableDrag to True to switch on the dragging behaviour. Do not set both EnableDrag and AllowDrag to true. Indeed, don’t use AllowDrag at all, that will simply return you to the old two-clicks to drag behaviour.
* Added an OnDropItem event. If this is assigned then the event handler is solely responsible for handling any reparenting or other processing necessary when an item is dropped. The minimal code necessary to move an item would be (ignoring sanity checks):

TFMXObject(Item).Parent := TFMXObject(NewParent); 

You can, of course, process the new item in any way you see fit.

The code at present is XE3 only. As and when I add XE2 support I’ll update the code and this post. The download includes a sample project with three tree views you can drag between. Uncomment the line to add an OnDropItem event handler to test that functionality.

Update 27/11/12 to fix OnChange event not firing.

Full source:

unit Solent.TreeView;

interface
uses FMX.TreeViewSystem.UITypesSystem.ClassesFMX.TypesSYstem.Types;

type TDropItemEvent procedure(SenderNewParentItemTObjectof object;

type TSolentTreeView = class(TTreeView)
  private
    
FEnableDragBoolean;
    
FOnDropItemTDropItemEvent;
    function 
GetDragItemTTreeViewItem;
    
procedure SetDragItem(const ValueTTreeViewItem);
  protected
    
MouseDownPointTPointF;
    
DragStartItemTTreeViewItem;
    
procedure MouseDown(ButtonTMouseButtonShiftTShiftStateXYSingle);override;
    
procedure MouseMove(ShiftTShiftStateXYSingle);override;
    
procedure DoMouseLeave;override;
    
procedure DragOver(const DataTDragObject; const PointTPointF;var AcceptBoolean);override;
    
procedure DragDrop(const DataTDragObject; const PointTPointF);override;
    
procedure StartDrag;virtual;
    
//Hack: Use RTTI to get acces to the private FDragItem field
    
property DragItemTTreeViewItem read GetDragItem write SetDragItem;
  public
  
published
    
//Use EnableDrag instead of AllowDrag. Setting both to true will not be good.
    
property EnableDragBoolean read FEnableDrag write FEnableDrag;
    
//If OnDropItem is assigned, then no automatic reparenting will happen.
    //It is entirely up to the handler to add/reparent/delete as necessary.
    //(Note that a default drag/drop would simply by: TFMXObject(Item).Parent := TFMXObject(NewParent);
    
property OnDropItemTDropItemEvent read FOnDropItem write FOnDropItem;
  
end;

procedure Register;

implementation
uses FMX
.PlatformSystem.RTTIFMX.FormsFMX.Layouts;

const 
DragDelta 5;  //No of pixels to move the mouse before starting a drag operation

procedure Register;
begin
  RegisterComponents
('Solent'[TSolentTreeView]);
end;

{ TSolentTreeView }

type
  THackControl 
= class(TControl);

  
TDragOver procedure(const DataTDragObject;const PointTPointF; var AcceptBooleanof object;
  
TDragDrop procedure(const DataTDragObject;const PointTPointFof object;

procedure TSolentTreeView.StartDrag;
var 
DataTDragObject;
  
BitmapTBitmap;
  
PTFMXObject;
  
DragDropIInterface;
begin
  
if EnableDrag and Assigned(DragStartItemthen
  begin
    DragDrop 
:= TPlatformServices.Current.GetPlatformService(IFMXDragDropService);
    if 
Assigned(DragDropthen
    begin
      Data
.Source := DragStartItem;
      
Data.Data := TValue.From<TObject>(Self);
      
:= Parent;
      while 
Assigned(P) and not (P is TCommonCustomForm) do
        
:= P.Parent;
      if 
Assigned(Pthen
      
try
        
Bitmap := DragStartItem.MakeScreenShot;
        
IFMXDragDropService(DragDrop).BeginDragDrop(TCommonCustomForm(P), DataBitmap);
      finally
        
Bitmap.Free;
      
end;
    
end;
    
DragStartItem := nil;
  
end;
end;

procedure TSolentTreeView.DoMouseLeave;
begin
  inherited
;
  
StartDrag;
end;

procedure TSolentTreeView.DragDrop(const DataTDragObject;
  const 
PointTPointF);
  var
  
ItemTTreeViewItem;
  
AllowBoolean;
  
PTPointF;
  
ProcTDragDrop;
begin
  
//Inherited method from TCustomTreeView is broken.
  //Parent of TCustomTreeView is TScrollBox.
  //Hack our way over the inherited method to get to the one in TScrollBox
  //Credit to Serg http://stackoverflow.com/users/246408/serg
  
TMethod(Proc).Code := @TScrollBox.DragDrop;
  
TMethod(Proc).Data := Self;
  
Proc(DataPoint);

  if 
Assigned(DragItemthen
  begin
    THackControl
(DragItem).DragLeave;
    
DragItem.RemoveFreeNotify(Self);
    
DragItem := nil;
  
end;
  
Item := ItemByPoint(Point.XPoint.Y);
  if 
Not Assigned(Itemthen
  begin
    
// to root
    
Allow := True;
    if 
Assigned(OnDragChangethen
      OnDragChange
(TTreeViewItem(Data.Source), nilAllow);
    if 
Allow then
    begin
      
if Assigned(OnDropItemthen
        OnDropItem
(SelfSelfData.Source)
      else
        
TTreeViewItem(Data.Source).Parent := Self;
      
Realign;
    
end;
  
end
  
else
  
begin
    Allow 
:= True;
    if 
Assigned(OnDragChangethen
      OnDragChange
(TTreeViewItem(Data.Source), ItemAllow);
    if 
Allow then
    begin
      
if not TTreeViewItem(Data.Source).isChild(Itemthen
      begin
        
if not Item.IsExpanded then
          Item
.IsExpanded := True;
        if 
Assigned(OnDropItemthen
          OnDropItem
(SelfItemData.Source)
        else
          
TTreeViewItem(Data.Source).Parent := Item;
        
Realign;
      
end;
    
end;
  
end;
end;

procedure TSolentTreeView.DragOver(const DataTDragObject;
  const 
PointTPointF; var AcceptBoolean);
var 
ItemTTreeViewItem;
  
ProcTDragOver;
begin
  
//Inherited method from TCustomTreeView is broken.
  //Parent of TCustomTreeView is TScrollBox.
  //Hack our way over the inherited method to get to the one in TScrollBox
  //Credit to Serg http://stackoverflow.com/users/246408/serg
  
TMethod(Proc).Code := @TScrollBox.DragOver;
  
TMethod(Proc).Data := Self;
  
Proc(DataPointAccept);

  
Item := ItemByPoint(Point.XPoint.Y);
  if (
Item <> DragItemthen
  begin
    
if Assigned(DragItemthen
    begin
      THackControl
(DragItem).DragLeave;
      
DragItem.RemoveFreeNotify(Self);
    
end;
    
DragItem := Item;
    if 
Assigned(DragItemthen
    begin
      DragItem
.AddFreeNotify(Self);
      
THackControl(DragItem).DragEnter(DataPoint);
      
Accept := True;
    
end
    
else
      
Accept := False;
  
end
  
else
    
Accept := True;

  if (
DragItem <> nil) and (DragItem Selectedthen
    Accept 
:= False;
end;

function 
TSolentTreeView.GetDragItemTTreeViewItem;
var 
CTRTTIContext;
  
TTRTTIType;
  
FTRTTIField;
  
VTValue;
begin
  Result 
:= nil;
  
:= TRTTIContext.Create;
  
:= C.GetType(ClassInfo);
  if 
<> nil then
  begin
    F 
:= T.GetField('FDragItem');
    if 
<> nil then
    begin
      V 
:= F.GetValue(Self);
      
Result := V.AsType<TTreeViewItem>;
    
end;
  
end;
  
C.Free;
end;

procedure TSolentTreeView.MouseDown(ButtonTMouseButtonShiftTShiftStateX,
  
YSingle);
var 
ItemTTreeViewItem;
begin
  inherited
;
  if 
EnableDrag then
  begin
    DragStartItem 
:= ItemByPoint(XY);
    
MouseDownPoint.:= X;
    
MouseDownPoint.:= Y;
  
end
  
else
    
DragStartItem := nil;
end;

procedure TSolentTreeView.MouseMove(ShiftTShiftStateXYSingle);
begin
  inherited
;
  if (
abs(X-MouseDownPoint.X) > DragDelta) or (abs(Y-MouseDownPoint.Y) > DragDeltathen
    StartDrag
;
end;

procedure TSolentTreeView.SetDragItem(const ValueTTreeViewItem);
var 
CTRTTIContext;
  
TTRTTIType;
  
FTRTTIField;
  
VTValue;
begin
  C 
:= TRTTIContext.Create;
  
:= C.GetType(ClassInfo);
  if 
<> nil then
  begin
    F 
:= T.GetField('FDragItem');
    if 
<> nil then
      F
.SetValue(SelfTValue.From<TTreeViewItem>(Value));
  
end;
  
C.Free;
end;

initialization
  RegisterFMXClasses
([TSolentTreeView]);
end

 

Resizing a FireMonkey Combo Box to Fit it’s Contents

MonkeyStyler displays two combo boxes on it’s toolbar, one to list the currently opened files and a second to list the elements in the current file. A number of users mentioned that long items in the combo box would be cropped and sometimes difficult to identify.

Creating a routine to resize a combo box made an interesting little challenge. We need to find the length of the longest item, but this needs to take account of the current font settings, and there’s no convenient ‘TextWidth’ function in FireMonkey. But we cab do it using a TText object.

I started by creating a TText object with AutoSize set to True and WordWrap set to False.

:= TText.Create(nil);
    
T.AutoSize := True;
    
T.WordWrap := False


Next we need to get the font used. In FireMonkey a TComboBox owns a TListBox which is used for the dropdown and the combo box copies the contents of the selected item into itself. So we really need the font of a TListBoxItem. I chose to use the font assigned to an actual list box item of the component:

if Items.Count 0 then
    begin
      Item 
:= ListBox.ListItems[0];
      
Item.ApplyStyleLookup;
      
:= Item.FindStyleResource('text');
      if 
O is TText then
        T
.Font.Assign(TText(O).Font);
            ... 


Note the call to ApplyStyleLookup which we need in case the item doesn’t currently have it’s styling applied. This could be because it is newly created or the styling has been removed - in FM2 the stying of non-visible controls is removed to save resources.

Next up is to iterate over the strings in Items and get the width of the widest,

for S in Items do
      
begin
        T
.Text := S;
        
//Bug in XE3: Assigning Text doesn't resize a TText, so hack around it.
        
T.AutoSize := False;
        
T.AutoSize := True;
        if 
<> nil then
          NewWidth 
:= T.Width+TControl(O).Padding.Left+TControl(O).Padding.Right;
        if 
NewWidth MinWidth then
          MinWidth 
:= NewWidth;
      
end


In the initial release of XE3 there is a bug in TText such that it doesn’t resize when you set the Text property, so we do a little dance with AutoSize to force an update. Also note we’re taking account of the Padding of the ‘text’ resource.

And finally we need to assign the new width, but since there is other stuff in the style besides the text we don’t know exactly what that is (especially if the style later changes). So, we calculate the width of the extra stuff with the current settings (Width-TControl(O).Width) and add out new width for the text,

:= FindStyleResource('content');
    if 
O is TControl then
      Width 
:= Width-TControl(O).Width+MinWidth

Putting it together, here is the complete code:

type TSolentComboBox = class(TComboBox)
  public
    
procedure ResizeToContents(MinWidthSingle);
  
end;
    
...

procedure TSolentComboBox.ResizeToContents(MinWidthSingle);
var
  
TTText;
  
NewWidthSingle;
  
OTFMXObject;
  
SString;
  
ItemTListBoxItem;
begin
  
try
    
:= TText.Create(nil);
    
T.AutoSize := True;
    
T.WordWrap := False;
    
:= nil;
    if 
Items.Count 0 then
    begin
      Item 
:= ListBox.ListItems[0];
      
Item.ApplyStyleLookup;
      
:= Item.FindStyleResource('text');
      if 
O is TText then
        T
.Font.Assign(TText(O).Font);
      
NewWidth := 0;
      for 
S in Items do
      
begin
        T
.Text := S;
        
//Bug in XE3: Assigning Text doesn't resize a TText, so hack around it.
        
T.AutoSize := False;
        
T.AutoSize := True;
        if 
<> nil then
          NewWidth 
:= T.Width+TControl(O).Padding.Left+TControl(O).Padding.Right;
        if 
NewWidth MinWidth then
          MinWidth 
:= NewWidth;
      
end;
    
end;

    
:= FindStyleResource('content');
    if 
O is TControl then
      Width 
:= Width-TControl(O).Width+MinWidth;

  finally
    
T.Free;
  
end;
end

MonkeyStyler Build 10

MonkeyStyler Builds 9 and 10 have been released.

Build 9 brings a big update to the Control Viewer to add a selection rectangle for the currently selected component. Components can be selected by clicking (select topmost), double clicking (select next component down (XE3 edition only)) or right clicking to show a full list of components under the mouse cursor. The selected component can also be dragged and resized (depending on Align property settings).

The Control Viewer should also handle sizing of elements which aren’t constrained within the bounds of the root component. This can be an issue with styles supplied with TMS components.

Build 10 is a quick update to some AVs which may have been experienced with unnamed (new) files. It also adds auto-resizing of the combo boxes on the toolbar (blog post coming soon).

Download

Full changelists

5/11/12 - 10
Fixed: Errors when using untitled or read only files.
Added: Combo boxes on toolbar resize to their contents.

3/11/12 - 9
Fixed: Unregistered version not showing icon on taskbar.
Fixed: Control Viewer now sizes appropriately when sub-components are outside the bounds of the element.
Fixed: File open dialog remember a previous folder incorrectly.
Added: Control Viewer size reflects margins, padding and controls outside the root components client area.
Added: Show selection rectangles for current component.
Added: Drag selection to move/resize components.
Added: Click on Control Viewer to select item under mouse/Double click to select parent component.
Added: Control Viewer has right-click menu which shows all components under the pointer to select from.