TSmoothLabel verbessern

[CReber]

SirThornberry hatte letztens eine Unit bereitgestellt mit der man ein Label weichzeichnen kann. Leider funktioniert dieser nicht mit ScanLines, sodass der Code sehr langsam ist. Nun gibt es ja im Forum genug Codes mit ScanLines die alle mit Bitmaps funktionieren. Weiß jemand wie man die Codes auf Labels anwenden kann? Ich hab leider keine Ahnung von grafischen Sachen und auch wenig Lust mich da einzudenken ;)

http://www.delphipraxis.net/internal...ct.php?t=10043
http://www.delphipraxis.net/internal...ct.php?t=24623
http://www.delphipraxis.net/internal...ct.php?t=14072

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 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.

[CReber]

*push it to the moon ;)

[mytar]

Könntest du ein Bild anhängen wie das mit TLabel und TSmoothedLabel aussieht?

Danke

[toms]

Verschnellern könnte es man mit Bitblt

[CReber]

Screenshot added..

[Kernel32.DLL]

och, sieht ja ganz nett aus...

*download*

[CReber]

das soll nur schneller sein ;)