TOPIC:

{
Copyright (C) 2015 Antônio Galvão

This is the file COPYING.modifiedLGPL, it applies to several units in the
Lazarus sources.

All files contain headers showing the appropriate license. See there if this
modification can be applied.

These files are distributed under the Library GNU General Public License
(see the file COPYING.LGPL) with the following modification:

As a special exception, the copyright holders of this library give you
permission to link this library with independent modules to produce an
executable, regardless of the license terms of these independent modules,
and to copy and distribute the resulting executable under terms of your choice,
provided that you also meet, for each linked independent module, the terms
and conditions of the license of that module. An independent module is a
module which is not derived from or based on this library. If you modify this
library, you may extend this exception to your version of the library, but
you are not obligated to do so. If you do not wish to do so, delete this
exception statement from your version.


If you didn't receive a copy of the file COPYING.LGPL, contact:
      Free Software Foundation, Inc.,
      675 Mass Ave
      Cambridge, MA  02139
      USA
}

unit JustifiedLabelUnit;

{$mode objfpc}{$H+}

interface

uses
  Windows, Classes, SysUtils, StdCtrls, Forms, Controls, Graphics, StrUtils,
  LazUTF8;

{ TJustifiedLabel }
type
  TJustifiedLabel = class(TCustomLabel)
  private
    FAutoSize,
    FAlreadyPainted,
    FWordWrap :boolean;
  protected
    procedure SetAutoSize(Value: Boolean); override;
  public
    constructor Create(TheOwner: TComponent); override;
    procedure Loaded; override;
    procedure Paint; override;
    {Makes WordWrap property inaccessible}
    property WordWrap: boolean read FWordWrap write FWordWrap default False;
  published
    property Align;
    //property Alignment;
    property Anchors;
    property AutoSize: Boolean read FAutoSize write SetAutoSize;
    property BidiMode;
    //property BorderSpacing;
    property Caption;
    property Color;
    property Constraints;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property FocusControl;
    property Font;
    //property Layout;
    property ParentBidiMode;
    property ParentColor;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowAccelChar;
    property ShowHint;
    property Transparent;
    property Visible;
    property OnChangeBounds;
    property OnClick;
    property OnContextPopup;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnMouseDown;
    property OnMouseEnter;
    property OnMouseLeave;
    property OnMouseMove;
    property OnMouseUp;
    property OnMouseWheel;
    property OnMouseWheelDown;
    property OnMouseWheelUp;
    property OnResize;
    property OnStartDrag;
   // property OptimalFill;
  end;

  procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Natural', [TJustifiedLabel]);
end;

{ TJustifiedLabel }

