FMX - XE6+XE7: Droptarget - Eigenschaft Filter funktioniert nicht

[Harry Stahl]

Ich bin gerade dabei, mein FMX-Buch für Delphi XE7 zu aktualisieren (XE6 hatte ich ja ausgelassen). Dabei gehe ich natürlich auch alle Texte, Demos und Work-Arounds durch. Einige Workarounds kann ich da entfernen, sehr schön.

Allerdings steckt an der einen oder anderen Stelle irgendwie immer noch der Fehlerteufel drin: Das Drag & Drop-Demo in den mitgelieferten Demos funktionierte noch nie so richtig (u.a. war Hittest der übergeordneten Komponente deaktiviert).

[Demo findet man hier: C:\Users\Public\Documents\Embarcadero\Studio\15.0\ Samples\Object Pascal\FireMonkey Desktop\ControlsDemo]

Zwar funktioniert das Demo jetzt soweit beim Drag und Drop, wurde für XE7 sogar etwas erweitert (man kann nicht nur vom Explorer eine Datei auf das Target ziehen, sondern auch einige Controls vom Formular).

Die Eigenschaft "Filter" des DragTargets für Dateien funktioniert nun aber leider nicht mehr.

Die Entwickler haben da in der Unit ExtCrls anscheinend spät in der Nacht dran gearbeitet und der Kaffee war schon aus oder wirkte nicht mehr:

Delphi-Quellcode:

procedure TDropTarget.DragOver(const Data: TDragObject; const Point: TPointF;
  var Operation: TDragOperation);
var
  Masks, M: string;
  HasFiles: Boolean;
  HasFilter: Boolean;
  HasMatchedFile: Boolean;
  I: Integer;
begin
  inherited;

  // determine if the user is dragging one or more files and
  // if there is any filter set
  HasFiles := Length(Data.Files) > 0;
  Masks := CurrentFilter;
  HasFilter := Masks <> '';

  // the Accept value is overriden by the filter only if there is at least one file
  // in the Data drag object; when a filter exists, there must be at least
  // one file that matches the filter in order for Accept to have set by the user;
  // if there is no file matching the filter, Accept is false
  if HasFiles and HasFilter then
  begin
    HasMatchedFile := False;
    M := GetToken(Masks, ';');
    while (M <> '') and (not HasMatchedFile) do
    begin
      for I := 0 to High(Data.Files) do
      begin
        HasMatchedFile := MatchesMask(Data.Files[I], M);

        // there is at least one file matching the filter
        if HasMatchedFile then
          Break;
      end;
      M := GetToken(Masks, ';');
    end;

    //HS: This is wrong!
    //if HasMatchedFile then
    //  Operation := TDragOperation.Move;

    // HS: The following is the right way: Wenn no File matches the
    // Filter, droped Action can not be allowed
    if HasMatchedFile  = false then
      Operation := TDragOperation.None;
  end;
end;

Wenn keine zum Filter passende Datei dabei ist, muss das Ergebnis natürlich auf NONE gesetzt werden, also das Drag & Drop abgewiesen werden. Und wenn ein Eintrag passte, dann wurde immer ein MOVE draus gemacht, egal was der Anwender zuvor (quasi unter inherited aufgerufen) gesetzt hatte.

Insgesamt hat die Sache also zwei grobe Fehler.

Lustigerweise steht in der Kommentierung oben noch was von "Accept", was bis Delphi XE5 noch richtig war, aber danach nicht mehr relevant war.

Die Korrektur habe ich da oben schon vermerkt und EMBA über QC mitgeteilt, ich hoffe, es fließt noch in XE8 ein (nebenbei, die Hilfe-Dokumentation - mitgeliefert und Online - ist auch noch veraltet, habe ich gleich mitgemeldet.

WorkAround bis dahin: Änderung in der Datei vornehmen und ExtrCtrls in das eigene Projektverzeichnis speichern.

Aber hey: Nach der neuen Politik von EMBA müsste dieser Fix ja auch noch in XE7 (und XE6) kommen. Na hoffen wir mal.