Einzelnen Beitrag anzeigen

Hobbycoder

Registriert seit: 22. Feb 2017
955 Beiträge
 
#1

TDragImage während DragOver verändern

  Alt 28. Aug 2018, 16:51
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?
Gruß Hobbycoder
Alle sagten: "Das geht nicht.". Dann kam einer, der wusste das nicht, und hat's einfach gemacht.
  Mit Zitat antworten Zitat