اللوحة tpaintbox أثناء السحب والإفلات مع dragimage

Question

في طلبي (Delphi 2007) أريد سحب العناصر من ListView إلى علبة Paintbox وتسليط الضوء على المناطق المقابلة في معالج OnPaint صندوق Paintbox. ومع ذلك أنا دائما أحصل على القطع الأثرية القبيحة. هل لديك أي نصيحة كيف يمكنني التخلص منها؟

مشروع اختبار: ما عليك سوى إنشاء تطبيق 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 Artefact http://img269.imageshack.us/img269/6535/1577878.png.

أتوقع أن أرى المستطيل الأزرق الكامل مع حدود سميكة. ولكن أسفل صورة السحب يمكن للمرء أن يرى المستطيل غير الملمع.

تحرير 2: هذا الموقع يتحدث عن "قضايا اللوحة":

يلاحظ SDK ImageList أنه عند رسم صورة السحب، يمكنك الحصول على مشكلات مع تحديثات أو لوحة الشاشة إلا إذا كنت تستخدم وظيفة APHIMELIST_DRAGLEAVE API لإخفاء صورة السحب أثناء حدوث اللوحة (وهذا ما هي طريقة HIDRIDRADRAGIMAGE في الفصل). لسوء الحظ، إذا كنت لا تملك عنصر التحكم الذي يتم رسمه في القيام بذلك ليس خيارا حقا.

ليس لدي المشكلة المذكورة في الجملة الأخيرة. ومع ذلك، لم أتمكن من العثور على المكان المناسب والمختصة الصحيحة (إنها ليس Imagelist1 في مشروع الاختبار الخاص بي - ربما ListView1.getDrigimages) للاتصال 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;

يجب أن تعمل. حسنا، الأمر بالنسبة لي مع دلفي 2007 على نظام التشغيل Windows XP 64 بت.

وكودوس للحصول على رمز العرض التوضيحي في سؤالك، طريقة ممتازة لإعلامنا بالمشكلة.

Answer 2

تم اختباره على XP، Delphi 2010 - أحصل على القطع الأثرية، لذلك فإن XP ذات الصلة وغير ثابتة في D2010

يحرر:

عند إجراء مزيد من التحقيق - إذا قمت بسحب أيقونة حتى يدخل الماوس فقط مربع فقط (ولكن الرمز لا) ثم يتم رسم المربع بشكل صحيح، فهذا فقط عندما يدخل الأيقونة صندوق Paints الذي تحدثه القطع الأثرية.

أضفت رمز بحيث إذا كانت الدولة Dsdragmove، فسوف تجبر عملية إعادة رسم وهذا عملت، ولكنه عانى من وميض