Gemälde TPaintBox während Drag & Drop mit dragimage

Question

In meiner Anwendung (Delphi 2007) Ich möchte ziehen Sie die Elemente aus einem Listview zu einem PaintBox und Highlight entsprechenden Bereiche in der OnPaint-Handler PaintBox. Ich bekomme aber immer hässliche Artefakte. Haben Sie einen Tipp, wie ich sie loswerden?

Testprojekt: Erstellen Sie einfach eine neue VCL-Anwendung und ersetzen Sie den Code in Unit1.pas mit den folgenden. Dann starten Sie die App und ziehen Sie Listenelemente über das Rechteck in der 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: Hier ist ein Bild von dem Glitch: dragimage Artefakts http://img269.imageshack.us/img269/6535/15778780.png

Ich erwarte, dass das komplette blaue Rechteck mit dicken Rahmen zu sehen. Allerdings unter dem Drag-Bild kann man das nicht-markiertes Rechteck sehen.

Edit 2: spricht über "Malerei Thema" Diese Website :

  

Die Abbildungsliste SDK stellt fest, dass, wenn   das Drag-Bild zeichnen können Sie erhalten   Probleme mit Updates oder Bildschirm Malerei   es sei denn, Sie verwenden ImageList_DragLeave   API-Funktion Drag Bild ausblenden   während das Bild auftritt (was   was die HideDragImage Verfahren in der   Klasse der Fall ist). Leider, wenn Sie   Sie besitzen nicht das Steuerelement, das Wesen ist   gemalt tun dies nicht wirklich eine ist   Option.

Ich habe das Problem nicht im letzten Satz erwähnt. Trotzdem war ich nicht in der Lage den richtigen Ort und die richtige Bildliste zu finden (es ist nicht ImageList1 in meinem Testprojekt - wahrscheinlich ListView1.GetDragImages). ImageList_DragLeave anrufen

Answer 1

Der Schlüssel ist das Drag-Bild zu verstecken, bevor die Farbe Box neu gezeichnet wird, und es danach wieder zu zeigen. Wenn Sie diesen Code in Ihrer Frage ersetzen:

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;

Mit diesem

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;

sollte es funktionieren. Nun, es hat für mich mit Delphi 2007 auf Windows XP 64 Bit.

Und ein dickes Lob für die Demonstration Code in Ihrer Frage, hervorragende Möglichkeit, uns das Problem sehen zu lassen.

Answer 2

Getestet auf XP, Delphi 2010 - ich die Artefakte erhalten, so dass es XP verwandt und nicht in D2010 Fest

Edit:

Bei der weiteren Untersuchung - wenn Sie ein Symbol ziehen, so dass die Maus nur gerade die Box betritt (aber das Symbol nicht) dann die Box korrekt gezeichnet wird, ist es nur, wenn das Symbol der Malkasten eintritt, dass die Artefakte auftreten.

Ich habe Code, so dass, wenn Staat dsDragMove ist, dann wäre es ein Neuzeichnen erzwingen und dies funktionierte, aber von Flimmern

gelitten