Dragimage와 함께 드래그 앤 드롭 중에 tpaintbox를 그리는 것

Question

내 응용 프로그램 (Delphi 2007)에서는 항목을 ListView에서 페인트 박스로 드래그하고 페인트 박스의 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 메소드가하는 것). 불행히도, 당신이 그린 컨트롤을 소유하고 있지 않다면이 작업을 수행하는 것은 실제로 선택 사항이 아닙니다.

마지막 문장에서 언급 된 문제가 없습니다. 그럼에도 불구하고 나는 올바른 장소와 올바른 Imagelist를 찾을 수 없었습니다 ( ~ 아니다 내 테스트 프로젝트의 imagelist1- 아마도 ListView1.getDragimages) imageList_dragleave를 호출합니다.

Answer 1

열쇠는 페인트 상자가 다시 그려지기 전에 드래그 이미지를 숨기고 그 후 다시 보여주는 것입니다. 질문 에서이 코드를 대체하는 경우 :

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과 함께합니다.

그리고 당신의 질문에서 데모 코드에 대한 kudos, 우리가 문제를 볼 수있는 훌륭한 방법.

Answer 2

XP, Delphi 2010에서 테스트 - 아티팩트를 얻으므로 XP와 관련이 있고 D2010에서 고정되지 않았습니다.

편집하다:

추가 조사시 - 마우스가 상자에 들어가도록 아이콘을 끌면 상자가 올바르게 그려지면 아이콘이 아티팩트가 발생하는 페인트 박스에 들어가는 경우에만 해당됩니다.

State가 dsdragmove라면 코드를 추가하여 다시 칠할 것이고 이것이 효과가 있었지만 깜박임으로 고통 받았습니다.