VirtualStringTree Drag & Drop

[Towmuz]

Hallo zusammen,

für einen VST benötige ich Drag & Drop Funktionalität, soweit so gut, funktioniert alles.
Nun benötige ich aber vst_irgendwas.MultiLine[Node] := True funktioniert natürlich auch,
was nicht mehr funktioniert sobald es MultilineNodes sind, ist die Anzeige der dünnen Linien für ein Einfügen zwischen zwei Nodes.
Auf einem Node drauf ist kein Problem, nur eben die Möglichkeit drüber oder drunter geht nicht mehr.

Genauer gesagt: Ich bekomme nur noch den TDropMode: dmOnNode
und nicht mehr: dmAbove oder dmBelow

Hülfe...

P.S.: Fals es da Abhilfe gibt, gibt es da auch etwas um diese, eben sehr dünnen, Hilfslinien für drüber und drunter etwas größer / höher zu machen?

[Aviator]

Welche Version des VST verwendest du denn?

Ich habe jetzt nur mal in den Source der Version 6.4 reingeschaut. Dort habe ich nichts gesehen, was eine Zeichnung der DropMark aufhebt wenn MultiLine auf True steht. Lediglich wenn die Anwendung den Parameter CustomDraw im OnBeforeItemPaint Event auf True setzt wird das Zeichnen der Nodes übersprungen. Dann aber komplett.

Hast du eine kleine Beispielanwendung in der du das nachstellen kannst? Ich kann mir gerade keinen MultiLine Tree auf die Schnelle machen.

Das Zeichnen der DropMark wird in der Procedure DoPaintDropMark() ausgeführt. Die Procedure wird in der ganzen PaintRoutine nur einmal aufgerufen. Du könntest dir in dem Fall eine Ableitung des VST machen und die DoPaintDropMark() Procedure überschreiben. Virtual ist die Procedure auch. Sollte also daher kein Problem sein wenn du die eigentliche VST Version mal updatest.

Delphi-Quellcode:

procedure TBaseVirtualTree.DoPaintDropMark(Canvas: TCanvas; Node: PVirtualNode; R: TRect);

// draws the drop mark into the given rectangle
// Note: Changed properties of the given canvas should be reset to their previous values.

var
  SaveBrushColor: TColor;
  SavePenStyle: TPenStyle;

begin
  if FLastDropMode in [dmAbove, dmBelow] then
    with Canvas do
    begin
      SavePenStyle := Pen.Style;
      Pen.Style := psClear;
      SaveBrushColor := Brush.Color;
      Brush.Color := FColors.DropMarkColor;

      if FLastDropMode = dmAbove then
      begin
        Polygon([Point(R.Left + 2, R.Top),
                 Point(R.Right - 2, R.Top),
                 Point(R.Right - 2, R.Top + 6),
                 Point(R.Right - 6, R.Top + 2),
                 Point(R.Left + 6 , R.Top + 2),
                 Point(R.Left + 2, R.Top + 6)
        ]);
      end
      else
        Polygon([Point(R.Left + 2, R.Bottom - 1),
                 Point(R.Right - 2, R.Bottom - 1),
                 Point(R.Right - 2, R.Bottom - 8),
                 Point(R.Right - 7, R.Bottom - 3),
                 Point(R.Left + 7 , R.Bottom - 3),
                 Point(R.Left + 2, R.Bottom - 8)
        ]);
      Brush.Color := SaveBrushColor;
      Pen.Style := SavePenStyle;
    end;
end;

[Towmuz]

Danke Aviator, das hilft schonmal weiter (TBaseVirtualTree.DoPaintDropMark )

VST Version ist auch die 6.4(.1)

Beispielanwendung mach ich, wenn ichs in PaintDropMark nicht beheben kann.

[Aviator]

Habe das heute mal versucht nachzustellen. Allerdings funktioniert der VST bei mir so wie erwartet. Ob MultiLine aktiv ist oder nicht spielt keine Rolle. Bei mir erscheinen trotzdem die Einfügemarken.

