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.