Delphi: TImage などの画像のちらつきを抑える

現象概要

Before

After

対策

以下、いずれかがあります。

DoubleBuffered := True;

Form1.DoubleBuffered:=True;

WMEraseBkgnd, WMPaint

type
  TForm1 = class(TForm)
  private
    procedure WMEraseBkgnd(var Message: TWMEraseBkgnd);
                               message WM_ERASEBKGND;
    procedure WMPaint(var Message: TWMPaint);
                               message WM_PAINT;
  end;

procedure TForm1.WMEraseBkgnd(var Message: TWMEraseBkgnd);
begin
// do nothing
end;

procedure TForm1.WMPaint(var Message: TWMPaint);
var
  PS: TPaintStruct;
  w, h: Integer;
  DC: HDC;
  bmp, bmpOld: HBITMAP;
  i, Count, SaveDCIndex: Integer;
begin
  if Message.DC <> 0 then
    inherited
  else
  begin
    BeginPaint(Handle, PS);
    try
      w := PS.rcPaint.Right - PS.rcPaint.Left;
      h := PS.rcPaint.Bottom - PS.rcPaint.Top;
      DC := GetDC(HWND(0));
      bmp := CreateCompatibleBitmap(DC, w, h);
      ReleaseDC(HWND(0), DC);
      try
        Message.DC := CreateCompatibleDC(HDC(0));
        with PS do
        try
          bmpOld := SelectObject(Message.DC, bmp);

          with rcPaint do
            SetWindowOrgEx(Message.DC, Left, Top, nil);
          FillRect(Message.DC, rcPaint, Brush.Handle);

          Count := ControlCount;
          for i := 0 to Count - 1 do
          begin
            if Controls[i] is TWinControl then break;
            with Controls[i] do
            begin
              if Visible and RectVisible(hdc, BoundsRect) then
              begin
                SaveDCIndex := SaveDC(Message.DC);
                OffsetWindowOrgEx(Message.DC, -Left, -Top, 
PPoint(0)^);
                IntersectClipRect(Message.DC, 0, 0, Width, Height);
                Perform(WM_PAINT, Message.DC, 0);
                RestoreDC(Message.DC, SaveDCIndex);
              end;
            end;
          end;

          BitBlt(hdc, rcPaint.Left, rcPaint.Top, w, h,
              Message.DC, rcPaint.Left, rcPaint.Top, SRCCOPY);

          SelectObject(Message.DC, bmpOld);
        finally
          DeleteDC(Message.DC);
          Message.DC := 0;
        end;
      finally
        DeleteObject(bmp);
      end;
    finally
      EndPaint(Handle, PS);
    end;
  end;
end;

参考にしたサイト

DoubleBuffered によりメモリ使用量は増えるという話。

以上です。