Как перетащить миниатюру из JvtThumbview? - PullRequest
Новая
       46

Как перетащить миниатюру из JvtThumbview?

2 голосов
/ 19 августа 2011

Я пишу программу редактора WYSIWYG, в которой пользователь может перетаскивать эскизы изображений на поверхность редактора (TPanel), а затем создавать PDF-файл, визуализируя поверхность редактора в PDF.

На моем TPanel у меня есть изображение, которое пользователь может изменять и перемещать. Я использую TSizeCtrl для этого.

У меня есть TJvThumbview, который загружается с изображениями из папки на диске.

Я хочу выполнить перетаскивание из JvThumbview на изображение, но не могу этого сделать.

Пожалуйста, кто-нибудь может подробно описать, как мне это сделать?

Большое спасибо заранее.

1 Ответ

3 голосов
/ 19 августа 2011

Я не могу устоять.

Мой демонстрационный проект состоит из:

  • один TJvThumbView и
  • один TImage

Перетаскивание достигается:

  • запуск операции перетаскивания, когда пользователь нажимает кнопку мыши на виде большого пальца,
  • управление перетаскиваемым изображением по производной TDragObject,
  • рисование перетаскиваемого изображения, когда объект перетаскивания сообщает, что операция перетаскивания завершена на TImage.

Вот как это может выглядеть: 

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.
...