AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Thema durchsuchen
Ansicht
Themen-Optionen

Unicode-Label implementieren

Ein Thema von CalganX · begonnen am 7. Aug 2007 · letzter Beitrag vom 15. Jan 2010
 
Benutzerbild von fkerber
fkerber
(CodeLib-Manager)

Registriert seit: 9. Jul 2003
Ort: Ensdorf
6.723 Beiträge
 
Delphi XE Professional
 
#3

Re: Unicode-Label implementieren

  Alt 8. Sep 2007, 09:58
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.
Frederic Kerber
  Mit Zitat antworten Zitat
 


Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 12:46 Uhr.
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz