Unicode-Label implementieren

[CalganX]

SirThornberry zeigt hier, wie man ein Label implementiert, das auch Unicode-Zeichen darstellen kann.

Delphi-Quellcode:

unit uUnicodeLabel;

interface

uses
  windows, graphics, classes, controls, StdCtrls;

type
  TUnicodeLabel = class(TGraphicControl)
  strict private
    fAlignment    : TAlignment;
    fCaption      : WideString;
    fLayout       : TTextLayout;
    fTransparent  : Boolean;
    fWordWrap     : Boolean;
    procedure SetAlignment(AValue: TAlignment);
    procedure SetCaption(ACaption: WideString);
    procedure SetLayout(AValue: TTextLayout);
    procedure SetTransparent(AValue: Boolean);
    procedure SetWordWrap(AValue: Boolean);
  published
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy(); override;

    procedure Paint(); override;
  published
    property Align;
    property Alignment: TAlignment read fAlignment write SetAlignment default taLeftJustify;
    property Anchors;
    property AutoSize default True;
    property Caption: WideString read fCaption write SetCaption;
    property Color;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Font;
    property HelpContext;
    property HelpKeyword;
    property HelpType;
    property Hint;
    property Layout: TTextLayout read fLayout write SetLayout default tlTop;
    property Margins;
    property ParentColor;
    property ParentFont;
    property ParentShowHint;
    property ShowHint;
    property Transparent: Boolean read fTransparent write SetTransparent default True;
    property WordWrap: Boolean read fWordWrap write SetWordWrap default False;
  end;

implementation

{ TPSUnicodeLabel }

constructor TUnicodeLabel.Create(AOwner: TComponent);
var
  lStyle  : TControlStyle;
begin
  inherited Create(AOwner);
  lStyle := ControlStyle;
  Include(lStyle, csSetCaption);
  ControlStyle := lStyle;

  AutoSize      := True;
  fCaption      := '';
  fAlignment    := taLeftJustify;
  fLayout       := tlTop;
  fTransparent  := True;
  fWordWrap     := True;
end;

destructor TUnicodeLabel.Destroy;
begin

  inherited Destroy();
end;

procedure TUnicodeLabel.Paint;
var
  lFormat : Cardinal;
  lRect,
  lRect2  : TRect;
  lSize   : TSize;
begin
  Canvas.Font.Assign(Font);

  if Transparent then
    Canvas.Brush.Style := bsClear
  else
  begin
    Canvas.Brush.Color := Color;
    Canvas.FillRect(Rect(0, 0, Width, Height));
  end; 
 
  //TextOutW(Canvas.Handle, 0, 0, @fCaption[1], Length(fCaption));
  lFormat := 0;
  case fAlignment of
    taLeftJustify : lFormat := lFormat or DT_LEFT;
    taRightJustify: lFormat := lFormat or DT_RIGHT;
    taCenter      : lFormat := lFormat or DT_CENTER;
  end;

  if fWordWrap then
    lFormat := lFormat or DT_WORDBREAK;

  lRect   := Rect(0, 0, Width, Height);

  lRect2 := lRect;
  DrawTextW(Canvas.Handle, @fCaption[1], Length(fCaption), lRect2, lFormat or DT_CALCRECT);
  if (fLayout <> tlTop) then
  begin
    if (fLayout = tlBottom) then
    begin
      lRect.Top     := Height - (lRect2.Bottom - lRect2.Top);
      lRect.Bottom  := Height;
    end
    else
    begin
      lRect.Top     := (Height - (lRect2.Bottom - lRect2.Top)) div 2;
      lRect.Bottom  := lRect.Top + (lRect2.Bottom - lRect2.Top);
    end;
  end;
 

  DrawTextW(Canvas.Handle, @fCaption[1], Length(fCaption), lRect, lFormat);

  if AutoSize and (caption <> '') then
  begin
    lSize.cx := lRect2.Right - lRect2.Left;
    lSize.cy := lRect2.Bottom - lRect2.Top;
    if (lSize.cx <> Width) or (lSize.cy <> Height) then
    begin
      SetBounds(Left, Top, lSize.cx, lSize.cy);
      Invalidate();
    end;
  end;
end;

procedure TUnicodeLabel.SetAlignment(AValue: TAlignment);
begin
  if (AValue <> fAlignment) then
  begin
    fAlignment  := AValue;
    Invalidate();
  end;
end;

procedure TUnicodeLabel.SetCaption(ACaption: WideString);
begin
  fCaption := ACaption;
  Invalidate();
end;

procedure TUnicodeLabel.SetLayout(AValue: TTextLayout);
begin
  if (AValue <> fLayout) then
  begin
    fLayout := AValue;
    Invalidate();
  end;
end;

procedure TUnicodeLabel.SetTransparent(AValue: Boolean);
begin
  if (AValue <> fTransparent) then
  begin
    fTransparent := AValue;
    Invalidate();
  end;
end;

procedure TUnicodeLabel.SetWordWrap(AValue: Boolean);
begin
  if (AValue <> fWordWrap) then
  begin
    fWordWrap := AValue;
    Invalidate();
  end;
end;

end.

Zur Verwendung kann entweder die Komponente als solche installiert werden, oder alternativ mit Hilfe von z.B. der GExperts ein vorhandenes Label ersetzt werden (Klassennamen in der PAS- und der DFM-Datei ersetzen).