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

[Luckie]

Warum wird das nicht von TLabel abgeleitet und einfach das OnPaint-Ereignis usw. überschrieben?

[fkerber]

Hi!

Also etwa so?

Delphi-Quellcode:

unit uUnicodeLabel;

interface 

uses
  windows, graphics, classes, controls, StdCtrls; 

type
  TUnicodeLabel = class(TLabel)
  strict private
    fCaption: WideString;
    procedure SetCaption(ACaption: WideString);
  published
  public 
    constructor Create(AOwner: TComponent); override; 
    destructor Destroy(); override; 

    procedure Paint(); override; 
  published 
    property Align;
    property Alignment 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 default tlTop;
    property Margins; 
    property ParentColor; 
    property ParentFont; 
    property ParentShowHint; 
    property ShowHint; 
    property Transparent default True;
    property WordWrap default False;
  end;

implementation 

{ TUnicodeLabel } 

constructor TUnicodeLabel.Create(AOwner: TComponent); 
begin
  inherited Create(AOwner);
  ControlStyle := ControlStyle + [csSetCaption];
  AutoSize      := True;
  fCaption      := '';

  Alignment    := taLeftJustify;
  Layout       := tlTop;
  Transparent  := True;
  WordWrap     := 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;  
  
  lFormat := 0;
  case Alignment of
    taLeftJustify : lFormat := lFormat or DT_LEFT;
    taRightJustify: lFormat := lFormat or DT_RIGHT;
    taCenter      : lFormat := lFormat or DT_CENTER;
  end;

  if WordWrap 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 (Layout <> tlTop) then
  begin 
    if (Layout = 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.SetCaption(ACaption: WideString);
begin
  fCaption := ACaption;
  Invalidate();
end;



end.

[BenjaminH]

Zitat von CalganX:

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

Wenn man wie Luckie es vorschlägt und fkerber es dann macht, dann müsste man das doch auch als Class helper machen können, oder? Für die die nur Turbo Delphi Explorer haben und trotzdem im Designer damit basteln wollen.

[SirThornberry]

ableiten ginge auch. Aber ich halte nix davon properties nur zu verdecken. Denn wenn man dann auf eine Vorgängerklasse püft und castet wird ja das falsche property gesetzt was keine Auswirkung hat.

[fkerber]

Hi!

@SirT:
Was meinst du mit verdecken bzw. dem Posting im Allgemeinen? Ich habe da nicht so den "Mega"-Durchblick, weswegen ich die Sache oben quasi "zur Diskussion" stelle

Die Teile, die jetzt weggefallen sind, haben doch mit der Tatsache, dass das Label jetzt Unicode kann, nicht zu tun gehabt, oder?


Ciao, Frederic

[SirThornberry]

mit verdecken meinte ich das ein bereits vorhandenes Property neu definiert wird und damit das alte überdeckt (aber eben nicht überschreibt was eben nur bei Methoden geht)
property Caption: WideString read fCaption write SetCaption; wenn man jetzt irgendwo im Quelltext folgende Zeile drin hat:

Delphi-Quellcode:

if (Control is TLabel) then
  TLabel(Control).Caption := 'irgendwas';

wundert man sich warum das Label trotzdem nicht die Caption ändert. Irgendwann bekommt man mit das es daran liegt dass, das Property "Caption" nur überdeckt wurde und fasst sich an den Kopf wer sowas gemacht hat.
Aus diesem Grund bin ich kein Fan vom überdecken von Properties. In diesem speziellen Fall könnte man noch etwas retten in dem man das Originale SetCaption vom Label überschreibt und in der überschriebenen Methode die Unicodecaption setzt. Ansonsten kann man wirklich Stunden bis Tage mit der Suche nach einem Fehler verbringen und wundert sich das ein Label seine Caption nicht ändert obwohl man das Property setzt.

[fkerber]

Hi!

Ich muss das hier jetzt nochmal "aufwärmen".
Besteht dieses Problem mit dem "aufgrund von Überdeckung ändert sich die Caption nicht" nur, wenn man

Delphi-Quellcode:

if (Control is TLabel) then
  TLabel(Control).Caption := 'irgendwas';

schreibt oder auch, wenn man

Delphi-Quellcode:

if (Control is TUnicodeLabel) then
  TUnicodeLabel(Control).Caption := 'irgendwas';

schreibt?

Wenn in letzterem Fall alles richtig funktioniert, fände ich persönlich das gar nicht weiter tragisch - oder was meint ihr?


Grüße, Frederic

[himitsu]

Ich hatte mit damals (vor Verwendung der TNTs) einfach die Zeichenroutine überschrieben und dort das "Ansi" nut UTF8-Decodiert.

Somit mußte .Caption nicht überschrieben werden.