unit USmoothLabel;
interface
uses
Windows, Classes, Controls, Graphics;
type
TSmoothLabel =
class(TGraphicControl)
private
fSmoothFactor: Byte;
function FGetCaption: TCaption;
procedure FSetCaption(
const Value: TCaption);
procedure FSetSmoothfactor(AValue: Byte);
public
constructor Create(AOwner: TComponent);
override;
procedure Paint;
override;
published
property Caption
read FGetCaption
write FSetCaption;
property Font;
property Smoothfactor: Byte
read fSmoothFactor
write FSetSmoothfactor
default 2;
end;
procedure Register;
implementation
procedure Antialiasing(
const DC: TCanvas;
const Rectangle: TRect);
type TRGBTripleArray =
array[0..32768]
of TRGBTriple;
// MaxWidth of ScanLine
pRGBTripleArray = ^TRGBTripleArray;
// Pointer auf TRGBTripleArray
var cx, cy : Smallint;
r, g, b : Byte;
Row1 : pRGBTripleArray;
Row2 : pRGBTripleArray;
Row3 : pRGBTripleArray;
TEMP : TBitmap;
CurRect : TRect;
begin
TEMP := TBitmap.Create;
try
with TEMP
do begin
Width := Rectangle.Right - Rectangle.Left;
Height := Rectangle.Bottom - Rectangle.Top;
CurRect := Rect(0, 0, Width, Height);
PixelFormat := pf24Bit;
Canvas.CopyRect(CurRect,
DC, Rectangle);
with Canvas
do begin
for cy := 1
to (Height - 2)
do begin
Row1 := ScanLine[cy - 1];
Row2 := ScanLine[cy];
Row3 := ScanLine[cy + 1];
for cx := 1
to (Width - 2)
do begin
r := (Row1[cx - 1].rgbtRed+Row1[cx].rgbtRed+
Row1[cx + 1].rgbtRed+
Row2[cx - 1].rgbtRed+
Row2[cx + 1].rgbtRed+
Row2[cx - 1].rgbtRed+
Row3[cx].rgbtRed+
Row3[cx + 1].rgbtRed+
Row3[cx].rgbtRed)
div 9;
g := (Row1[cx - 1].rgbtGreen+
Row1[cx].rgbtGreen+
Row1[cx + 1].rgbtGreen+
Row2[cx - 1].rgbtGreen+
Row2[cx + 1].rgbtGreen+
Row2[cx - 1].rgbtGreen+
Row3[cx].rgbtGreen+
Row3[cx + 1].rgbtGreen+
Row3[cx].rgbtGreen)
div 9;
b := (Row1[cx - 1].rgbtBlue+
Row1[cx].rgbtBlue+
Row1[cx + 1].rgbtBlue+
Row2[cx - 1].rgbtBlue+
Row2[cx + 1].rgbtBlue+
Row2[cx - 1].rgbtBlue+
Row3[cx].rgbtBlue+
Row3[cx + 1].rgbtBlue+
Row3[cx].rgbtBlue)
div 9;
Row2[cx].rgbtBlue := b;
Row2[cx].rgbtGreen := g;
Row2[cx].rgbtRed := r;
end;
end;
end;
DC.CopyRect(Rectangle, Canvas, CurRect);
end;
finally
TEMP.Free;
end;
end;
constructor TSmoothlabel.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
fSmoothFactor := 2;
SetBounds(Left, Top, 100, 25);
end;
function GetBlendColor(Basecolor: TColor; Blendcolor: TColor; BlendIntensity: Byte=127): TColor;
type TMyColor =
record
red : Byte;
green : Byte;
blue : Byte;
end;
var LF1, LF2 : TMyColor;
begin
LF1.red := GetRValue(Basecolor);
LF1.green := GetGValue(Basecolor);
LF1.blue := GetBValue(Basecolor);
LF2.red := (LF1.red * (255-BlendIntensity) + GetRValue(Blendcolor) * BlendIntensity)
div 255;
// + helligkeit) / 2, 255);
LF2.green := (LF1.green * (255-BlendIntensity) + GetGValue(Blendcolor) * BlendIntensity)
div 255;
// + helligkeit) / 2, 255);
LF2.blue := (LF1.blue * (255-BlendIntensity) + GetBValue(Blendcolor) * BlendIntensity)
div 255;
// + helligkeit) / 2, 255);
Result :=
rgb(LF2.red, LF2.green, LF2.blue);
end;
procedure TSmoothlabel.Paint;
var LTmpPic : TBitmap;
LCountX, LCountY : Integer;
LColor, LFontColor : TColor;
begin
LTmpPic := TBitmap.Create;
LTmpPic.PixelFormat := pf8bit;
LTmpPic.Width := Width * fSmoothFactor;
LTmpPic.Height := Height * fSmoothFactor;
LTmpPic.Canvas.Font.Assign(Font);
LTmpPic.Canvas.Font.Color := clBlack;
LTmpPic.Canvas.Font.Height := LTmpPic.Canvas.Font.Height * fSmoothFactor;
LTmpPic.Canvas.TextOut(0, 0, Caption);
Antialiasing(LTmpPic.Canvas, Rect(0, 0, LTmpPic.Width, LTmpPic.Height));
LTmpPic.Canvas.StretchDraw(Rect(0, 0, Width, Height), LTmpPic);
LFontColor := Font.Color;
for LCountY := 0
to Height - 1
do begin
for LCountX := 0
to Width - 1
do begin
LColor := GetBlendColor(LFontColor, GetPixel(Canvas.Handle, LCountX, LCountY), GetRValue(GetPixel(LTmpPic.Canvas.Handle, LCountX, LCountY)));
SetPixel(Canvas.Handle, LCountX, LCountY, LColor);
end;
end;
LTmpPic.Free;
end;
function TSmoothlabel.FGetCaption: TCaption;
begin
Result :=
inherited Caption;
end;
procedure TSmoothlabel.FSetCaption(
const Value: TCaption);
begin
if Value <> Caption
then
begin
inherited Caption := Value;
Repaint;
end;
end;
procedure TSmoothlabel.FSetSmoothfactor(AValue: Byte);
begin
if AValue < 1
then
AValue := 1
else if AValue > 5
then
AValue := 5;
if AValue <> fSmoothFactor
then begin
fSmoothFactor := AValue;
Repaint;
end;
end;
procedure Register;
begin
RegisterComponents('
Zusätzlich', [TSmoothLabel]);
end;
end.