procedure TJustifiedLabel.Paint;
var
  R : TRect;
  TextLeft: integer = 0;
  TextTop: integer = 0;
  LabelText: string;
  OldFontColor: TColor;
  NumberOfLines :Integer = 0;
  i :Integer;
  Extra :Integer;
  Blanks :Integer;
  LastLineEndingChar :Char;
  ALine :String;
  Cols :Integer;
  AverageCharWidth :Integer;
  s: TCaption;
  ByteSet: set of byte = [];
  s1: String;
  WrappedText :String;

  procedure BeSureFontIsValid;
  begin
    Self.Canvas.Font.Name := 'Tahoma';
  end;

  procedure AdjustHeight;
  begin
    if NumberOfLines > 0 then
      Self.Height := NumberOfLines * Canvas.TextHeight('A');
  end;

  procedure MarkParagraphEndings;
  begin
    s := LabelText;
    i := 0;
    while Pos(LineEnding, S) > 0 do
    begin
      s1 := Trim(Copy2SymbDel(s, LineEnding[Length(LineEnding)]));
      if Trim(s1) = '' then
        if not (i in ByteSet) then
          Include(ByteSet, i);
      Inc(i);
    end;
  end;

  procedure AdjustInitialWidth;
  begin
    // Adjust the width for the initial caption
    if not FAlreadyPainted and (csDesigning in ComponentState)
      and (Pos(#32, Caption) = 0) then
    begin
      FAlreadyPainted := True;

      // The inherited SetAutosize cannot be called from Create or Loaded.
      if Self.Width < Canvas.TextWidth(Caption) then
        inherited SetAutoSize(True);
    end
    else
      inherited SetAutoSize(False);
  end;

  procedure DrawInitialCaption;
  begin
    if not Enabled then
    begin
      Self.Canvas.Font.Color := clBtnHighlight;
      Self.Canvas.TextOut(1, 1, LabelText);
      Self.Canvas.Font.Color := clBtnShadow;
    end;
    Self.Canvas.TextOut(0, 0, LabelText);
    Self.Canvas.Font.Color := OldFontColor;
    if FAutoSize then
      AdjustHeight;
  end;

begin
  if Self.Width < 40 then Exit;
  AdjustInitialWidth;
  BeSureFontIsValid;
  R := Rect(0,0,Self.Width,Self.Height);
  with Self.Canvas do
  begin
    Brush.Color := Self.Color;
    if (Color <> clNone) and not Transparent then
    begin
      Brush.Style := bsSolid;
      FillRect(R);
    end;
    Brush.Style := bsClear;
    Font := Self.Font;
    DoMeasureTextPosition(TextTop, TextLeft);
    OldFontColor := Canvas.Font.Color;
    LabelText := Trim(Caption);
    if Pos(#32, LabelText) = 0 then
    begin
      DrawInitialCaption;
      Exit;
    end;
    AverageCharWidth := (TextWidth(Caption) div UTF8Length(Caption));
    Cols := (Self.Width div (AverageCharWidth + 1));
    //if Cols > 0 then
        WrappedText := Trim(UTF8WrapText(Caption, Cols));
    LabelText := WrappedText;
    MarkParagraphEndings;
    if not IsEnabled then
    begin
      Self.Canvas.Font.Color := clBtnHighlight;
      NumberOfLines := 1 + (Length(LabelText) - Length(StringReplace(LabelText, LineEnding, '', [rfReplaceAll]))) div length(lineending);
      for i := 1 to NumberOfLines - 1 do
      begin
        LastLineEndingChar := LineEnding[Length(LineEnding)];
        ALine := Trim(Copy2SymbDel(labeltext, LastLineEndingChar));
        Extra := Self.Width - Canvas.TextWidth(ALine);
        Blanks := (UTF8Length(ALine) - UTF8Length(StringReplace(ALine, #32, '', [rfReplaceAll])));
        if not (i in ByteSet) then
          SetTextJustification(Canvas.Handle, Extra, Blanks);
        Canvas.TextOut(R.Left + TextLeft + 1, TextTop + 1 + R.Top + (i - 1) * Canvas.TextHeight('A'), aline);
        SetTextJustification(Canvas.Handle, 0, 0);
      end;
      ALine := Trim(Copy2SymbDel(labeltext, LastLineEndingChar));
      TextOut(R.Left + TextLeft + 1, TextTop + 1 + R.Top + (NumberOfLines - 1) * Canvas.TextHeight('A'), aline);
      Canvas.Font.Color := clBtnShadow;
    end;
    LabelText := WrappedText;
    NumberOfLines := 1 + (Length(LabelText) - Length(StringReplace(LabelText, LineEnding, '', [rfReplaceAll]))) div length(lineending);
    for i := 1 to NumberOfLines - 1 do
    begin
      LastLineEndingChar := LineEnding[Length(LineEnding)];
      ALine := Trim(Copy2SymbDel(labeltext, LastLineEndingChar));
      Extra := Self.Width - Canvas.TextWidth(ALine);
      Blanks := (UTF8Length(ALine) - UTF8Length(StringReplace(ALine, #32, '', [rfReplaceAll])));
      if not (i in ByteSet) then
          SetTextJustification(Canvas.Handle, Extra, Blanks);
      Canvas.TextOut(R.Left, R.Top + (i - 1) * Canvas.TextHeight('A'), ALine);
      SetTextJustification(Canvas.Handle, 0, 0);
    end;
    ALine := Trim(Copy2SymbDel(labeltext, LastLineEndingChar));
    Canvas.TextOut(R.Left, R.Top + (NumberOfLines - 1) * Canvas.TextHeight('A'), ALine);
    Canvas.Font.Color := OldFontColor;
  end;
  if FAutoSize then
    AdjustHeight;
end;

constructor TJustifiedLabel.Create(TheOwner :TComponent);
begin
  inherited Create(TheOwner);
  Canvas.Font.Name := 'Tahoma';
  FAutoSize := True;
end;

procedure TJustifiedLabel.Loaded;
begin
  inherited Loaded;
end;

procedure TJustifiedLabel.SetAutoSize(Value :Boolean);
var
  NumberOfLines :Integer;
  LabelText :TCaption;
begin
  if FAutoSize <> Value then
    FAutoSize := Value;
  if (Caption = '') or not FAutoSize then
    Exit;
  LabelText := Caption;
  NumberOfLines := 1 + (Length(LabelText) - Length(StringReplace(LabelText, LineEnding, '', [rfReplaceAll]))) div length(lineending);
  Self.Height := NumberOfLines * Canvas.TextHeight('A');
end;

end.