{-----------------------------------------------------------------------------
The contents of this file are subject to the Mozilla Public License
Version 1.1 (the "License"); you may not use this file except in compliance
with the License. You may obtain a copy of the License at
http://www.mozilla.org/MPL/MPL-1.1.html

Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
the specific language governing rights and limitations under the License.

The Original Code is: JvgLabel.PAS, released on 2003-01-15.

The Initial Developer of the Original Code is Andrey V. Chudin,  [chudin att yandex dott ru]
Portions created by Andrey V. Chudin are Copyright (C) 2003 Andrey V. Chudin.
All Rights Reserved.

Contributor(s):
Michael Beck [mbeck att bigfoot dott com].

You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
located at http://jvcl.sourceforge.net

Known Issues:
-----------------------------------------------------------------------------}
// $Id: JvgLabel.pas 10612 2006-05-19 19:04:09Z jfudickar $

unit JvgLabel;

{$I jvcl.inc}
{$I windowsonly.inc} // (ahuser) uses WndProc and Wnd hooks

interface

uses
  {$IFDEF USEJVCL}
  {$IFDEF UNITVERSIONING}
  JclUnitVersioning,
  {$ENDIF UNITVERSIONING}
  {$ENDIF USEJVCL}
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls,
  {$IFDEF USEJVCL}
  JvComponent,
  {$ENDIF USEJVCL}
  JvgTypes, JvgCommClasses, JvgUtils;

const
  FTextAlign = DT_LEFT or DT_SINGLELINE;
  RadianEscapments: array [TglLabelDir] of Integer = (0, -1800, -900, 900);

type
  TFontWeight = (fwDONTCARE, fwTHIN, fwEXTRALIGHT, fwLIGHT, fwNORMAL, fwMEDIUM,
    fwSEMIBOLD, fwBOLD, fwEXTRABOLD, fwHEAVY);

  {$IFDEF USEJVCL}
  TJvgCustomLabel = class(TJvGraphicControl)
  {$ELSE}
  TJvgCustomLabel = class(TGraphicControl)
  {$ENDIF USEJVCL}
  private
    FAutoSize: Boolean;
    FFocusControl: TWinControl;
    FFocusControlMethod: TFocusControlMethod;
    FTransparent: Boolean;
    FPrevWndProc: Pointer;
    FNewWndProc: Pointer;
    procedure SetFocusControl(Value: TWinControl);
    procedure SetTransparent(Value: Boolean);
    procedure WMLMouseUp(var Msg: TMessage); message WM_LBUTTONUP;
    procedure WMLMouseDown(var Msg: TMessage); message WM_LBUTTONDOWN;
  protected
    FActiveNow: Boolean;
    FShowAsActiveWhileControlFocused: Boolean;
    ActiveWhileControlFocused: Boolean;
    FNeedRehookFocusControl: Boolean;
    FExternalCanvas: TCanvas;
    procedure HookFocusControlWndProc;
    procedure UnhookFocusControlWndProc;
    procedure FocusControlWndHookProc(var Msg: TMessage);
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    {$IFDEF USEJVCL}
    procedure MouseEnter(Control: TControl); override;
    procedure TextChanged; override;
    {$ENDIF USEJVCL}

    property AutoSize: Boolean read FAutoSize write FAutoSize default True;
    property FocusControl: TWinControl read FFocusControl write SetFocusControl;
    property FocusControlMethod: TFocusControlMethod read FFocusControlMethod
      write FFocusControlMethod default fcmOnMouseDown;
    property Transparent: Boolean read FTransparent write SetTransparent default True;
    property ExternalCanvas: TCanvas read FExternalCanvas write FExternalCanvas;
    procedure Paint; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  end;

  TJvgLabel = class(TJvgCustomLabel)
  private
    FDirection: TglLabelDir;
    FTextStyles: TJvgLabelTextStyles;
    FColors: TJvgLabelColors;
    FFontWeight: TFontWeight;
    // FActiveTextColor: TColor;
    FOptions: TglLabelOptions;
    FSupressPaint: Boolean;
    FGradient: TJvgGradient;
    FIllumination: TJvgIllumination;
    FTexture: TBitmap;
    FBackground: TBitmap;
    FTextureImage: TImage;
    FBackgroundImage: TImage;
    FAlignment: TAlignment;
    FUFontWeight: Word;
    FRunOnce: Boolean;
    FFirstCreate: Boolean;
    FNeedUpdateOnlyMainText: Boolean;
    FNeedRemakeTextureMask: Boolean;
    FImg: TBitmap;
    FTextureMask: TBitmap;
    FBackgroundBmp: TBitmap;
    FTextureBmp: TBitmap;
    FTargetCanvas: TCanvas;
    procedure SetDirection(Value: TglLabelDir);
    procedure SetFontWeight(Value: TFontWeight);
    procedure SetOptions(Value: TglLabelOptions);
    procedure SetTexture(Value: TBitmap);
    procedure SetBackground(Value: TBitmap);
    function GetTexture: TBitmap;
    function GetBackground: TBitmap;
    procedure SetTextureImage(Value: TImage);
    procedure SetBackgroundImage(Value: TImage);
    procedure SetAlignment(Value: TAlignment);
    procedure OnGradientChanged(Sender: TObject);
    procedure OnIlluminationChanged(Sender: TObject);
    procedure CreateLabelFont;
    procedure InvalidateLabel(UpdateBackgr: Boolean);
  protected
    {$IFDEF USEJVCL}
    procedure MouseEnter(Control: TControl); override;
    procedure MouseLeave(Control: TControl); override;
    procedure FontChanged; override;
    {$ENDIF USEJVCL}
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure Loaded; override;
  public
    FreeFont: TFont;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Paint; override;
    property SupressPaint: Boolean read FSupressPaint write FSupressPaint;
    property Canvas;
    property ExternalCanvas;
  published
    property Anchors;
    property Align;
    property Caption;
    property DragCursor;
    property DragMode;
    property Enabled;
    property Font;
    property ParentColor;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    //    property ShowAccelChar;
    property ShowHint;
    property Visible;
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnStartDrag;
    {$IFDEF USEJVCL}
    property OnMouseEnter;
    property OnMouseLeave;
    {$ENDIF USEJVCL}
    property FocusControl;
    property FocusControlMethod;
    property AutoSize;
    property Transparent;
    property Direction: TglLabelDir read FDirection write SetDirection  default fldLeftRight;
    property TextStyles: TJvgLabelTextStyles read FTextStyles write FTextStyles;
    property Colors: TJvgLabelColors read FColors write FColors;
    property FontWeight: TFontWeight read FFontWeight write SetFontWeight;
    property Options: TglLabelOptions read FOptions write SetOptions;
    property Gradient: TJvgGradient read FGradient write FGradient;
    property Illumination: TJvgIllumination read FIllumination write FIllumination;
    property Texture: TBitmap read GetTexture write SetTexture;
    property Background: TBitmap read GetBackground write SetBackground;
    property TextureImage: TImage read FTextureImage write SetTextureImage;
    property BackgroundImage: TImage read FBackgroundImage write SetBackgroundImage;
    property Alignment: TAlignment read FAlignment write SetAlignment;
  end;

  TJvgStaticTextLabel = class(TJvgCustomLabel)
  private
    FActiveColor: TColor;
    FAlignment: TglAlignment;
    FOptions: TglStaticTextOptions;
    FWordWrap: Boolean;
    procedure DrawTextBroadwise(Canvas: TCanvas);
    procedure AdjustBounds;
    procedure SetAlignment(Value: TglAlignment);
    procedure SetOptions(Value: TglStaticTextOptions);
    procedure SetWordWrap(Value: Boolean);
    function GetAutoSize: Boolean;
  protected
    procedure SetAutoSize(Value: Boolean); override; 
    {$IFDEF USEJVCL}
    procedure MouseEnter(Control: TControl); override;
    procedure MouseLeave(Control: TControl); override;
    {$ENDIF USEJVCL}
  public
    constructor Create(AOwner: TComponent); override;
    procedure Paint; override;
    property Canvas;
    property ExternalCanvas;
  published
    property Anchors;
    property Align;
    property Caption;
    property Color;
    property DragCursor;
    property DragMode;
    property Enabled;
    property Font;
    property ParentColor;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property Visible;
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnStartDrag;
    {$IFDEF USEJVCL}
    property OnMouseEnter;
    property OnMouseLeave;
    {$ENDIF USEJVCL}
    property FocusControl;
    property FocusControlMethod;
    property Transparent;
    property ActiveColor: TColor read FActiveColor write FActiveColor default clWhite;
    property Alignment: TglAlignment read FAlignment write SetAlignment default ftaBroadwise;
    property AutoSize: Boolean read GetAutoSize write SetAutoSize;
    property Options: TglStaticTextOptions read FOptions write SetOptions;
    property WordWrap: Boolean read FWordWrap write SetWordWrap default True;
  end;

  TJvgGlyphLabel = class(TJvgLabel)
  private
    FGlyphOn: TBitmap;
    FGlyphOff: TBitmap;
    FGlyphDisabled: TBitmap;
    FGlyphKind: TglGlyphKind;
    function IsCustomGlyph: Boolean;
    procedure SetGlyphOn(Value: TBitmap);
    function GetGlyphOn: TBitmap;
    procedure SetGlyphOff(Value: TBitmap);
    function GetGlyphOff: TBitmap;
    procedure SetGlyphDisabled(Value: TBitmap);
    function GetGlyphDisabled: TBitmap;
    procedure SetGlyphKind(Value: TglGlyphKind);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property GlyphKind: TglGlyphKind read FGlyphKind write SetGlyphKind default fgkDefault;
    property GlyphOn: TBitmap read GetGlyphOn write SetGlyphOn stored True;
    property GlyphOff: TBitmap read GetGlyphOff write SetGlyphOff stored True;
    property GlyphDisabled: TBitmap read GetGlyphDisabled write
      SetGlyphDisabled stored IsCustomGlyph;
  end;

