delphi - imagenes - que es wow slider

Arrastre el cambio de imagen mientras arrastra sobre la grilla

Question

Estoy creando una instancia de mi DragObject personalizado en StartDrag:

procedure TForm1.GridStartDrag(Sender: TObject;
var DragObject: TDragObject);
begin
DragObject := TMyDragControlObject.Create(Sender as TcxGridSite);
end;

Últimamente en otra grilla en DragOver:

procedure TForm1.SecondGridDragOver(Sender, Source: TObject; X,
Y: Integer; State: TDragState; var Accept: Boolean);
begin
Accept := False;
if Source is TMyDragControlObject then
with TMyDragControlObject(Source) do
// using TcxGrid
if (Control is TcxGridSite) or (Control is TcxGrid) then begin
Accept := True
// checking the record value on grid
// the label of drag cursor will be different
// getting the record value works fine!
if RecordOnGrid.Value > 5 then
DragOverPaint(FImageList, ''You can drop here!'');
else begin
Accept := false;
DragOverPaint(FImageList, ''You can''''t drop here!'');
end
end;
end;

Mi procedimiento DragOverPaint:

procedure TForm1.DragOverPaint(ImageList: TImageList; AValue: string);
var ABmp: TBitmap;
begin
if not Assigned(ImageList) then Exit;
ABmp := TBitmap.Create();
try
with ABmp.Canvas do begin
ABmp.Width := TextWidth(AValue);
ABmp.Height := TextHeight(AValue);
TextOut(0, 0, AValue);
end;
ImageList.BeginUpdate;
ImageList.Clear;
ImageList.Width := ABmp.Width;
ImageList.Height := ABmp.Height;
ImageList.AddMasked(ABmp, clNone);
ImageList.EndUpdate;
finally
ABmp.Free();
end;
Repaint;
end;

Quiero que vuelva a pintar DragImageList según el valor de registro de la cuadrícula, pero la lista de imágenes no se actualiza cuando ya está pintada.

Answer 1

Una vez que ImageList ha empezado a arrastrarse, no puede cambiar la imagen de arrastre cambiando la ImageList porque Windows crea otra ImageList temporalmente mezclada especialmente para el arrastre. Por lo tanto, debe finalizar, cambiar e iniciar de nuevo el arrastre ImageList (esto no es igual a finalizar e iniciar la operación de arrastre de VCL completa, solo WinAPI ImageList). El resultado / desventaja es un leve temblor en la transición de las imágenes.

El momento de cambiar las imágenes cambia cuando se acepta (en este caso específico). Es posible tratar esto en OnDragOver, pero ya que usted crea un propio DragObject, también puede anular los métodos diseñados para ello de TDragObject:

type
TControlAccess = class(TControl);
TMyDragControlObject = class(TDragControlObjectEx)
private
FDragImages: TDragImageList;
FPrevAccepted: Boolean;
protected
function GetDragCursor(Accepted: Boolean; X, Y: Integer): TCursor; override;
function GetDragImages: TDragImageList; override;
public
destructor Destroy; override;
end;
{ TMyDragControlObject }
destructor TMyDragControlObject.Destroy;
begin
FDragImages.Free;
inherited Destroy;
end;
function TMyDragControlObject.GetDragCursor(Accepted: Boolean; X,
Y: Integer): TCursor;
begin
if FPrevAccepted <> Accepted then
with FDragImages do
begin
EndDrag;
SetDragImage(Ord(Accepted), 0, 0);
BeginDrag(GetDesktopWindow, X, Y);
end;
FPrevAccepted := Accepted;
Result := inherited GetDragCursor(Accepted, X, Y);
end;
function TMyDragControlObject.GetDragImages: TDragImageList;
const
SNoDrop = ''You can''''t drop here!!'';
SDrop = ''You can drop here.'';
Margin = 20;
var
Bmp: TBitmap;
begin
if FDragImages = nil then
begin
FDragImages := TDragImageList.Create(nil);
Bmp := TBitmap.Create;
try
Bmp.Canvas.Font.Assign(TControlAccess(Control).Font);
Bmp.Width := Bmp.Canvas.TextWidth(SNoDrop) + Margin;
Bmp.Height := Bmp.Canvas.TextHeight(SNoDrop);
Bmp.Canvas.TextOut(Margin, 0, SNoDrop);
FDragImages.Width := Bmp.Width;
FDragImages.Height := Bmp.Height;
FDragImages.Add(Bmp, nil);
Bmp.Canvas.FillRect(Rect(0, 0, Bmp.Width, Bmp.Height));
Bmp.Canvas.TextOut(Margin, 0, SDrop);
FDragImages.Add(Bmp, nil);
FDragImages.SetDragImage(0, 0, 0);
finally
Bmp.Free;
end;
end;
Result := FDragImages;
end;
{ TForm1 }
procedure TForm1.FormCreate(Sender: TObject);
begin
Grid1.ControlStyle := Grid1.ControlStyle + [csDisplayDragImage];
Grid2.ControlStyle := Grid2.ControlStyle + [csDisplayDragImage];
end;
procedure TForm1.Grid1StartDrag(Sender: TObject; var DragObject: TDragObject);
begin
DragObject := TMyDragControlObject.Create(Sender as TStringGrid);
end;
procedure TForm1.Grid2DragOver(Sender, Source: TObject; X, Y: Integer;
State: TDragState; var Accept: Boolean);
begin
Accept := False;
if IsDragObject(Source) then
with TMyDragControlObject(Source) do
if Control is TGrid then
{ Just some condition for testing }
if Y > Control.Height div 2 then
Accept := True;
end;

Answer 2

Como señaló NGLN, la razón por la cual el cambio no surte efecto es que Windows crea una lista temporal de imágenes mientras arrastra. Como solución ligeramente diferente, puede cambiar directamente la imagen en esta lista temporal.

El siguiente es el DragOverPaint modificado en consecuencia. Tenga en cuenta que aún debe utilizar algún tipo de indicador para no volver a llenar la lista con cada movimiento del mouse como en la respuesta de NGLN.

procedure TForm1.DragOverPaint(ImageList: TImageList; AValue: string);
var
ABmp: TBitmap;
ImgList: HIMAGELIST; // <- will get the temporary image list
begin
if not Assigned(ImageList) then Exit;
ABmp := TBitmap.Create();
try
with ABmp.Canvas do begin
ABmp.Width := TextWidth(AValue);
ABmp.Height := TextHeight(AValue);
TextOut(0, 0, AValue);
end;
// ImageList.BeginUpdate; // do not fiddle with the image list,
// ImageList.Clear; // it''s not used while dragging
// ImageList.Width := ABmp.Width;
// ImageList.Height := ABmp.Height;
// ImageList.AddMasked(ABmp, clNone);
// ImageList.EndUpdate;
// get the temporary image list
ImgList := ImageList_GetDragImage(nil, nil);
// set the dimensions for images and empty the list
ImageList_SetIconSize(ImgList, ABmp.Width, ABmp.Height);
// add the text as the first image
ImageList_AddMasked(ImgList, ABmp.Handle, ColorToRGB(clWhite));
finally
ABmp.Free();
end;
// Repaint; // <- No need to repaint the form
end;