Drag and Drop von einer Listbox in die andere ohne VCL

[Gruber_Hans_12345]

Hi Luckie

Ich habs in einem Projekt von mir auch Drag & Drop ohne Shell ohne VCL gemacht

Ist schon ne weile her, hab einfach den Source kopiert (ist sicher ne menge unnützer scahen dabei ...)

Delphi-Quellcode:

  TDummyDragManager = class(TInterfacedObject, IDropTarget)
  private
    FoldItem    : TTBCustomItem;
    FOwner      : TControl;
    trAutoCheck : TTimer;
    procedure RestartTimer;
    procedure StopTimer;

    procedure OnTimer(Sender : TObject);
  public
    destructor Destroy; override;

    function DragEnter(const DataObject: IDataObject; KeyState: Integer; Pt: TPoint; var Effect: Integer): HResult; stdcall;
    function DragLeave: HResult; stdcall;
    function DragOver(KeyState: Integer; Pt: TPoint; var Effect: Integer): HResult; stdcall;
    function Drop(const DataObject: IDataObject; KeyState: Integer; Pt: TPoint; var Effect: Integer): HResult; stdcall;
  end;

function TDummyDragManager.DragEnter(const DataObject: IDataObject; KeyState: Integer; Pt: TPoint; var Effect: Integer): HResult; stdcall;
begin
    Effect                  := DROPEFFECT_LINK;
    Result  := 0;
end;

function TDummyDragManager.DragLeave: HResult;
begin
    Result  := 0;
end;

destructor TDummyDragManager.Destroy;
begin
    if assigned(trAutoCheck) then
        FreeAndNil(trAutoCheck);
    inherited;
end;

procedure TDummyDragManager.OnTimer(Sender : TObject);
begin
    TTimer(Sender).Enabled  := FALSE;
    TfrMDIChild(TForm(TTBXItem(FoldItem).Tag)).DoActivate;
end;

procedure TDummyDragManager.StopTimer;
begin
    if not assigned(trAutoCheck) then exit;
    trAutoCheck.Enabled := FALSE;
end;

procedure TDummyDragManager.RestartTimer;
begin
    if not assigned(trAutoCheck) then begin
        trAutoCheck             := TTimer.Create(nil);
        trAutoCheck.Interval    := 500;
        trAutoCheck.OnTimer     := OnTimer;
    end;

    trAutoCheck.Enabled := FALSE;
    trAutoCheck.Enabled := TRUE;
end;

function TDummyDragManager.DragOver(KeyState: Integer; Pt: TPoint; var Effect: Integer): HResult;
var thisItem    : TTBCustomItem;
begin
    thisItem    := nil;
    TTBXToolbar(FOwner).View.UpdateSelection(@Pt, True);
    if Assigned(TTBXToolbar(FOwner).View.Selected) then begin
        thisItem    := TTBXToolbar(FOwner).View.Selected.Item;
        if not thisItem.Enabled then thisItem   := nil;
    end;

    if thisItem <> FoldItem then begin
        FoldItem    := thisItem;
        if assigned(FoldItem) then  RestartTimer
        else                        StopTimer;
    end;
    if assigned(thisItem) then Effect   := DROPEFFECT_LINK;
    Result    := 0;
end;

function TDummyDragManager.Drop(const DataObject: IDataObject; KeyState: Integer; Pt: TPoint; var Effect: Integer): HResult;
begin
    Result  := 0;
end;

... FormCreate
    dropTarget              := TDummyDragManager.Create;
    dropTarget.FOwner       := tbTaskBar;

    RegisterDragDrop(tbTaskBar.Handle, IDropTarget(dropTarget));

Vielleicht hilfts ja