Drag and Drop von TScrollBox ergibt falsche x,y Koordinaten

Rund um die LCL und andere Komponenten
Antworten
cle
Beiträge: 30
Registriert: Mi 31. Jan 2018, 11:54
OS, Lazarus, FPC: Winux (L trunc FPC 3.3.1)
CPU-Target: 64Bit

Drag and Drop von TScrollBox ergibt falsche x,y Koordinaten

Beitrag von cle »

Moin zusammen,

ich erstelle zur Laufzeit Panels in einer Scrollbox. Diese möchte ich per Drag und Drop einigen Einträgen in einem TreeView zuweisen.
Dazu ermittle ich im DragDrop Ereignis über TreeView1.GetNodeAt() den Treeview Eintrag.
Dies funktioniert für die ersten Panels in der ScrollBox einwandfrei. Sobald ich allerdings scrollen muss, um andere Panels auszuwählen, schlägt das Ganze fehl. Als Ursache habe ich herausgefunden, dass in dem Fall für X und Y sonderbare (z.T. negative) Werte übermittelt werden. Eigentlich sollten die X und Y Werte von onDragDrop doch den Punkt angeben, auf dem die Maustaste losgelassen wird. Mir ist nicht klar, warum der von der Position der ScrollBox abhängen soll. Steh ich hier auf dem Schlauch oder Lazarus?

Hier mal ein Demoprogramm (benötigt einen TreeView mit ein paar Einträgen und eine ScrollBox auf einem Panel)
Mit Gruß und bestem Dank im voraus
Alex

Code: Alles auswählen

unit Unit1;
 
{$mode objfpc}{$H+}
 
interface
 
uses
  Classes, SysUtils, Forms, Controls, Dialogs, Graphics, ExtCtrls,
  ComCtrls, StdCtrls;
 
type FThumb = class(TPanel);
 
type
 
  { TForm1 }
 
  TForm1 = class(TForm)
    Panel1: TPanel;
    ScrollBox1: TScrollBox;
    TreeView1: TTreeView;
    procedure FormCreate(Sender: TObject);
    procedure CreateTestPanels(ACount: Integer);
    procedure OnThumbMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X: Integer; Y: Integer);
    procedure ReArrange;
    procedure SetOrigin(var ALeft, ATop: Integer; const AWidth, AHeight, ADistance, AIndex: Integer);
    procedure AddThumb(const ACaption, APath: String; AValue: Pointer=NIL);
    procedure TreeView1DragDrop(Sender, Source: TObject; X, Y: Integer);
    procedure TreeView1DragOver(Sender, Source: TObject; X, Y: Integer;
      State: TDragState; var Accept: Boolean);
  private
    { private declarations }
    ThumbWidth, ThumbHeight, ThumbGap: Integer;
  public
    { public declarations }
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.lfm}
 
{ TForm1 }
 
procedure TForm1.FormCreate(Sender: TObject);
begin
  ThumbWidth  := 200;
  ThumbHeight := 200;
  ThumbGap    := 10;
  CreateTestPanels(20);
end;
 
procedure TForm1.CreateTestPanels(ACount: Integer);
var
  i: Integer;
begin
  for i := 0 to ACount do AddThumb('P '+inttostr(i), 'P'+inttostr(i));
  ReArrange;
end;
 
procedure TForm1.ReArrange;
var
  i: Integer;
  l, t: Integer;
begin
  l := 0;
  t := 0;
  for i := 0 to ScrollBox1.ComponentCount -1 do
  begin
    FThumb(ScrollBox1.Components[i]).Visible := false;
    SetOrigin(l, t, ThumbWidth, FThumb(ScrollBox1.Components[i]).Height, ThumbGap, i);
    FThumb(ScrollBox1.Components[i]).Left := l;
    FThumb(ScrollBox1.Components[i]).Top := t;
    FThumb(ScrollBox1.Components[i]).Visible := true;
  end;
end;
 
procedure TForm1.SetOrigin(var ALeft, ATop: Integer; const AWidth, AHeight, ADistance, AIndex: Integer);
var
  ImagesPerLine: Integer;
  CurrPos, CurrLine: Integer;
begin
  ImagesPerLine := Width DIV (AWidth + ADistance);
  if ImagesPerLine = 0 then ImagesPerLine := 1;
  CurrLine := AIndex DIV ImagesPerLine;
  ATop := ADistance + (ADistance + AHeight) * CurrLine;
  if ATop < 0 then ATop := 0;
  CurrPos := AIndex MOD ImagesPerLine;
  ALeft := ADistance + (ADistance + AWidth) * CurrPos;
  if ALeft < 0 then ALeft := 0;
end;
 
procedure TForm1.OnThumbMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X: Integer; Y: Integer);
begin
  (Sender as FThumb).BeginDrag(false);
end;
 
procedure TForm1.AddThumb(const ACaption, APath: String; AValue: Pointer=NIL);
var
  Thumb: FThumb;