Jetzt wäre die Frage, ob du bei dir evtl. noch andere Dinge in den TreeOptions oder sonst wo eingestellt hast, die das irgendwie verhindern?!

Zeichnest du z.B. irgendetwas selbst was die Linie übermalen könnte in irgendeinem der PaintEvents?

[Towmuz]

Anbei Testprojekt.

Dazu noch:
Wenn ich Multiline auskommentiere, funktioniert es trotzdem nicht.
Wenn ich dazu den Zeilenumbruch - #13#10 auskommentiere geht alles wie gewünscht.
Multiline ohne Zeilenumbruch haut trotzdem nicht hin.

Einstellungen habe ich nur die Nötigsten angepasst.

Delphi-Quellcode:

procedure TForm1.VirtualStringTree1GetText(Sender: TBaseVirtualTree;
  Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
  var CellText: string);
var
  p: PPosition;
begin
  p := VirtualStringTree1.GetNodeData(Node);

  if p <> nil then
    case Column of
      0: CellText := p.Test;
      1:
      begin
        VirtualStringTree1.MultiLine[Node] := True;
        CellText := p.Test2 + #13#10 + 'Zweite Zeile';
      end;
      2: CellText := p.Test3;
    end;
end;

Multiline scheint ok

[Aviator]

Hi,

habe mir mal gerade deine fertige Exe angeschaut bevor ich irgendwas selbst kompiliert habe. Bei mir funktioniert das problemlos. Wichtig für das Zeichnen der DropMarks ist allerdings, dass du aus dem Header bzw. Column Bereich rauskommst. Sobald du die Maus noch innerhalb einer Column bewegst wird nichts angezeigt. Siehe angehängtes Bild.

[Towmuz]

Hoi und danke für´s Nachschauen,

dass das soweit funktioniert mit den Columns, bzw. dann dahinter ist mir klar, aber das ist ja nicht Sinn der Sache.
Es funktioniert ja auch wie gewünscht, wenn ich genannte Sachen weglasse.

---------------
function TBaseVirtualTree.DetermineDropMode(const P: TPoint; var HitInfo: THitInfo; var NodeRect: TRect): TDropMode; An der Stelle stimmt die Hitinfo scheinbar nicht mehr, er kommt niemals in den oberen / unteren Randbereich, also überzeichnet #13#10 und Multiline irgendwas.
Allerdings bin ich grad zu blöd, die Stelle zu finden wo das stattfindet

[Aviator]

Hallo Towmuz,

habe mich jetzt mal etwas länger durch den VST Source geklickt und gedebuggt. Hat erst noch etwas gedauert, bis ich dein Problem richtig nachvollziehen konnte.

Schlussendlich habe ich aber deinen Übeltäter gefunden und kann nur sagen, dass ist as designed. Warum? Kein Ahnung. Eventuell kannst du ja was daraus bauen.

Die von dir gedachte HitInfo macht dir das Problem eher nicht. Der Fehler tritt schon früher auf.

Folgende Methode macht dir einen Strich durch die Rechnung:

Delphi-Quellcode:

function TCustomVirtualStringTree.DoGetNodeWidth(Node: PVirtualNode; Column: TColumnIndex; Canvas: TCanvas = nil): Integer;

// Returns the text width of the given node in pixels.
// This width is stored in the node's data member to increase access speed.

var
  Data: PInteger;

begin
  if (Column > NoColumn) and (vsMultiline in Node.States) then    ///////   HIER IST DEIN PROBLEM
    Result := FHeader.Columns[Column].Width                       ///////   DIE ZURÜCKGEGEBENE TEXTBREITE ENTSPRICHT IMMER DER BREITE DER AKTUELLEN COLUMN
  else
  begin
    if Canvas = nil then
      Canvas := Self.Canvas;

    if Column = FHeader.MainColumn then
    begin
      // Primary column or no columns.
      Data := InternalData(Node);
      if Assigned(Data) then
      begin
        Result := Data^;
        if Result = 0 then
        begin
          Data^ := CalculateTextWidth(Canvas, Node, Column, Text[Node, Column]);
          Result := Data^;
        end;
      end
      else
        Result := 0;
    end
    else
      // any other column
      Result := CalculateTextWidth(Canvas, Node, Column, Text[Node, Column]);
  end;
