Pintura TPaintBox durante Drag & Drop com dragImage
-
19-09-2019 - |
Pergunta
Na minha aplicação (Delphi 2007) eu quero arrastar itens de um ListView para um PaintBox e áreas de destaque correspondente em manipulador OnPaint do PaintBox. No entanto, eu sempre obter artefactos feios. Você tem algum conselho como posso me livrar deles?
projeto de teste: Apenas criar uma nova aplicação VCL e substituir o código no Unit1.pas com o seguinte. Em seguida, iniciar os itens de aplicativos e lista arraste sobre o retângulo na 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.
Editar: Aqui está uma imagem da falha: dragImage artefato http://img269.imageshack.us/img269/6535/15778780.png
Eu espero ver o retângulo azul completo com borda grossa. No entanto sob a imagem de arrasto pode ver o retângulo realçada-un.
Editar 2: Este site fala sobre "Questões pintura":
As notas ImageList SDK que quando desenho a imagem de arrastar você pode obter problemas com atualizações ou pintura de tela a menos que você use o ImageList_DragLeave função da API para ocultar a imagem de arrastar enquanto ocorre a pintura (que é o que o método HideDragImage na classe faz). Infelizmente, se você não possui o controle que está sendo pintado fazendo isso não é realmente uma opção.
Eu não tenho o problema mencionado na última frase. No entanto, eu não era capaz de encontrar o lugar certo eo imagelist direito (é não ImageList1 no meu projeto de teste - provavelmente ListView1.GetDragImages). Chamá ImageList_DragLeave
Solução
A chave é para ocultar a imagem de arrastar antes da caixa de tinta é redesenhado, e mostrá-la novamente depois disso. Se você substituir este código na sua pergunta:
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;
com este
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;
ele deve funcionar. Bem, ele faz para mim com Delphi 2007 no Windows XP de 64 bits.
E elogios para o código de demonstração na sua pergunta, excelente maneira de deixar-nos ver o problema.
Outras dicas
Testado em XP, Delphi 2010 - Recebo os artefatos, por isso é XP relacionado e não fixo na D2010
Editar:
Ao investigar mais - se você arrastar um ícone para que o mouse apenas entra na caixa (mas o ícone não faz), em seguida, a caixa é desenhado corretamente, é apenas quando o ícone entra no paintbox que os artefatos ocorrer.
Eu adicionei código para que se o estado foi dsDragMove então seria forçar um repaint e isso funcionou, mas sofria de cintilação