Gemälde TPaintBox während Drag & Drop mit dragimage
-
19-09-2019 - |
Frage
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
Lösung
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.
Andere Tipps
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