Question

In my application (Delphi 2007) I want to drag items from a ListView to a PaintBox and highlight corresponding areas in the PaintBox’s OnPaint handler. However I always get ugly artefacts. Do you have any advice how I can get rid of them?

Test project: Just create a new VCL application and replace the code in Unit1.pas with the following. Then start the app and drag list items over the rectangle in the PaintBox.

unit Unit1;

interface

uses
  Windows,
  Messages,
  SysUtils,
  Variants,
  Classes,
  Graphics,
  Controls,
  Forms,
  Dialogs,
  ExtCtrls,
  ComCtrls,
  ImgList;

type
  TForm1 = class(TForm)
  private
    PaintBox1: TPaintBox;
    ListView1: TListView;
    ImageList1: TImageList;
    FRectIsHot: Boolean;
    function GetSensitiveRect: TRect;
    procedure PaintBox1DragOver(Sender, Source: TObject; X, Y: Integer;
      State: TDragState; var Accept: Boolean);
    procedure PaintBox1Paint(Sender: TObject);
  public
    constructor Create(AOwner: TComponent); override;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

uses
  TypInfo;

const
  IconIDs: array[TMsgDlgType] of PChar = (IDI_EXCLAMATION, IDI_HAND,
    IDI_ASTERISK, IDI_QUESTION, nil);

{ TForm1 }

constructor TForm1.Create(AOwner: TComponent);
var
  Panel1: TPanel;
  mt: TMsgDlgType;
  Icon: TIcon;
  li: TListItem;
begin
  inherited Create(AOwner);
  Width := 600;
  Height := 400;

  ImageList1 := TImageList.Create(Self);
  ImageList1.Name := 'ImageList1';
  ImageList1.Height := 32;
  ImageList1.Width := 32;

  ListView1 := TListView.Create(Self);
  ListView1.Name := 'ListView1';
  ListView1.Align := alLeft;
  ListView1.DragMode := dmAutomatic;
  ListView1.LargeImages := ImageList1;

  Panel1 := TPanel.Create(Self);
  Panel1.Name := 'Panel1';
  Panel1.Caption := 'Drag list items here';
  Panel1.Align := alClient;

  PaintBox1 := TPaintBox.Create(Self);
  PaintBox1.Name := 'PaintBox1';
  PaintBox1.Align := alClient;
  PaintBox1.ControlStyle := PaintBox1.ControlStyle + [csDisplayDragImage];
  PaintBox1.OnDragOver := PaintBox1DragOver;
  PaintBox1.OnPaint := PaintBox1Paint;
  PaintBox1.Parent := Panel1;

  ListView1.Parent := Self;
  Panel1.Parent := Self;

  Icon := TIcon.Create;
  try
    for mt := Low(TMsgDlgType) to High(TMsgDlgType) do
      if Assigned(IconIDs[mt]) then
      begin
        li := ListView1.Items.Add;
        li.Caption := GetEnumName(TypeInfo(TMsgDlgType), Ord(mt));
        Icon.Handle := LoadIcon(0, IconIDs[mt]);
        li.ImageIndex := ImageList1.AddIcon(Icon);
      end;
  finally
    Icon.Free;
  end;
end;

function TForm1.GetSensitiveRect: TRect;
begin
  Result := PaintBox1.ClientRect;
  InflateRect(Result, -PaintBox1.Width div 4, -PaintBox1.Height div 4);
end;

procedure TForm1.PaintBox1Paint(Sender: TObject);
var
  r: TRect;
begin
  r := GetSensitiveRect;
  if FRectIsHot then
  begin
    PaintBox1.Canvas.Pen.Width := 5;
    PaintBox1.Canvas.Brush.Style := bsSolid;
    PaintBox1.Canvas.Brush.Color := clAqua;
  end
  else
  begin
    PaintBox1.Canvas.Pen.Width := 1;
    PaintBox1.Canvas.Brush.Style := bsClear;
  end;
  PaintBox1.Canvas.Rectangle(r.Left, r.Top, r.Right, r.Bottom);
end;

procedure TForm1.PaintBox1DragOver(Sender, Source: TObject; X,
  Y: Integer; State: TDragState; var Accept: Boolean);
var
  r: TRect;
  MustRepaint: Boolean;
begin
  MustRepaint := False;

  if State = dsDragEnter then
  begin
    FRectIsHot := False;
    MustRepaint := True;
  end
  else
  begin
    r := GetSensitiveRect;
    Accept := PtInRect(r, Point(X, Y));

    if Accept <> FRectIsHot then
    begin
      FRectIsHot := Accept;
      MustRepaint := True;
    end;
  end;

  if MustRepaint then
    PaintBox1.Invalidate;
end;

end.

Edit: Here is a picture of the glitch:DragImage artefact http://img269.imageshack.us/img269/6535/15778780.png

I expect to see the complete blue rectangle with thick border. However beneath the drag image one can see the un-highlighted rectangle.

Edit 2: This site talks about “Painting Issues”:

The ImageList SDK notes that when
drawing the drag image you can get
issues with updates or screen painting
unless you use the ImageList_DragLeave
API function to hide the drag image
whilst the painting occurs (which is
what the HideDragImage method in the
class does). Unfortunately, if you
don’t own the control that’s being
painted doing this isn’t really an
option.

I don’t have the problem mentioned in the last sentence. Nevertheless I wasn’t able to find the right place and the right imagelist (it’s not ImageList1 in my test project – probably ListView1.GetDragImages) to call ImageList_DragLeave.

Answer 1

The key is to hide the drag image before the paint box is redrawn, and to show it again after that. If you replace this code in your question:

procedure TForm1.PaintBox1DragOver(Sender, Source: TObject; X,
  Y: Integer; State: TDragState; var Accept: Boolean);
var
  r: TRect;
  MustRepaint: Boolean;
begin
  MustRepaint := False;

  if State = dsDragEnter then
  begin
    FRectIsHot := False;
    MustRepaint := True;
  end
  else
  begin
    r := GetSensitiveRect;
    Accept := PtInRect(r, Point(X, Y));

    if Accept <> FRectIsHot then
    begin
      FRectIsHot := Accept;
      MustRepaint := True;
    end;
  end;

  if MustRepaint then
    PaintBox1.Invalidate;
end;

with this

procedure TForm1.PaintBox1DragOver(Sender, Source: TObject; X,
  Y: Integer; State: TDragState; var Accept: Boolean);
var
  r: TRect;
begin
  if State = dsDragEnter then
  begin
    FRectIsHot := False;
    PaintBox1.Invalidate;
  end
  else
  begin
    r := GetSensitiveRect;
    Accept := PtInRect(r, Point(X, Y));

    if Accept <> FRectIsHot then
    begin
      FRectIsHot := Accept;
      ImageList_DragShowNolock(False);
      try
        PaintBox1.Refresh;
      finally
        ImageList_DragShowNolock(True);
      end;
    end;
  end;
end;

it should work. Well, it does for me with Delphi 2007 on Windows XP 64 bit.

And kudos for the demonstration code in your question, excellent way to let us see the problem.