{$IFDEF USEJVCL}
{$IFDEF UNITVERSIONING}
const
  UnitVersioning: TUnitVersionInfo = (
    RCSfile: '$URL: https://jvcl.svn.sourceforge.net/svnroot/jvcl/tags/JVCL3_32/run/JvgLabel.pas $';
    Revision: '$Revision: 10612 $';
    Date: '$Date: 2006-05-19 21:04:09 +0200 (ven., 19 mai 2006) $';
    LogPath: 'JVCL\run'
  );
{$ENDIF UNITVERSIONING}
{$ENDIF USEJVCL}

implementation

uses
  {$IFDEF USEJVCL}
  Math,
  JvJVCLUtils;
  {$ELSE}
  Math;
  {$ENDIF USEJVCL}

{$IFNDEF USEJVCL}

function JvMakeObjectInstance(Method: TWndMethod): Pointer;
begin
  {$IFDEF COMPILER6_UP}
  Result := Classes.MakeObjectInstance(Method);
  {$ELSE}
  Result := MakeObjectInstance(Method);
  {$ENDIF COMPILER6_UP}
end;

procedure JvFreeObjectInstance(ObjectInstance: Pointer);
begin
  if ObjectInstance <> nil then
    {$IFDEF COMPILER6_UP}
    Classes.FreeObjectInstance(ObjectInstance);
    {$ELSE}
    FreeObjectInstance(ObjectInstance);
    {$ENDIF COMPILER6_UP}
end;

{$ENDIF !USEJVCL}

//=== { TJvgCustomLabel } ====================================================

constructor TJvgCustomLabel.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlStyle := ControlStyle + [csOpaque, csReplicatable];
  ActiveWhileControlFocused := True;
  FAutoSize := True;
  FTransparent := True;
  FFocusControlMethod := fcmOnMouseDown;
