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;