Гость
Целевая тема:
Создать новую тему:
Автор:
Форумы / Delphi [игнор отключен] [закрыт для гостей] / TDragControlObject и что ему надо? / 4 сообщений из 4, страница 1 из 1
26.04.2021, 17:45
    #40066071
Мимопроходящий
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
TDragControlObject и что ему надо?
пытаюсь рисовать перетаскиваемый текст (Drag&Drop).
для этого создан класс
TDraggedText
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
uses
  Controls, Graphics;

type
  TDraggedText = class(TDragControlObject)
  private
    FDragImages: TDragImageList;
    FText: string;
  protected
    function GetDragImages: TDragImageList; override;
  public
    constructor Create(AControl: TControl; AText: string); reintroduce;  
    destructor Destroy; override;
    procedure HideDragImage; override;
    procedure ShowDragImage; override;
    property DragText: string read FText write FText;
  end;

implementation

{ TDraggedText }

constructor TDraggedText.Create(AControl: TControl; AText: string);
begin
  inherited Create(AControl);
  FText := AText;
end;

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

procedure TDraggedText.HideDragImage;
begin
  GetDragImages.HideDragImage;
end;

procedure TDraggedText.ShowDragImage;
begin
  GetDragImages.ShowDragImage;
end;

type
  TMyControl = class(TControl);

function TDraggedText.GetDragImages: TDragImageList;
var
  Bmp: TBitmap;
begin
  if FDragImages = nil then
    begin
      FDragImages := TDragImageList.Create(nil);
      Bmp := TBitmap.Create;
      try
        Bmp.Canvas.Font.Assign(TMyControl(Control).Font);
        Bmp.Canvas.Font.Color := clHotlight;
        Bmp.Width := Bmp.Canvas.TextWidth(FText);
        Bmp.Height := Bmp.Canvas.TextHeight(FText);
        Bmp.Canvas.TextOut(0, 0, FText);
        FDragImages.Width := Bmp.Width;
        FDragImages.Height := Bmp.Height;
        FDragImages.SetDragImage(FDragImages.Add(Bmp, nil), 0, 0);
      finally
        Bmp.Free;
      end;
    end;
  Result := FDragImages;
end;

end.

для примера берём ListBox:
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
ListBox1.DragMode := dmAutomatic;
...
procedure TForm1.ListBox1StartDrag(Sender: TObject; var DragObject: TDragObject);
begin
  DragObject := TDraggedText.Create(ListBox1, 'тра-та-та');
end;

procedure TForm1.ListBox1DragOver(Sender, Source: TObject; X, Y: Integer;
  State: TDragState; var Accept: Boolean);
begin
  Accept := Source is TDraggedText;
end;

мышку нажал - текст нарисовался.
начинаешь вести - текст исчез и с концами.

что ему ещё надобно?
есть у кого идеи?
...
Рейтинг: 0 / 0
26.04.2021, 18:01
    #40066081
alekcvp
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
TDragControlObject и что ему надо?
Мимопроходящий,

А погуглить?
https://stackoverflow.com/questions/13043343/how-to-have-text-as-my-drag-cursor
...
Рейтинг: 0 / 0
26.04.2021, 18:06
    #40066086
Мимопроходящий
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
TDragControlObject и что ему надо?
26.04.2021 18:01, alekcvp пишет:
> А погуглить?

ага.
вон оно чо, Михалыч.
контролу нужно стиль привить.
Код: pascal
1.
ListBox1.ControlStyle := ListBox1.ControlStyle + [csDisplayDragImage];



thanks! :)
...
Рейтинг: 0 / 0
26.04.2021, 19:15
    #40066099
alekcvp
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
TDragControlObject и что ему надо?
Мимопроходящий,

Вообще у меня в проге и без этого работает, а вот изображение сгенерировать - надо.
...
Рейтинг: 0 / 0
Форумы / Delphi [игнор отключен] [закрыт для гостей] / TDragControlObject и что ему надо? / 4 сообщений из 4, страница 1 из 1
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]