Label Weichzeichnen

[SirThornberry]

so, da es nicht so schwer war hab ichs mal schnell geproogt. Einfach den gesamten Quelltext als "usmoothlabel.pas" speichern. Musst den Quelltext gegebenfalls anpassen damit alles wie beim normalen Label funktioniert. Man kann das ganze auch einfach von TGraphicControl ableiten und dann braucht man nur "Font" und "Caption" unter published hinzufügen, das reicht eigentlich auch. (quelltext diesbezüglich gleich mal geändert)

Delphi-Quellcode:

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 Font;
    property Caption read FGetCaption write FSetCaption;
    property Smoothfactor: Byte read fSmoothFactor write FSetSmoothfactor default 2;
  end;

implementation

procedure Antialiasing(const DC: TCanvas; const Rectangle: TRect);
type
  TRGBTripleArray = array[0..32768] of TRGBTriple;
  // 32768 = maximale Anzahl der Pixel in der Breite eines Bildes (also eine "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;
    Invalidate;
  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;
    Invalidate;
  end;
end;


end.