TDragImage während DragOver verändern

[Hobbycoder]

Hi,

mittels folgender Klasse lasse ich mir ein DragImage neben den Dragcursor zeichnen.

Delphi-Quellcode:

{ TTreeDragControlObject }

destructor TTreeDragControlObject.Destroy;
begin
  FDragImages.Free;
  inherited;
end;

function TTreeDragControlObject.GetDragImages: TDragImageList;
var
  bmp: TBitmap;
begin
  if FDragImages=nil then
    FDragImages:=TDragImageList.Create(nil);
  if FDragImages<>nil then
  begin
    bmp:=TBitmap.Create;
    try
      bmp.Canvas.Brush.Color:=clAqua;
      bmp.Canvas.Font.Style:=[fsBold];
      bmp.Canvas.Font.Size:=14;
      bmp.Width:=bmp.Canvas.TextWidth(FText)+25;
      bmp.Height:=bmp.Canvas.TextHeight(FText);
      bmp.Canvas.FillRect(Rect(0,0,bmp.Width, bmp.Height));
      bmp.Canvas.TextOut(25, 0, FText);
      FDragImages.Width:=bmp.Width;
      FDragImages.Height:=bmp.Height;
      FDragImages.Masked:=True;
      FDragImages.AddMasked(bmp, clFuchsia);
    finally
      bmp.Free;
    end;
  end;
  Result:=FDragImages;
end;

procedure TTreeDragControlObject.HideDragImage;
begin
  GetDragImages.HideDragImage;
end;

procedure TTreeDragControlObject.SetSourceText(const Value: string);
begin
  FSourceText := Value;
end;

procedure TTreeDragControlObject.SetText(const Value: string);
begin
  FText:=Value;
  self.GetDragImages;
end;

procedure TTreeDragControlObject.ShowDragImage;
begin
  GetDragImages.ShowDragImage;
end;

procedure Tfrm_main.sgEndDrag(Sender, Target: TObject; X, Y: Integer);
begin
  FreeAndNil(FDragObject);
end;

Das klappt auch wunderbar.
Das Dragtarget ist eine Statusbar mit mehreren Panels, wobei sich der Test des DragImage je nach Panel anpassen soll.

Ich werte die Position auf der StatusBar über folgendes Event aus:

Delphi-Quellcode:

procedure Tfrm_main.StatusBar1DragOver(Sender, Source: TObject; X,
  Y: Integer; State: TDragState; var Accept: Boolean);
var
  i: Integer;
  p: Integer;
  w: Integer;
  isTarget: boolean;
begin
  p:=-1;
  w:=0;
  for i:=0 to StatusBar1.Panels.Count-2 do
  begin
    if (x>w) and (x<(w+StatusBar1.Panels[i].Width)) then
    begin
      p:=i;
      Break;
    end;
    w:=w+StatusBar1.Panels[i].Width;
  end;
  StatusBar1.Panels[StatusBar1.Panels.Count-1].Text:='P: '+IntToStr(P)+' X: '+inttostr(x)+' Y: '+inttostr(y);
  isTarget:=False;
  if p>-1 then
    if maList[p].montuer then
      isTarget:=True;
  if isTargetthen
  begin
    FDragObject.DragText:=FDragObject.SourceText +' planen für '+ maList[p].Name;
    FDragObject.ShowDragImage;
    StatusBar1.Panels[StatusBar1.Panels.Count-1].Text:=maList[p].Name;
  end else begin
    FDragObject.DragText:=FDragObject.SourceText;
    FDragObject.ShowDragImage;
    if p>-1 then
      StatusBar1.Panels[StatusBar1.Panels.Count-1].Text:='*'+maList[p].Name else
      StatusBar1.Panels[StatusBar1.Panels.Count-1].Text:='';
  end;
  Accept:=isTarget;
end;

Ich setze nun den Test für das FDragObject neu. Das klappt jedoch nur, wenn ich mit der Maus kurz von Statusbar runtergehe und an einer anderen Stelle wieder drauf. Bewege ich jedoch den Cursor auf der Statusbar zwischen den Panels hin und her, bleibt das DragImage immer gleich.
Das die Procedure StatusBar1DragOver beim Bewegen der Maus durchlaufen wird, kann ich am letzten Panel sehen, wo ich mir testweise die Daten ausgeben lasse.

Meine Vermutung ist ja, dass mittels AddMask der TDragImageList immer wieder ein neues Image hinzugefügt wird, aber immer nur das erste dargestellt wird. Ich finde aber auch keine Funktion, wie ich die TDragImageList leer krige. Auch ein FDragImages.Clear in der Procedure GetDragImages hat scheinbar keine Wirkung.

Wie kann man sowas machen, also das DragImage während der Mausbewegung auf dem gleichen Control verändern?

[Hobbycoder]

Hab mir dann doch selbst helfen können. Und damit alle anderen auch was davon haben ... :

Die Lösung steht hier.

Kurz gesagt: Die verwendete TDragImageList kann nach dem erstellen nicht verändert werden. Letztlich muss mittels GetDragCursor EndDrag und eine neues BeginDrag ausgelöst werden, damit die TDragImageList neu erstellt werden kann (Dann mit einem veränderten Image).

z.B. so:

Delphi-Quellcode:

function TTreeDragControlObject.GetDragCursor(Accepted: Boolean; X,
  Y: Integer): TCursor;
begin
  if (FPrevAccepted<>Accepted) or (FText<>FPrevText) then
    with FDragImages do
    begin
      EndDrag;
      SetDragImage(0, 0, 0);
      BeginDrag(GetDesktopWindow, x, y);
    end;
  FPrevAccepted:=Accepted;
  REsult:=inherited GetDragCursor(Accepted, x, y);
end;

[Uwe Raabe]

Packe einfach alle Bilder am Anfang in die DragImageList und wähle das passende mit SetDragImage aus.

[Hobbycoder]

Hm....gute Idee. Klingt auch logisch, weil ist ja eine DragImageList.

Wenn du noch eine Idee hättest, wie ich das DragImage weniger Transparent kriege?

[Uwe Raabe]

Zitat von Hobbycoder:

Wenn du noch eine Idee hättest, wie ich das DragImage weniger Transparent kriege?

Spiel doch mal mit dem DrawingStyle der TDragImageList.

[Hobbycoder]

Hat bei mir keinen spürbaren Effekt. Egal was ich einstelle, die Transparenz bleibt gleich.