Модуль TXTDRGBX PAS
unit TxtDrgBx; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls; type TTextDragListBox = class( TListBox ) private FDragImage: TImageList; protected procedure CreateDragImage; procedure DoStartDrag( var DragObject: TDragObject );
override; public constructor Create( AnOwner: TComponent );
override; destructor Destroy; override; function GetDragImages: TCustomImageList; override; end; procedure Register; implementation constructor TTextDragListBox.Create( AnOwner: TComponent );
begin inherited Create( AnOwner );
ControlStyle := ControlStyle + [ csDisplayDragImage ]; FDragImage := TImageList.CreateSize ( 32, 32 );
end; destructor TTextDragListBox.Destroy; begin FDragImage.Free; inherited Destroy; end; procedure TTextDragListBox.CreateDragImage; var Bitmap: TBitmap; // Перетаскиваемое изображение AnItemRect: TRect; // Прямоугольник, в котором находится // элемент списка MousePt: TPoint; // Положение курсора begin // Очищаем список изображений //и заканчиваем работу, // если в списке нет выделенных элементов FDragImage.Clear; if ItemIndex = -1 then Exit; // Создаем растр, масштабируем его //до размеров // выделенного элемента и выводим //в нем текст AnItemRect := ItemRect( ItemIndex );
Bitmap := TBitmap.Create; try with Bitmap do begin Width := AnItemRect.Right - AnItemRect.Left; Height := AnItemRect.Bottom - AnItemRect.Top; Canvas.Font := Font; Canvas.DrawFocusRect( Rect( 0, 0, Width, Height ) );
Canvas.Brush.Style := bsClear; Canvas.TextOut ( 1, 1, Items[ ItemIndex ] );
// Задаем размер списка изображений, заносим //в него // изображение и устанавливаем прозрачный цвет FDragImage.Width := Width; FDragImage.Height := Height; FDragImage.AddMasked( Bitmap, clWhite );
// ... задаем положение активной точки GetCursorPos( MousePt );
with ScreenToClient( MousePt ), AnItemRect do FDragImage.SetDragImage ( 0, X - Left, Y - Top );
end; finally Bitmap.Free; end; end; procedure TTextDragListBox.DoStartDrag ( var DragObject: TDragObject );
begin inherited DoStartDrag( DragObject );
CreateDragImage; end; function TTextDragListBox.GetDragImages: TCustomImageList; begin Result := nil; if FDragImage.Count >
0 then Result := FDragImage; end; procedure Register; begin RegisterComponents('HP Delphi 3', [ TTextDragListBox ]);
end; end.
Основную часть листинга 9.5 занимает процедура CreateDragImage для работы со списком изображений. После создания и прорисовки растра размер списка изображений приводится в соответствие с размером растра (не забывайте это делать!), после чего метод AddMasked заносит растр в список и назначает прозрачный цвет.
Метод SetDragImage, вызываемый двумя строками ниже, задает положение активной точки (hotspot) перетаскиваемого изображения. Мышь «держит» перетаскиваемое изображение в активной точке. В нашем случае вызов SetDragImage гарантирует, что текстовый прямоугольник будет перетаскиваться за точку его первоначального «захвата».
Конечно, запрограммировать этот прием в Delphi 2 и 3 оказывается сложнее, чем просто рисовать на экране, но зато перед вами открываются широкие возможности для организации визуального взаимодействия компонентов. Например, при перетаскивании изображения между списками второй список может скрыть перетаскиваемое изображение, выделить свой элемент-приемник и затем вернуть скрытое изображение на экран.