end;

Die Folge daraus ist, dass in der Procedure TBaseVirtualTree.DetermineHitPositionLTR(var HitInfo: THitInfo; Offset, Right: Integer; Alignment: TAlignment); das Flag hiOnItemLabel gesetzt wird:

Delphi-Quellcode:

TextWidth := DoGetNodeWidth(HitInfo.HitNode, HitInfo.HitColumn);

// Check if the text can be aligned at all. This is only possible if there is enough room
// in the remaining text rectangle.
if TextWidth > Right - ImageOffset then
  Include(HitInfo.HitPositions, hiOnItemLabel)
else
begin
  ...
end;

Und in der function TBaseVirtualTree.DetermineDropMode(const P: TPoint; var HitInfo: THitInfo; var NodeRect: TRect): TDropMode; wird dann der entsprechende DropMode gesetzt. Bitte die Kommentare hinter den Code Zeilen beachten!

Delphi-Quellcode:

function TBaseVirtualTree.DetermineDropMode(const P: TPoint; var HitInfo: THitInfo; var NodeRect: TRect): TDropMode;
// Determine the DropMode.

var
  ImageHit: Boolean;
  LabelHit: Boolean;
  ItemHit: Boolean;

begin
  ImageHit := HitInfo.HitPositions * [hiOnNormalIcon, hiOnStateIcon] <> [];
  LabelHit := hiOnItemLabel in HitInfo.HitPositions;                               ///////  Hier wird dann LabelHit auf true gesetzt
  ItemHit := ((hiOnItem in HitInfo.HitPositions) and
             ((toFullRowDrag in FOptions.FMiscOptions) or (toFullRowSelect in FOptions.FSelectionOptions)));

  // In report mode only direct hits of the node captions/images in the main column are accepted as hits.
  if (toReportMode in FOptions.FMiscOptions) and not (ItemHit or ((LabelHit or ImageHit) and
    (HitInfo.HitColumn = FHeader.MainColumn))) then
    HitInfo.HitNode := nil;

  if Assigned(HitInfo.HitNode) then
  begin
    if LabelHit or ImageHit or not (toShowDropmark in FOptions.FPaintOptions) then    ///  Hier springt er dann immer auf DropMode dmOnNode
      Result := dmOnNode
    else
      if ((NodeRect.Top + NodeRect.Bottom) div 2) > P.Y then
        Result := dmAbove
      else
        Result := dmBelow;
  end
  else
    Result := dmNowhere;
end;

Ich hoffe ich konnte dir mit dieser Info weiterhelfen.

[Towmuz]

Hey Aviator,

vielen Dank für deine Mühe das ist jetzt extremst ausführlicher, als ich erwartet hatte.

Das der die hiOnItemLabel immer auf True setzt, hat ich schon gesehen, nur wo, da fehlts mir noch an Debugroutine.

Dann wirds jetzt abgeleitet und diese Multiline-Überprüfung in der IF fliegt raus.
Ich schreib dann gleich das nächste Thema alá "VirtualstringTree meckert mit AV, weil er nicht mehr die richtige Spaltenbreite für Zellen errechnet"

[Aviator]

Kein Problem. Bin ja froh wenn ich helfen kann. Der VirtualTreeView ist eben ein Spezialgebiet von mir mit dem ich mich schon seit Jahren beschäftige.

MultiLine hatte ich allerdings noch nie benötigt. Deshalb wusste ich da auch nicht auf Anhieb einen Rat.

Ist aber gut zu wissen, da ich MultiLine für mein aktuelles Projekt evtl. einsetzen wollte.

Ein schönes Wochenende wünsche ich.