jvglabel.pas

East make Tray Icon in delphi

{-----------------------------------------------------------------------------
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,v 1.34 2005/02/18 13:56:18 wpostma Exp $

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
  {$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: '$RCSfile: JvgLabel.pas,v $';
    Revision: '$Revision: 1.34 $';
    Date: '$Date: 2005/02/18 13:56:18 $';
    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