Delphi-PRAXiS

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   GUI-Design mit VCL / FireMonkey / Common Controls (https://www.delphipraxis.net/18-gui-design-mit-vcl-firemonkey-common-controls/)
-   -   Delphi Label Weichzeichnen (https://www.delphipraxis.net/38906-label-weichzeichnen.html)

CReber 25. Jan 2005 21:23


Label Weichzeichnen
 
Kennt jemand eine Komponente mit der man ein Label weichzeichnen kann? (AntiAliasing)

// mir würde auch ein Codeschnipsel reichen ;)


MfG

SirThornberry 25. Jan 2005 21:32

Re: Label Weichzeichnen
 
Ich kenn keine Solche Komponente aber es sollte nicht all zu schwer sein sich diese selbst zu schreiben

CReber 25. Jan 2005 21:51

Re: Label Weichzeichnen
 
Naja ich stelle mir das nicht so einfach vor... ;)

// Edit:

http://www.delphicity.net/catalogue/...ite/index.html

das habe ich gerade mal gefunden, aber leider funktioniert der download nimmer :/

SirThornberry 25. Jan 2005 22:02

Re: Label Weichzeichnen
 
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.


Alle Zeitangaben in WEZ +1. Es ist jetzt 21:49 Uhr.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz