Drag & Drop Problem unter Delphi

[WEBSTER]

Salute,

ich habe eine Listbox, in der die Reihenfolge der Items per Drag&Drop verändert werden kann. Die Listbox kann 10 Items im sichtbaren Bereich aufnehmen. Die Restlichen müssen sich "erscrollt" werden. Das klappt auch alles.

Hier das Problem:
Wenn ich nun das Item[1] an die letzte Position der Listbox setzen möchte (z.B. die 40. Position), dann wird im Augenblick "nach oben oder unten gescrollt" und bei einem Drop die Position der ListBox ermittelt. Da aber bei der 40. Position die Listbox gescrollt wurde stimmen xy Werte der Listbox mehr und der Drop erfolgt an einer FALSCHEN Stelle....

<PRE>
procedure Ttouren_sortieren_Form.SORT_PieListDragDrop(Sender ,
Source: TObject; X, Y: Integer);
var
iTemp: integer;
ptTemp: TPoint;
szTemp: string;
begin
try
ptTemp.x := x;
ptTemp.y := y;
iTemp := 0;
while iTemp <= TPieList(Source).Items.Count - 1 do
begin
if TPieList(Source).selected[iTemp] then
begin
with Sender as TPieList do
begin
szTemp := TPieList(Source).items[iTemp];
TPieList(Source).items.Delete(iTemp);
items.Insert(itemAtPos(ptTemp, true), szTemp);
end;
end;
inc(iTemp);
end;

//////////////////////////////////////////////////////////////////////////
// Sortierung wird abgespeichert

Update_Position(main_form.Str_Tour_Name);
except
touren_sortieren_Form.OnShow(self);
MessageDlg('Ungültige Position angegeben !', mtError, [mbOk], 0);
end;
end;

---------------------------------------------------------------------
DAS AUTOMATISCHE SCROLLEN LIEGT AUF EINEM TIMER

procedure Ttouren_sortieren_Form.Timer1Timer(Sender: TObject);
var
pt: TPoint;
begin
GetCursorPos(pt);
pt := ScreenToClient(pt);
with SORT_PieList.Boundsrect, pt do
if (x > left) and (x < right) then begin
if y< top then
SORT_PieList.perform(WM_VSCROLL, SB_LINEUP, 0)
else if y > bottom then
SORT_PieList.perform(WM_VSCROLL, SB_LINEDOWN, 0)
else
timer1.enabled := false;
end
else
timer1.enabled := false;
end;

procedure Ttouren_sortieren_Form.FormDragOver(Sender, Source: TObject; X,
Y: Integer; State: TDragState; var Accept: Boolean);
begin
accept := false;
if State = dsDragLeave then
timer1.enabled := false
else
if (Source is TPieList) then
begin
with TPieList(Source).boundsrect do
timer1.enabled := (x > left) and (x < right) and
((y< top) or (y > bottom))
end;

end;

procedure Ttouren_sortieren_Form.FormCreate(Sender: TObject);
begin
Timer1.enabled := false;
Timer1.Interval := 100;
end;

</PRE>

Vielleicht könnt IHR mir weiterhelfen....?

THX
WEBSTER

[Jens Schumann]

Hallo Webster,<br>folgendem Code kann ich innerhalb einer Listbox die Sortierung über Drag&Drop verändern:
<pre>
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls;

type
TForm1 = class(TForm)
ListBox1: TListBox;
Timer1: TTimer;
procedure ListBox1DragOver(Sender, Source: TObject; X, Y: Integer;
State: TDragState; var Accept: Boolean);
procedure Timer1Timer(Sender: TObject);
procedure ListBox1DragDrop(Sender, Source: TObject; X, Y: Integer);
private
{ Private-Deklarationen }
procedure ScrollListBox(L : TListBox);
public
{ Public-Deklarationen }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.ListBox1DragOver(Sender, Source: TObject; X, Y: Integer;
State: TDragState; var Accept: Boolean);
begin
Accept:=Sender = Listbox1;
If State = dsDragLeave then
Timer1.Enabled := False
else
Timer1.Enabled:=True;
end;

procedure TForm1.ScrollListBox(L: TListBox);
var
MP : TPoint;
begin
MP:=L.ScreenToClient(Mouse.CursorPos); // Mouse gibt's glaube ich ab D5
If MP.Y>L.Height-10 then
L.Perform(WM_VSCROLL, SB_LINEDOWN, 0);
If MP.Y<10 then
L.Perform(WM_VSCROLL, SB_LINEUP, 0);
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
ScrollListBox(Listbox1);
end;

procedure TForm1.ListBox1DragDrop(Sender, Source: TObject; X, Y: Integer);
var
NewItemIndex : Integer;
begin
Timer1.Enabled:=False;
With (Sender as TListbox) do
begin
NewItemIndex:=ItemAtPos(Point(X,Y),True);
Items.Exchange(ItemIndex,NewItemIndex);
end;
end;

end.
</pre&gt