end;

destructor TJvgCustomLabel.Destroy;
begin
  SetFocusControl(nil);
  inherited Destroy;
end;

procedure TJvgCustomLabel.Paint;
begin
  //...if FocusControl have changed his parent in Run-Time...
  if FNeedRehookFocusControl then
    HookFocusControlWndProc;
  //don't inherited;
end;

procedure TJvgCustomLabel.Notification(AComponent: TComponent; Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (AComponent = FocusControl) and (Operation = opRemove) then
  begin
    {UnhookFocusControlWndProc;}
    FFocusControl := nil;
  end;
end;

{$IFDEF USEJVCL}
procedure TJvgCustomLabel.MouseEnter(Control: TControl);
begin
  if csDesigning in ComponentState then
    Exit;
  inherited MouseEnter(Control);
  if Assigned(FocusControl) and (FocusControlMethod = fcmOnMouseEnter) then
    FocusControl.SetFocus;
end;
{$ENDIF USEJVCL}

procedure TJvgCustomLabel.WMLMouseUp(var Msg: TMessage);
begin
  inherited;
  if Enabled and (FocusControlMethod = fcmOnMouseUp) and
    Assigned(FocusControl) and FocusControl.CanFocus then
    FocusControl.SetFocus;
end;

procedure TJvgCustomLabel.WMLMouseDown(var Msg: TMessage);
begin
  inherited;
  if Enabled and (FocusControlMethod = fcmOnMouseDown) and
    Assigned(FocusControl) and FocusControl.CanFocus then
    FocusControl.SetFocus;
end;

{$IFDEF USEJVCL}
procedure TJvgCustomLabel.TextChanged;
begin
  inherited TextChanged;
  Invalidate;
end;
{$ENDIF USEJVCL}

procedure TJvgCustomLabel.HookFocusControlWndProc;
var
  P: Pointer;
begin
  P := Pointer(GetWindowLong(FocusControl.Handle, GWL_WNDPROC));
  if P <> FNewWndProc then
  begin
    FPrevWndProc := P;
    FNewWndProc := JvMakeObjectInstance(FocusControlWndHookProc);
    SetWindowLong(FocusControl.Handle, GWL_WNDPROC, Longint(FNewWndProc));
  end;
end;

procedure TJvgCustomLabel.UnhookFocusControlWndProc;
begin
  //  if not(csDesigning in ComponentState) then Exit;
  if (FNewWndProc <> nil) and (FPrevWndProc <> nil) and
    (Pointer(GetWindowLong(FocusControl.Handle, GWL_WNDPROC)) = FNewWndProc) then
  begin
    SetWindowLong(FocusControl.Handle, GWL_WNDPROC, Longint(FPrevWndProc));
    // (rom) JvFreeObjectInstance call added
    JvFreeObjectInstance(FNewWndProc);
    FNewWndProc := nil;
  end;
end;

procedure TJvgCustomLabel.FocusControlWndHookProc(var Msg: TMessage);
begin
  case Msg.Msg of
    WM_SETFOCUS:
      begin
        {$IFDEF USEJVCL}
        MouseEnter(Self);
        {$ENDIF USEJVCL}
        FShowAsActiveWhileControlFocused := True;
      end;
    WM_KILLFOCUS:
      begin
        FShowAsActiveWhileControlFocused := False;
        {$IFDEF USEJVCL}
        MouseLeave(Self);
        {$ENDIF USEJVCL}
      end;
    WM_DESTROY:
      FNeedRehookFocusControl := True;
  end;
  Msg.Result := CallWindowProc(FPrevWndProc, TForm(Owner).Handle,
    Msg.Msg, Msg.WParam, Msg.LParam);
end;

procedure TJvgCustomLabel.SetFocusControl(Value: TWinControl);
begin
  if FFocusControl = Value then
    Exit;
  if ActiveWhileControlFocused and Assigned(FFocusControl) then
    UnhookFocusControlWndProc;
  FFocusControl := Value;
  if ActiveWhileControlFocused and Assigned(FFocusControl) then
    HookFocusControlWndProc;
end;

procedure TJvgCustomLabel.SetTransparent(Value: Boolean);
begin
  FTransparent := Value;
  Invalidate;
end;

//=== { TJvgLabel } ==========================================================

constructor TJvgLabel.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  TextStyles := TJvgLabelTextStyles.Create;
  Colors := TJvgLabelColors.Create;
  Gradient := TJvgGradient.Create;
  FIllumination := TJvgIllumination.Create;
  FImg := TBitmap.Create;

  FFirstCreate := True;
  FreeFont := TFont.Create;
  if csDesigning in ComponentState then
    Self.Font.Name := 'Arial';
  AutoSize := True;
  //  FRunOnce:=False;
  //  FActiveNow := False;

  FDirection := fldLeftRight;
  FFontWeight := fwDONTCARE;
  //  FSupressPaint := False;
  FUFontWeight := Word(fwDONTCARE);
  //  FNeedUpdateOnlyMainText:=False;
  FGradient.OnChanged := OnGradientChanged;
  FIllumination.OnChanged := OnIlluminationChanged;
  TextStyles.OnChanged := OnIlluminationChanged;
  Colors.OnChanged := OnIlluminationChanged;
  FOptions := [floActiveWhileControlFocused];
  FTargetCanvas := Canvas;
  FTransparent := True;
  Width := 100;
  Height := 16;
end;

destructor TJvgLabel.Destroy;
begin
  TextStyles.Free;
  Colors.Free;
  Gradient.Free;
  FIllumination.Free;
  FTexture.Free;
  FBackground.Free;
  FTextureMask.Free;
  FImg.Free;
  inherited Destroy;
  DeleteObject(FreeFont.Handle);
  FreeFont.Free;
end;

procedure TJvgLabel.Notification(AComponent: TComponent; Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (AComponent = BackgroundImage) and (Operation = opRemove) then
    BackgroundImage := nil
  else
  if (AComponent = TextureImage) and (Operation = opRemove) then
    TextureImage := nil;
end;

{$IFDEF USEJVCL}

procedure TJvgLabel.FontChanged;
begin
  inherited FontChanged;
  CreateLabelFont;
  Invalidate;
end;

procedure TJvgLabel.MouseEnter(Control: TControl);
begin
  if csDesigning in ComponentState then
    Exit;

  if not Enabled or (floIgnoreMouse in Options) or
     FShowAsActiveWhileControlFocused then
    Exit;
  //inherited;
  FActiveNow := True;
  with TextStyles, Colors do
    if (Passive <> Active) or
      ((Background <> BackgroundActive) and not Transparent) then
    begin
      if floBufferedDraw in Options then
        Repaint
      else
        InvalidateLabel(True);
    end
    else
    if (floDelineatedText in Options) and (DelineateActive <> Delineate) then
      Repaint
    else
    if TextActive <> Text then
    begin
      FNeedUpdateOnlyMainText := True;
      Repaint;
    end;
  inherited MouseEnter(Control);
end;

procedure TJvgLabel.MouseLeave(Control: TControl);
begin
  if csDesigning in ComponentState then
    Exit;
  if not Enabled or (floIgnoreMouse in Options) or
    FShowAsActiveWhileControlFocused then
    Exit;
  //inherited;
  FActiveNow := False;
  with TextStyles, Colors do
    if (Passive <> Active) or
      ((Background <> BackgroundActive) and not Transparent) then
    begin
      if floBufferedDraw in Options then
        Repaint
      else
        InvalidateLabel(True);
    end
    else
    if (floDelineatedText in Options) and (DelineateActive <> Delineate) then
      Repaint
    else
    if TextActive <> Text then
    begin
      FNeedUpdateOnlyMainText := True;
      Repaint;
    end;
  inherited MouseLeave(Control);
end;

{$ENDIF USEJVCL}

procedure TJvgLabel.Loaded;
begin
  inherited Loaded;
  if FTexture <> nil then
    FTextureBmp := FTexture
  else
  if Assigned(FTextureImage) then
    FTextureBmp := FTextureImage.Picture.Bitmap
  else
    FTextureBmp := nil;
  if Assigned(FBackground) then
    FBackgroundBmp := FBackground
  else
  if Assigned(FBackgroundImage) then
    FBackgroundBmp := FBackgroundImage.Picture.Bitmap
  else
    FBackgroundBmp := nil;
end;

procedure TJvgLabel.Paint;
var
  R: TRect;
  X, Y, X1, Y1, TX, TY: Integer;
  Size, TextSize: TSize;
  FontColor: TColor;
  CurrTextStyle: TglTextStyle;
  CurrDelinColor: TColor;
  OldGradientFActive, LUseBackgroundBmp, LUseTextureBmp, LBufferedDraw: Boolean;
begin
  inherited Paint;
  if FSupressPaint or (Length(Caption) = 0) then
    Exit;
  if floTransparentFont in Options then
    LBufferedDraw := True
  else
    LBufferedDraw := (floBufferedDraw in Options) and
      not (csDesigning in ComponentState);
  if LBufferedDraw then
    FTargetCanvas := FImg.Canvas
  else
  if Assigned(ExternalCanvas) then
    FTargetCanvas := ExternalCanvas
  else
    FTargetCanvas := Canvas;
  FNeedUpdateOnlyMainText := FNeedUpdateOnlyMainText and not LBufferedDraw and
    (not IsItAFilledBitmap(FBackgroundBmp));
  if not FRunOnce then
  begin
    FNeedUpdateOnlyMainText := False;
    FRunOnce := True;
  end;
  FTargetCanvas.Font := FreeFont;
  //...CALC POSITION
  GetTextExtentPoint32(FTargetCanvas.Handle, PChar(Caption), Length(Caption), Size);
  with TextStyles, Colors do
    if FActiveNow then
    begin
      CurrTextStyle := Active;
      CurrDelinColor := DelineateActive;
      FontColor := TextActive;
    end
    else
    if Enabled then
    begin
      CurrTextStyle := Passive;
      CurrDelinColor := Delineate;
      FontColor := Text;
    end
    else
    begin
      CurrTextStyle := Disabled;
      CurrDelinColor := Delineate;
      FontColor := TextDisabled;
    end;
  X := 0;
  Y := 0;
  Size.cx := Size.cx + 2 + Trunc(Size.cx * 0.01);
  //  Size.cy:=Size.cy+Trunc(Size.cy*0.1);
  Size.cy := Size.cy + 2;
  TextSize := Size;
  if (CurrTextStyle = fstShadow) or (CurrTextStyle = fstVolumetric) then
  begin
    Inc(Size.cy, Illumination.ShadowDepth);
    Inc(Size.cx, Illumination.ShadowDepth);
  end;
  if floDelineatedText in Options then
  begin
    Inc(Size.cy, 2);
    Inc(Size.cx, 2);
  end;

  if (Align = alNone) and AutoSize then
    case FDirection of
      fldLeftRight, fldRightLeft:
        begin
          Width := Size.cx;
          Height := Size.cy;
        end;
    else {fldDownUp,fldUpDown:}
      begin
        Width := Size.cy;
        Height := Size.cx;
      end;
    end;

  //  pt := CalcAlignedTextPosition( FTargetCanvas.Handle, Caption, Size );
  //  X := pt.X; Y := pt.Y;
  //CalcAlignedTextPosition( FTargetCanvas.Handle, Caption, Size );

  case FDirection of
    fldLeftRight:
      begin //if Align = alNone then begin Width:=Max(w,Size.cx);Height:=Max(h,Size.cy); end;
        case Alignment of
          taCenter:
            X := (Width - Size.cx) div 2;
          taRightJustify:
            X := Width - Size.cx;
        end;
      end;
    fldRightLeft:
      begin //if Align = alNone then begin Width:=Max(w,Size.cx);Height:=Max(h,Size.cy);X:=Width;Y:=Height; end;
        case Alignment of
          taCenter:
            X := (Width + Size.cx) div 2;
          taLeftJustify:
            X := Width - (Size.cx - TextSize.cx) - 2;
        else
          X := TextSize.cx;
        end;
        Y := TextSize.cy;
      end;
    fldDownUp:
      begin //if Align = alNone then begin Height:=Max(h,Size.cx);Width:=Max(w,Size.cy);Y:=Height-2; end;
        case Alignment of
          taCenter:
            Y := (Height + TextSize.cx - (Size.cy - TextSize.cy)) div 2;
          taRightJustify:
            Y := TextSize.cx - 4;
        else
          Y := Height - (Size.cy - TextSize.cy) - 2;
        end;
      end;
    fldUpDown:
      begin //if Align = alNone then begin Height:=Max(h,Size.cx);Width:=Max(w,Size.cy);X:=Width; end;
        case Alignment of
          taCenter:
            Y := (Height - Size.cx) div 2;
          taRightJustify:
            Y := Height - Size.cx;
        else
          Y := 1;
        end;
        X := TextSize.cy;
      end;
  end;

  //...CALC POSITION end

  R := GetClientRect;
  if FTargetCanvas = FImg.Canvas then
  begin
    FImg.Width := Width;
    FImg.Height := Height;
  end;

  SetBkMode(FTargetCanvas.Handle, Windows.TRANSPARENT);
  if not Transparent then
  begin
    FTargetCanvas.Brush.Style := bsSolid;
    if FActiveNow then
      FTargetCanvas.Brush.Color := Colors.BackgroundActive
    else
      FTargetCanvas.Brush.Color := Colors.Background;
    FTargetCanvas.FillRect(R);
  end;

  try
    LUseBackgroundBmp := IsItAFilledBitmap(FBackgroundBmp);
  except
    //  raise;
    LUseBackgroundBmp := False;
    FBackgroundBmp := nil;
    FBackgroundImage := nil;
  end;

  try
    LUseTextureBmp := IsItAFilledBitmap(FTextureBmp);
  except
    LUseTextureBmp := False;
    FTextureBmp := nil;
    FTextureImage := nil;
  end;

  //  ShadowColor_ := Colors.Shadow;
  //  HighlightColor_ := Colors.Highlight;
  if LUseBackgroundBmp then
  begin //...FillBackground
    TX := 0;
    TY := 0;
    while TX < Width do
    begin
      while TY < Height do
      begin
        BitBlt(FTargetCanvas.Handle, TX, TY,
          FBackgroundBmp.Width, FBackgroundBmp.Height,
          FBackgroundBmp.Canvas.Handle, 0, 0, SRCCOPY);
        Inc(TY, FBackgroundBmp.Height);
      end;
      Inc(TX, FBackgroundBmp.Width);
      TY := 0;
    end;
  end
  else
  if LBufferedDraw then
    with FTargetCanvas do
    begin
      if Transparent or (floTransparentFont in Options) then
      try
        Brush.Color := Parent.Brush.Color;
        Brush.Style := bsSolid;
        FillRect(R);
        Brush.Style := bsClear;
        GetParentImageRect(Self, Bounds(Left, Top, Width, Height),
          FTargetCanvas.Handle);
      except
      end;
    end;

  OldGradientFActive := Gradient.Active;
  //...Supress Gradient if needed
  with Colors do
    if (FActiveNow and (TextActive <> Text)) or not Enabled then
      Gradient.Active := False;
  if floDelineatedText in Options then
  begin
    X1 := 4;
    Y1 := 4;
  end
  else
  begin
    X1 := 2;
    Y1 := 2;
  end;

  if CurrTextStyle = fstNone then
  begin
    X1 := X1 div 2 - 1;
    Y1 := Y1 div 2 - 1;
  end;
  if CurrTextStyle = fstShadow then
  begin
    X1 := X1 div 2 - 1;
    Y1 := Y1 div 2 - 1;
  end;
  if {FNeedRemakeTextureMask and} LUseTextureBmp or
    (floTransparentFont in Options) then
  begin
    if not Assigned(FTextureMask) then
      FTextureMask := TBitmap.Create;
    with FTextureMask do
    begin
      Width := Self.Width;
      Height := Self.Height;
      Canvas.Brush.Color := clBlack;
      Canvas.Brush.Style := bsSolid;
      Canvas.FillRect(GetClientRect);
      Canvas.Font := FreeFont;
      Canvas.Font.Color := clWhite;
      if (CurrTextStyle = fstNone) or (CurrTextStyle = fstShadow) then
        Canvas.TextOut(X + X1, Y + Y1, Caption)
      else
        Canvas.TextOut(X + X1 div 2, Y + Y1 div 2, Caption);
      TX := 0;
      TY := 0;

      if not Self.Transparent then
      begin
        BitBlt(Canvas.Handle, TX, TY, Width, Height, FTargetCanvas.Handle, 0,
          0, SRCAND);
        if FActiveNow then
          ChangeBitmapColor(FTextureMask, clBlack, Colors.BackgroundActive)
        else
          ChangeBitmapColor(FTextureMask, clBlack, Colors.Background);
        BitBlt(Self.Canvas.Handle, 0, 0, Width, Height, Canvas.Handle, 0, 0,
          SRCCOPY);
        Exit;
      end;

      if floTransparentFont in Options then
        BitBlt(Canvas.Handle, TX, TY, Width, Height, FTargetCanvas.Handle, 0,
          0, SRCAND)
      else
      if LUseTextureBmp then //...fill mask with texture
        while TX < Width do
        begin
          while TY < Height do
          begin
            BitBlt(Canvas.Handle, TX, TY, FTextureBmp.Width,
              FTextureBmp.Height, FTextureBmp.Canvas.Handle, 0, 0, SRCAND);
            Inc(TY, FTextureBmp.Height);
          end;
          Inc(TX, FTextureBmp.Width);
          TY := 0;
        end;
    end;
  end;

  if IsItAFilledBitmap(FTextureBmp) then
    FontColor := 0;
  ExtTextOutExt(FTargetCanvas.Handle, X, Y, GetClientRect, Caption,
    CurrTextStyle, floDelineatedText in Options,
    FNeedUpdateOnlyMainText, FontColor, CurrDelinColor,
    Colors.Highlight, Colors.Shadow,
    Illumination, Gradient, FreeFont);

  //  SetBkMode( FTargetCanvas.Handle, iOldBkMode );
  FNeedUpdateOnlyMainText := False;
  Gradient.Active := OldGradientFActive;

  if (Assigned(FTextureBmp) or (floTransparentFont in Options)) and
    (CurrTextStyle <> fstPushed) then
    if Assigned(FTextureMask) then {fix access violation! WPostma.}
      BitBlt(FTargetCanvas.Handle, 0, 0, FTextureMask.Width, FTextureMask.Height,
        FTextureMask.Canvas.Handle, 0, 0, SRCPAINT);

  if FImg.Canvas = FTargetCanvas then
    BitBlt(Canvas.Handle, 0, 0, FImg.Width, FImg.Height,
      FTargetCanvas.Handle, 0, 0, SRCCOPY);

  //R:=Rect(Left,Top,Left+Width,Top+Height);
  //ValidateRect( Parent.Handle, @R );
end;

procedure TJvgLabel.CreateLabelFont;
begin
  if not FFirstCreate then
    DeleteObject(FreeFont.Handle);
  FreeFont.Handle := CreateRotatedFont(Font, RadianEscapments[FDirection]);
  FFirstCreate := False;
end;

procedure TJvgLabel.InvalidateLabel(UpdateBackgr: Boolean);
var
  R: TRect;
begin
  R := Bounds(Left, Top, Width, Height);
  if not (csDestroying in ComponentState) then
    InvalidateRect(Parent.Handle, @R, UpdateBackgr);
end;

procedure TJvgLabel.OnGradientChanged(Sender: TObject);
begin
  FNeedUpdateOnlyMainText := True;
  Repaint;
  //InvalidateLabel(False);
end;

procedure TJvgLabel.OnIlluminationChanged(Sender: TObject);
begin
  CalcShadowAndHighlightColors((Parent as TWinControl).Brush.Color, Colors);
  InvalidateLabel(True);
end;

procedure TJvgLabel.SetDirection(Value: TglLabelDir);
begin
  FDirection := Value;
  CreateLabelFont;
  FNeedRemakeTextureMask := True;
  InvalidateLabel(True);
end;

procedure TJvgLabel.SetFontWeight(Value: TFontWeight);
begin
  if FFontWeight = Value then
    Exit;
  FFontWeight := Value;
  FUFontWeight := Word(Value) * 100;
  CreateLabelFont;
  FNeedRemakeTextureMask := True;
  InvalidateLabel(True);
end;

procedure TJvgLabel.SetOptions(Value: TglLabelOptions);
begin
  if FOptions = Value then
    Exit;
  FOptions := Value;
  ActiveWhileControlFocused := floActiveWhileControlFocused in Options;
  if floTransparentFont in Options then
    Options := Options + [floBufferedDraw];
  CalcShadowAndHighlightColors((Parent as TWinControl).Brush.Color, Colors);
  FNeedRemakeTextureMask := True;
  InvalidateLabel(True);
end;

procedure TJvgLabel.SetTexture(Value: TBitmap);
begin
  if Assigned(FTexture) then
    FTexture.Free;
  FTexture := nil;
  if (Value <> nil) and (Value.Handle <> 0) then
  begin
    FTexture := TBitmap.Create;
    FTexture.Assign(Value);
    FTextureBmp := FTexture;
  end
  else
  if Assigned(FTextureImage) then
    FTextureBmp := FTextureImage.Picture.Bitmap
  else
    FTextureBmp := nil;
  FNeedRemakeTextureMask := True;
  InvalidateLabel(True);
end;

procedure TJvgLabel.SetBackground(Value: TBitmap);
begin
  if Assigned(FBackground) then
    FBackground.Free;
  FBackground := nil;
  if (Value <> nil) and (Value.Handle <> 0) then
  begin
    FBackground := TBitmap.Create;
    FBackground.Assign(Value);
    FBackgroundBmp := FBackground;
  end
  else
  if FBackgroundImage <> nil then
    FBackgroundBmp := FBackgroundImage.Picture.Bitmap
  else
    FBackgroundBmp := nil;
  InvalidateLabel(True);
end;

function TJvgLabel.GetTexture: TBitmap;
begin
  if not Assigned(FTexture) then
    FTexture := TBitmap.Create;
  Result := FTexture;
end;

function TJvgLabel.GetBackground: TBitmap;
begin
  if not Assigned(FBackground) then
    FBackground := TBitmap.Create;
  Result := FBackground;
end;

procedure TJvgLabel.SetTextureImage(Value: TImage);
begin
  FTextureImage := Value;
  //mb  if (not IsItAFilledBitmap(FTexture)) and Assigned(Value) then
  if Value <> nil then
  begin
    FTextureBmp := FTextureImage.Picture.Bitmap;
  end
  else
  if FTexture <> nil then
    FTextureBmp := FTexture
  else
    FTextureBmp := nil;
  InvalidateLabel(True);
end;

procedure TJvgLabel.SetBackgroundImage(Value: TImage);
begin
  FBackgroundImage := Value;
  //mb  if (not IsItAFilledBitmap(FBackground)) and Assigned(Value) then
  if Value <> nil then
  begin
    FBackgroundBmp := FBackgroundImage.Picture.Bitmap;
    InvalidateLabel(True);
  end
  else
  if FBackground <> nil then
    FBackgroundBmp := FBackground
  else
    FBackgroundBmp := nil;
  InvalidateLabel(True);
end;

procedure TJvgLabel.SetAlignment(Value: TAlignment);
begin
  FAlignment := Value;
  Invalidate;
end;

//=== { TJvgStaticTextLabel } ================================================

constructor TJvgStaticTextLabel.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FActiveColor := clWhite;
  FAlignment := ftaBroadwise;
  FOptions := [ftoActiveWhileControlFocused];
  FWordWrap := True;
  Width := 100;
  Height := 16;
end;

{$IFDEF USEJVCL}
procedure TJvgStaticTextLabel.MouseEnter(Control: TControl);
begin
  if (ftoIgnoreMouse in Options) or FShowAsActiveWhileControlFocused then
    Exit;
  FActiveNow := True;
  Repaint;
  inherited MouseEnter(Control);
end;

procedure TJvgStaticTextLabel.MouseLeave(Control: TControl);
begin
  if (ftoIgnoreMouse in Options) or FShowAsActiveWhileControlFocused then
    Exit;
  FActiveNow := False;
  if ftoUnderlinedActive in Options then
    Invalidate
  else
    Repaint;
  inherited MouseLeave(Control);
end;

{$ENDIF USEJVCL}

procedure TJvgStaticTextLabel.Paint;
const
  Alignments: array [TglAlignment] of Word =
    (DT_LEFT, DT_RIGHT, DT_CENTER, 0);
  WordWraps: array [Boolean] of Word = (0, DT_WORDBREAK);
var
  LAlignment: TglAlignment;
  FTargetCanvas: TCanvas;
  Rect: TRect;
begin
  //inherited;
  if Caption = '' then
    Exit;

  if Assigned(ExternalCanvas) then
    FTargetCanvas := ExternalCanvas
  else
    FTargetCanvas := Canvas;
  FTargetCanvas.Font.Assign(Font);
  LAlignment := FAlignment;
  SetBkMode(FTargetCanvas.Handle, Integer(FTransparent));

  {  if FActiveNow and(ftoUnderlinedActive in Options) then
      FTargetCanvas.Font.Style := Font.Style + [fsUnderline]
    else
      FTargetCanvas.Font.Style := Font.Style - [fsUnderline];
  }
  if FActiveNow then
    SetTextColor(FTargetCanvas.Handle, ColorToRGB(ActiveColor))
  else
    SetTextColor(FTargetCanvas.Handle, ColorToRGB(Font.Color));

  //  TextOut( FTargetCanvas.Handle, 0, 0, 'lpszString', 10);
  //  BitBlt( FTargetCanvas.Handle, 0, 0, Width, Height, Image.FTargetCanvas.Handle, Width, Height, SRCCOPY );
  if Alignment = ftaBroadwise then
  begin
    if FWordWrap then
    begin
      DrawTextBroadwise(FTargetCanvas);
      Exit;
    end
    else
      LAlignment := ftaLeftJustify;
  end;
  Rect := ClientRect;
  Windows.DrawText(FTargetCanvas.Handle, PChar(Caption), Length(Caption), Rect,
    DT_EXPANDTABS or WordWraps[FWordWrap] or Alignments[LAlignment]);
end;

procedure TJvgStaticTextLabel.DrawTextBroadwise(Canvas: TCanvas);
var
  DrawPos, Pos1, Pos2, LineWidth, LineNo, LexemCount, TextHeight: Integer;
  Lexem: string;
  Size: TSize;
  LStop, LBroadwiseLine: Boolean;

  function GetNextLexem(var Pos1, Pos2: Integer; ATrimLeft: Boolean): string;
  var
    Pos: Integer;
  begin
    Pos := Pos1;
    if Caption[Pos] = ' ' then
      repeat
        Inc(Pos);
      until (Pos > Length(Caption)) or (Caption[Pos] <> ' ');
    Pos2 := Pos;
    if ATrimLeft and (LineNo > 0) then
      Pos1 := Pos;
    repeat
      Inc(Pos2);
    until (Pos2 > Length(Caption)) or (Caption[Pos2] = ' ');

    Result := Copy(Caption, Pos1, Pos2 - Pos1);
  end;

  procedure DrawLine(AdditSpace: Cardinal);
  var
    I, DrawPos1, DrawPos2: Integer;
    Lexem: string;
    Size: TSize;
    X, X1: Single;
  begin
    DrawPos1 := DrawPos;
    DrawPos2 := DrawPos;
    X := 0;
    X1 := 0;
    LineWidth := 0;
    for I := 1 to LexemCount do
    begin
      Lexem := GetNextLexem(DrawPos1, DrawPos2, I = 1);
      //      if LexemCount=1 then Lexem:=Lexem+' ';
      GetTextExtentPoint32(Canvas.Handle, PChar(Lexem), Length(Lexem), Size);
      Inc(LineWidth, Trunc(X));
      X := X + Size.cx;
      if (Trunc(X) > Width) and (LexemCount > 1) then
        Exit;

      if (LexemCount > 1) and LBroadwiseLine then
        X := X + AdditSpace / (LexemCount - 1);
      TextOut(Canvas.Handle, Trunc(X1), LineNo * TextHeight, PChar(Lexem),
        Length(Lexem));
      X1 := X;
      DrawPos1 := DrawPos2;
    end;
  end;

begin
  if Text = '' then
    Exit;
  LineWidth := 0;
  LineNo := 0;
  DrawPos := 1;
  Pos1 := 1;
  Pos2 := 1;
  LexemCount := 0;
  TextHeight := 0;
  LStop := False;
  LBroadwiseLine := True;
  repeat
    Lexem := GetNextLexem(Pos1, Pos2, LexemCount = 0);
    //    if LexemCount=0 then Lexem:=Lexem+' ';
    GetTextExtentPoint32(Canvas.Handle, PChar(Lexem), Length(Lexem), Size);
    Inc(LineWidth, Size.cx);
    Inc(LexemCount);
    if TextHeight < Size.cy then
      TextHeight := Size.cy;
    if (LineWidth > Width) or (Pos2 >= Length(Caption)) then
    begin
      if LineWidth > Width then
      begin
        if LexemCount = 1 then
          Pos1 := Pos2;
        if LexemCount > 1 then
          Dec(LexemCount);
        DrawLine(Width - (LineWidth - Size.cx));
        DrawPos := Pos1;
        Inc(LineNo);
        LexemCount := 0;
        LineWidth := 0;
        LStop := Pos1 > Length(Caption);
      end
      else
      begin
        LBroadwiseLine := ftoBroadwiseLastLine in Options;
        DrawLine(Width - LineWidth);
        Inc(LineNo);
        LStop := True;
      end;
    end
    else
      Pos1 := Pos2;
  until LStop;
  if FAutoSize then
    Height := Max(12, LineNo * TextHeight);
end;

procedure TJvgStaticTextLabel.AdjustBounds;
const
  WordWraps: array [Boolean] of Word = (0, DT_WORDBREAK);
var
  DC: HDC;
  X: Integer;
  Rect: TRect;
begin
  if not (csReading in ComponentState) and FAutoSize then
  begin
    Rect := ClientRect;
    DC := GetDC(HWND_DESKTOP);
    Canvas.Handle := DC;
    Windows.DrawText(Canvas.Handle, PChar(Caption), Length(Caption), Rect,
      DT_EXPANDTABS or DT_CALCRECT or WordWraps[FWordWrap]);
    Canvas.Handle := 0;
    ReleaseDC(HWND_DESKTOP, DC);
    X := Left;
    if FAlignment = ftaRightJustify then
      Inc(X, Width - Rect.Right);
    SetBounds(X, Top, Rect.Right, Rect.Bottom);
  end;
end;

procedure TJvgStaticTextLabel.SetAlignment(Value: TglAlignment);
begin
  FAlignment := Value;
  Invalidate;
end;

procedure TJvgStaticTextLabel.SetOptions(Value: TglStaticTextOptions);
begin
  FOptions := Value;
  ActiveWhileControlFocused := ftoActiveWhileControlFocused in Options;
  Invalidate;
end;

procedure TJvgStaticTextLabel.SetWordWrap(Value: Boolean);
begin
  FWordWrap := Value;
  Invalidate;
end;

procedure TJvgStaticTextLabel.SetAutoSize(Value: Boolean);
begin
  inherited AutoSize := Value;
  AdjustBounds;
end;

function TJvgStaticTextLabel.GetAutoSize: Boolean;
begin
  Result := inherited AutoSize;
end;

//=== { TJvgGlyphLabel } =====================================================

// (rom) Glyph handling is a mess

constructor TJvgGlyphLabel.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlStyle := [csCaptureMouse, csOpaque,
    csClickEvents, csSetCaption, csReplicatable];
end;

destructor TJvgGlyphLabel.Destroy;
begin
  FGlyphOn.Free;
  FGlyphOff.Free;
  FGlyphDisabled.Free;
  inherited Destroy;
end;

function TJvgGlyphLabel.IsCustomGlyph: Boolean;
begin
  Result := FGlyphKind = fgkCustom;
end;

procedure TJvgGlyphLabel.SetGlyphOn(Value: TBitmap);
begin
  if Assigned(FGlyphOn) then
    FGlyphOn.Free;
  FGlyphOn := TBitmap.Create;
  FGlyphKind := fgkCustom;
  FGlyphOn.Assign(Value);
  Invalidate;
end;

function TJvgGlyphLabel.GetGlyphOn: TBitmap;
begin
  if not Assigned(FGlyphOn) then
    FGlyphOn := TBitmap.Create;
  Result := FGlyphOn;
end;

procedure TJvgGlyphLabel.SetGlyphOff(Value: TBitmap);
begin
  if Assigned(FGlyphOff) then
    FGlyphOff.Free;
  FGlyphOff := TBitmap.Create;
  FGlyphKind := fgkCustom;
  FGlyphOff.Assign(Value);
  Invalidate;
end;

function TJvgGlyphLabel.GetGlyphOff: TBitmap;
begin
  if not Assigned(FGlyphOff) then
    FGlyphOff := TBitmap.Create;
  Result := FGlyphOff;
end;

procedure TJvgGlyphLabel.SetGlyphDisabled(Value: TBitmap);
begin
  if Assigned(FGlyphDisabled) then
    FGlyphDisabled.Free;
  FGlyphDisabled := TBitmap.Create;
  FGlyphDisabled.Assign(Value);
  Invalidate;
end;

function TJvgGlyphLabel.GetGlyphDisabled: TBitmap;
begin
  if not Assigned(FGlyphDisabled) then
    FGlyphDisabled := TBitmap.Create;
  Result := FGlyphDisabled;
end;

procedure TJvgGlyphLabel.SetGlyphKind(Value: TglGlyphKind);
begin
  if FGlyphKind <> Value then
    FGlyphKind := Value;
  if (FGlyphKind = fgkCustom) and (csReading in ComponentState) then
  begin
    GlyphOn := nil;
    GlyphOff := nil;
    GlyphDisabled := nil;
  end
  else
  begin
    FGlyphOn.Assign(nil); // fixes GDI resource leak
    FGlyphOff.Assign(nil); // fixes GDI resource leak
    FGlyphOn.LoadFromResourceName(HInstance, 'JvgON');
    FGlyphOff.LoadFromResourceName(HInstance, 'JvgOFF');
    FGlyphDisabled := TBitmap.Create;
    FGlyphDisabled.LoadFromResourceName(HInstance, 'JvgDISABLED');
  end;
end;

{$IFDEF USEJVCL}
{$IFDEF UNITVERSIONING}
initialization
  RegisterUnitVersion(HInstance, UnitVersioning);

finalization
  UnregisterUnitVersion(HInstance);
{$ENDIF UNITVERSIONING}
{$ENDIF USEJVCL}

end.

