Einzelnen Beitrag anzeigen

Benutzerbild von SirThornberry
SirThornberry
(Moderator)

Registriert seit: 23. Sep 2003
Ort: Bockwen
12.235 Beiträge
 
Delphi 2006 Professional
 
#26

Re: Alpha Zeichen auf Label machen

  Alt 28. Jun 2007, 14:40
die Ausgangsfrage betreffend hab ich mal fix ein label gebastelt welches Unicode 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.
Jens
Mit Source ist es wie mit Kunst - Hauptsache der Künstler versteht's
  Mit Zitat antworten Zitat