2

私のアプリケーション (Delphi 2007) では、項目を ListView から PaintBox にドラッグし、PaintBox の OnPaint ハンドラで対応する領域を強調表示したいと考えています。しかし、私はいつも醜いアーティファクトを手に入れます。それらを取り除く方法について何かアドバイスはありますか?

テスト プロジェクト:新しい VCL アプリケーションを作成し、Unit1.pas のコードを次のコードに置き換えます。次に、アプリを起動し、リスト項目を 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.

編集:これはグリッチの写真です: DragImage アーティファクト http://img269.imageshack.us/img269/6535/15778780.png

太い境界線を持つ完全な青い長方形が表示されることを期待しています。ただし、ドラッグ イメージの下には、強調表示されていない四角形が表示されます。

編集 2: このサイトでは、「塗装の問題」について説明しています。

ImageList SDK は、ドラッグ画像を描画するときに、描画中に ImageList_DragLeave API 関数を使用してドラッグ画像を非表示にしない限り、更新または画面描画で問題が発生する可能性があることに注意してください (これは、クラスの HideDragImage メソッドが行うことです)。残念ながら、ペイントされているコントロールを所有していない場合、これを行うことは実際にはオプションではありません。

最後の文で述べた問題はありません。それにもかかわらず、ImageList_DragLeave を呼び出すための適切な場所と適切なイメージリスト (私のテスト プロジェクトでは ImageList1 ではない- おそらく ListView1.GetDragImages) を見つけることができませんでした。

4

2 に答える 2

2

重要なのは、ペイントボックスが再描画される前にドラッグ画像を非表示にし、その後再び表示することです。質問でこのコードを置き換える場合：

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;

動作するはずです。まあ、それはWindowsXP64ビット上のDelphi2007で私のためになります。

そして、あなたの質問のデモコードに対する称賛、問題を私たちに見せるための優れた方法。

于 2010-02-10T12:21:18.220 に答える
1

XP、Delphi 2010 でテスト済み - アーティファクトを取得したので、XP 関連であり、D2010 では修正されていません

編集：

さらに調査すると、アイコンをドラッグして、マウスがボックスに入るだけで (アイコンは入りません)、ボックスが正しく描画されます。アーティファクトが発生するのは、アイコンがペイントボックスに入ったときだけです。

状態が dsDragMove の場合に再描画が強制されるようにコードを追加しましたが、これは機能しましたが、ちらつきが発生しました

于 2010-02-10T12:20:26.500 に答える