Search code examples
delphidrag-and-dropjvcl

How to drag a thumbnail from JvtThumbview?


I am writing a WYSIWYG type of editor program in which the user can drag image thumbnails onto an editor surface (TPanel) and then create a PDF by rendering the editor surface onto the PDF.

On my TPanel, I have a TImage which the user can resize and move. I am using TSizeCtrl for this.

I have a TJvThumbview which is being loaded with images from a disk folder.

I want to accomplish drag-drop from the JvThumbview onto the TImage - but cannot do this.

Please can someone detail how I would accomplish this?

Thanks so much in advance.


Solution

  • I cannot resist.

    My demo project consists of:

    • one TJvThumbView and
    • one TImage

    Dragging is achieved by:

    • starting the drag operation when the user mouse-downs on the thumb view,
    • managing the dragged image by a TDragObject derivative,
    • drawing the dragged image when the drag object says the drag operation ended on the TImage.

    This is how it could look like:

    unit Unit1;
    
    interface
    
    uses
      Classes, Graphics, Controls, Forms, JvExForms, JvBaseThumbnail, JvThumbViews,
      ExtCtrls;
    
    type
      TMyDragObject = class(TDragControlObjectEx)
      private
        FDragImages: TDragImageList;
        FPictureToDrag: TPicture;
      protected
        function GetDragImages: TDragImageList; override;
        procedure Finished(Target: TObject; X, Y: Integer;
          Accepted: Boolean); override;
      public
        constructor CreateFromThumbView(ThumbView: TJvThumbView);
        destructor Destroy; override;
      end;
    
      TForm1 = class(TForm)
        JvThumbView1: TJvThumbView;
        Image1: TImage;
        procedure FormCreate(Sender: TObject);
        procedure JvThumbView1MouseDown(Sender: TObject; Button: TMouseButton;
          Shift: TShiftState; X, Y: Integer);
        procedure JvThumbView1StartDrag(Sender: TObject;
          var DragObject: TDragObject);
        procedure Image1DragOver(Sender, Source: TObject; X, Y: Integer;
          State: TDragState; var Accept: Boolean);
      end;
    
    var
      Form1: TForm1;
    
    implementation
    
    {$R *.dfm}
    
    procedure TForm1.FormCreate(Sender: TObject);
    begin
      // Fill our image list with arbitrary images
      if JvThumbView1.Directory = '' then
        JvThumbView1.Directory := 'C:\Users\Public\Pictures\Sample Pictures';
      // Style all controls for showing the drag image if Delphi version is D7 or
      // lower. See also comment in TMyDragObject.CreateFromThumbView
      JvThumbView1.ControlStyle := JvThumbView1.ControlStyle +
        [csDisplayDragImage];
      Image1.ControlStyle := Image1.ControlStyle + [csDisplayDragImage];
      ControlStyle := ControlStyle + [csDisplayDragImage];
    end;
    
    procedure TForm1.Image1DragOver(Sender, Source: TObject; X, Y: Integer;
      State: TDragState; var Accept: Boolean);
    begin
      // The destination image component accepts all drag operations
      Accept := True;
    end;
    
    procedure TForm1.JvThumbView1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    begin
      // If mouse down on a thumb...
      if JvThumbView1.SelectedFile <> '' then
        // then let's start dragging
        JvThumbView1.BeginDrag(False, Mouse.DragThreshold);
    end;
    
    procedure TForm1.JvThumbView1StartDrag(Sender: TObject;
      var DragObject: TDragObject);
    begin
      // DragObject will automatically be destroyed when necessary when it's
      // derived from TDragControlObjectEx
      DragObject := TMyDragObject.CreateFromThumbView(JvThumbView1);
    end;
    
    { TMyDragObject }
    
    const
      DragImageSize = 100;
    
    constructor TMyDragObject.CreateFromThumbView(ThumbView: TJvThumbView);
    begin
      inherited Create(ThumbView);
      // This is the picture the user will drag around
      FPictureToDrag := TPicture.Create;
      FPictureToDrag.LoadFromFile(ThumbView.SelectedFile);
      // We want a nice drag image, but this property is only available in >D7
      { AlwaysShowDragImages := True; }
    end;
    
    destructor TMyDragObject.Destroy;
    begin
      FDragImages.Free;
      FPictureToDrag.Free;
      inherited Destroy;
    end;
    
    procedure TMyDragObject.Finished(Target: TObject; X, Y: Integer;
      Accepted: Boolean);
    begin
      // Finished dragging
      inherited Finished(Target, X, Y, Accepted);
      // If we are over an Image component, then draw the picture
      if Accepted and (Target is TImage) then
        TImage(Target).Canvas.StretchDraw(Bounds(X, Y, DragImageSize,
          DragImageSize), FPictureToDrag.Graphic);
    end;
    
    function TMyDragObject.GetDragImages: TDragImageList;
    var
      DragImage: TBitmap;
    begin
      if FDragImages = nil then
      begin
        FDragImages := TDragImageList.Create(nil);
        // Set dimensions of drag image list
        FDragImages.Width := DragImageSize;
        FDragImages.Height := DragImageSize;
        // Prepare drag image
        DragImage:= TBitmap.Create;
        try
          DragImage.Width := DragImageSize;
          DragImage.Height := DragImageSize;
          DragImage.Canvas.StretchDraw(Rect(0, 0, DragImage.Width,
            DragImage.Height), FPictureToDrag.Graphic);
          FDragImages.AddMasked(DragImage, clWhite);
        finally
          DragImage.Free;
        end;
      end;
      Result := FDragImages;
    end;
    
    end.