Image严重闪烁的问题?

Question

我用一个Panel,里面放置了一个PaintBox绘制网格
上面放置了一个可以拖动,拉大,拉小的Image
可是当我拖动和拉动Image时,Image闪烁的很严重,有什么好的方法不闪烁?
Panel.doulbedbuffer设置TURE我试过不关用,还有WMEraseBkGnd该怎么用TFORM1.WMEraseBkGnd这样不管用?

Answer 1

办法一，在主窗口的Canvas上直接画
二,改写控件，因为继承自TGraphicControl的控件都是有这种闪烁问题，下面的控件就可以完美解决这个问题：
unit FFPBox;
{=======================================================}
interface
{=======================================================}
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls;type
  TFFPaintEvent  = procedure (Sender: TObject; Canvas: TCanvas) of Object;  TFlickerFreePaintBox = class(TCustomControl)
  private
    { Private declarations }
    FOnFFPaint:TFFPaintEvent;
  protected
    { Protected declarations }
    procedure Paint; override;
    procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
  published
    { Published declarations }
    property OnPaint:TFFPaintEvent read FOnFFPaint write FOnFFPaint;
    property Canvas;
    property Align;
    property Color;
    property DragCursor;
    property DragMode;
    property Enabled;
    property Font;
    property ParentColor;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property Visible;
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnStartDrag;
  end;procedure Register;
{=======================================================}
implementation
{=======================================================}
constructor TFlickerFreePaintBox.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlStyle := [csAcceptsControls, csCaptureMouse, csClickEvents,
    csOpaque, csDoubleClicks, csReplicatable];
  TabStop := False;
end;
{-------------------------------------------------------}
procedure TFlickerFreePaintBox.Paint;
var bmp: TBitmap;
begin
  if csDesigning in ComponentState then
    with Canvas do
    begin
      Pen.Style := psDash;
      Brush.Style := bsSolid;
      Canvas.Brush.Color := Color;
      Rectangle(0, 0, Width, Height);
      exit;
    end;   bmp := TBitmap.Create;
   try
    bmp.Canvas.Brush.Color := Color;
    bmp.Width := Width;
    bmp.Height := Height;
    bmp.Canvas.Font := Font;
    if Assigned(FOnFFPaint) then begin
      FOnFFPaint(Self, bmp.Canvas);
      Canvas.Draw(0,0, bmp);
    end;
   finally
    bmp.Free;
   end;
end;
{-------------------------------------------------------}
{------------------------关键之处-----------------------}
procedure TFlickerFreePaintBox.WMEraseBkgnd(var Message: TWMEraseBkgnd);
begin
  Message.Result := 1;
end;
{=======================================================}
procedure Register;
begin
  RegisterComponents('System', [TFlickerFreePaintBox]);
end;end.

Answer 2

谢谢 xzhifei
我想问清楚点,我这个是应该应该重写Image控件还是PaintBox控件?
如要重写是PaintBox,是否可以拿你上面的直接来用?