Gedimmten Hintergrund im Canvas schneller

[Nic2012]

Jo, mit Scanline geht das viel schneller, selbst im Designmodus kein Flackern mehr, Voraussetzung fürs Scanlinen ein temp. Bitmap:

Code:

procedure TExtShape.Paint;
  const
    Delta = 0.80;
  function ColorDimmed(Color: TColor): TColor;
  begin
    Color := ColorToRGB(Color);
    Result := RGB(Round(GetRValue(Color) * Delta),
                  Round(GetGValue(Color) * Delta),
                  Round(GetBValue(Color) * Delta));
  end;
type
  TRGB32 = packed record
    B, G, R, A: Byte;
  end;
  TRGB32Array = packed array[0..MaxInt div SizeOf(TRGB32)-1] of TRGB32; 
  PRGB32Array = ^TRGB32Array;
var
  y, x: Integer;
  b: Graphics.TBitmap;
  Source: TRect;
  Dest: TRect;
  Row: PRGB32Array;
begin
  if FIsDimmed then begin

    b := Graphics.TBitmap.Create;
    try
      b.PixelFormat := pf32bit;
      b.Width := Width;
      b.Height := Height;

      Dest := Rect(0, 0, b.Width, b.Height);
      Source := Rect(0, 0, Width, Height);

      b.Canvas.CopyRect(Dest, Canvas, Source);

      for Y := 0 to Height -1 do begin
        Row := b.Scanline[Y];
        for X := 0 to Width -1 do begin
          Row^[X].R := Round(Row^[X].R * Delta);
          Row^[X].G := Round(Row^[X].G * Delta);
          Row^[X].B := Round(Row^[X].B * Delta);
        end;
      end;

      Canvas.CopyRect(Source, b.Canvas, Dest);

    finally
       b.Free;
    end;

    {
    for Y := 0 to Height -1 do
      for X := 0 to Width -1 do
        SetPixelV( Canvas.Handle, X, Y, ColorDimmed(GetPixel(Canvas.Handle, X, Y)));
    }
  end;

  inherited Paint;

  Canvas.Font := Font;
  Canvas.TextOut((Width - Canvas.TextWidth(Caption)) div 2, (Height - Canvas.TextHeight(Caption)) div 2, Caption);
end;