begin
  Thumb := FThumb.Create(ScrollBox1);
  Thumb.Visible := false;
  Thumb.Align := alNone;
  Thumb.Width  := ThumbWidth;
  Thumb.Height := ThumbHeight;
  Thumb.Color  := clBlue;
  Thumb.Caption:= ACaption;
  Thumb.Parent := ScrollBox1;
  Thumb.OnMouseDown := @OnThumbMouseDown;
end;
 
procedure TForm1.TreeView1DragDrop(Sender, Source: TObject; X, Y: Integer);
var
  Node: TTreeNode;
begin
  Node := TreeView1.GetNodeAt(x,y);
  if Node <> NIl then Form1.Caption := Node.Text else Form1.Caption := inttostr(x) + '/' + inttostr(y);
end;
 
procedure TForm1.TreeView1DragOver(Sender, Source: TObject; X, Y: Integer;
  State: TDragState; var Accept: Boolean);
begin
  accept := true;
end;
 
 
end.
 

Michl
Beiträge: 2505
Registriert: Di 19. Jun 2012, 12:54

Re: Drag and Drop von TScrollBox ergibt falsche x,y Koordina

Beitrag von Michl »

Ich habe dein Problem jetzt nicht getestet, doch da war/ist eine Abweichung zu Delphi, welche in Lazarus Trunk gefixt ist und mit dem nächsten Major Release Einzug hält: http://wiki.freepascal.org/Lazarus_1.10.0_release_notes#LCL_Changes

Code: Alles auswählen

 TScrollingWinControl (TForm, TScrollBox, TFrame)
    ScreenToClient and ClientToScreen are now calculated without scrollbar offset. Done for Delphi compatibility.

Bzw.:https://bugs.freepascal.org/view.php?id=32392

Code: Alles auswählen

type
  TLiveSelection = (lsMoney, lsChilds, lsTime);
  TLive = Array[0..1] of TLiveSelection; 

cle
Beiträge: 30
Registriert: Mi 31. Jan 2018, 11:54
OS, Lazarus, FPC: Winux (L trunc FPC 3.3.1)
CPU-Target: 64Bit

Re: Drag and Drop von TScrollBox ergibt falsche x,y Koordina

Beitrag von cle »

Hallo Michl,

danke für deine Antwort.
Ich habe mir den Bugreport und die Beispielanwendung dort angeschaut und bin mir nicht so ganz sicher, ob es sich um das gleiche Problem handelt. Den dort beschriebenen Fehler habe ich nicht wirklich nachvollziehen können (oder verstanden).
Die Koordinaten von einem 'Drop' sollten doch immer korrekt sein und nicht wegen einer Delphi-Kompatibilität?

Gruß
Alex

Michl
Beiträge: 2505
Registriert: Di 19. Jun 2012, 12:54

Re: Drag and Drop von TScrollBox ergibt falsche x,y Koordina

Beitrag von Michl »

Man kann darüber diskutieren, welches Verhalten das bessere ist: Offset der X und Y Koordinaten werden bzw. wurden vom gescrollten oberen linken Punkt aus berechnet - vs. - es gibt kein Offset im gescrollten Zustand, X und Y Koordinaten entsprechen der sichtbaren X und Y Koordinate

Da Delphi letztere Variante nutzt und dadurch auch ein paar Probleme beseitigt wurden, wird sich das Verhalten in einem neuen Lazarus Release ändern.


Im Moment fehlt mir leider hinten und vorne Zeit, dein Projekt nachzubauen und zu testen. Ich denke aber, daß das Problem schon dem beschriebenen entspricht.
Du kannst versuchen dein Projekt mit Lazarus Trunk zu bauen und schauen, ob es dort funktioniert.
Wenn ich es testen soll, dann bräuchte ich das Projekt als Source (hier anhängen geht wohl nicht, aber ein Link zu einem File-Server sollte gehen).

PS, noch ein allgemeiner Hinweis: Eine Typedefinition sollte immer mit einem "T" anfangen. Idealerweise nimmt man ein "F" als Anfangsbuchstabe für private Bezeichner in einer Klasse. Mehr Infos z.B.: https://www.delphi-treff.de/object-pascal/styleguide/

Code: Alles auswählen

type
  TLiveSelection = (lsMoney, lsChilds, lsTime);
  TLive = Array[0..1] of TLiveSelection; 

cle
Beiträge: 30
Registriert: Mi 31. Jan 2018, 11:54
OS, Lazarus, FPC: Winux (L trunc FPC 3.3.1)
CPU-Target: 64Bit

Re: Drag and Drop von TScrollBox ergibt falsche x,y Koordina

Beitrag von cle »

Prima, ich habe es mit dem Trunk getestet und es funktioniert in der Tat.

Danke für deine Hilfe und Geduld.
Gruß
Alex

Antworten