DragImage を使用したドラッグ アンド ドロップ中に TPaintBox をペイントする
-
19-09-2019 - |
質問
私のアプリケーション (Delphi 2007) では、ListView から PaintBox に項目をドラッグし、PaintBox の OnPaint ハンドラーで対応する領域を強調表示したいと考えています。しかし、私はいつも醜い芸術品を手に入れます。どうすればそれらを取り除くことができるかアドバイスはありますか?
テストプロジェクト: 新しい VCL アプリケーションを作成し、Unit1.pas のコードを次のものに置き換えるだけです。次に、アプリを起動し、リスト項目をペイント ボックス内の四角形上にドラッグします。
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.
編集: 不具合の写真は次のとおりです。DragImage アーティファクト http://img269.imageshack.us/img269/6535/15778780.png
太い枠線が付いた完全な青い長方形が表示されることを期待しています。ただし、ドラッグ画像の下には、強調表示されていない四角形が表示されます。
編集2: このサイト 「絵画の問題」について話します。
ImageList SDKは、ドラッグ画像を描画するときに、ImageList_DragLeave API関数を使用して絵画が発生している間にドラッグ画像を非表示にしない限り、更新または画面絵画の問題を取得できることに注意してください(クラスのHidedRagimageメソッドが行うこと)。残念ながら、これを行うことで塗装されているコントロールを所有していない場合、実際には選択肢ではありません。
最後の文で述べたような問題はありません。それにもかかわらず、適切な場所と適切な画像リストを見つけることができませんでした( ない 私のテストプロジェクトのImageList1 - おそらくListView1.GetDragImages)を使用してImageList_DragLeaveを呼び出します。
解決
重要なのは、ペイント ボックスが再描画される前にドラッグ イメージを非表示にし、再描画後に再び表示することです。質問内のこのコードを置き換えると、次のようになります。
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;
これとともに
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;
それは機能するはずです。そうですね、Windows XP 64 ビット上の Delphi 2007 では問題ありません。
そして、質問内のデモ コードは、問題を理解するための優れた方法であり、称賛に値します。
他のヒント
XP、Delphi 2010 でテスト済み - アーティファクトが得られるため、これは XP 関連であり、D2010 では修正されていません
編集:
さらに調査すると、マウスがボックスにちょうど入るようにアイコンをドラッグした場合 (アイコンは入っていない)、ボックスは正しく描画されます。アーティファクトが発生するのは、アイコンがペイントボックスに入ったときだけです。
状態が dsDragMove の場合に再描画を強制するようにコードを追加しました。これは機能しましたが、ちらつきが発生しました