aactrls.pas

平滑特效字体控件包是一个基于平滑（Anti-aliasing）和特效（Effect）字体 技术的控件包

{*******************************************************************************

                          AAFont - 平滑特效字体控件包
                          ---------------------------
                           (C)Copyright 2001-2004
                            CnPack 开发组 周劲羽

            这一控件包是自由软件，您可以遵照自由软件基金会出版的GNU 较
        宽松通用公共许可证协议来修改和重新发布这一程序，或者用许可证的
        第二版，或者（根据您的选择）用任何更新的版本。

            发布这一控件包的目的是希望它有用，但没有任何担保。甚至没有
        适合特定目的而隐含的担保。更详细的情况请参阅 GNU 较宽松通用公
        共许可证。

            您应该已经和控件包一起收到一份 GNU 较宽松通用公共许可证的
        副本。如果还没有，写信给：
            Free Software Foundation, Inc., 59 Temple Place - Suite
        330, Boston, MA 02111-1307, USA.

            单元作者：CnPack 开发组 周劲羽
            下载地址：http://www.yygw.net
            电子邮件：[e-mail]

*******************************************************************************}

unit AACtrls;
{* |<PRE>
================================================================================
* 软件名称：平滑特效字体控件包
* 单元名称：平滑特效字体控件单元
* 单元作者：CnPack 开发组 周劲羽
* 下载网址：http://www.yygw.net
* Eamil   ：[e-mail]
* 开发平台：PWin2000Pro + Delphi 5.01
* 兼容测试：PWin9X/2000/XP + Delphi 5/6/7 + C++Build 5/6
* 备　　注：该单元实现了以下几个控件：
*           平滑特效字体标签 TAALabel
*           平滑特效超链接标签 TAALinkLabel
*           平滑特效文本控件 TAAText
*           平滑滚动文本控件 TAAScrollText
*           平滑特效渐隐文本控件 TAAFadeText
* 最后更新：2004.07.12
================================================================================
|</PRE>}

interface

{$I AAFont.inc}

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  AAFont, AATimer, ExtCtrls, StdCtrls, ShellAPI;

const
  //版本号
  verAAFont = 'V2.60';

type

{ TAAFontEffect }

  TAAFontEffect = class(TCustomParam)
  {* 平滑特效字体标签控件参数类}
  published
    property Transparent;
    {* 控件是否透明}
    property Layout;
    {* 文本垂直方向对齐方式}
    property Alignment;
    {* 文本水平对齐方式}
    property Quality;
    {* 平滑字体显示精度}
    property FontEffect;
    {* 平滑特效字体属性}
    property BackColor;
    {* 控件背景颜色}
    property BackGround;
    {* 控件背景图像}
    property BackGroundMode;
    {* 控件背景图像显示模式}
  end;

{ TAALabel }

  TAALabel = class(TAAGraphicControl)
  {* 平滑特效字体标签控件，用于显示单行文本，在控件的Effect属性中定义了所有与
     特效显示相关的设置。
   |<BR> 注：该控件不支持多行文本，如果需要显示多行文本，用TAAText来代替。
   |<BR> 在设计期，可通过双击控件来快速设置字体特效属性}
  private
    { Private declarations }
    FEffect: TAAFontEffect;
    MemBmp: TBitmap;
    procedure SetEffect(const Value: TAAFontEffect);
  protected
    { Protected declarations }
    procedure PaintCanvas; override;
    procedure Reset; override;
    procedure TransparentPaint;
    procedure DrawMem;
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    {* 类构造器}
    destructor Destroy; override;
    {* 类析构器}
  published
    { Published declarations }
    property AutoSize;
    {* 是否自动设置控件尺寸}
    property Border;
    {* 控件边界保留宽度}
    property Caption;
    {* 控件标题}
    property Font;
    {* 字体}
    property Width default 46;
    {* 控件宽度}
    property Height default 12;
    {* 控件高度}
    property Effect: TAAFontEffect read FEffect write SetEffect;
    {* 平滑特效字体属性}
  end;

{ THotLink }

  THotLink = class(TCustomParam)
  {* 平滑特效字体超链接标签控件超链接参数类}
  private
    FFade: Boolean;
    FUnderLine: Boolean;
    FFadeDelay: Cardinal;
    FURL: string;
    FFontEffect: TAAEffect;
    FColor: TColor;
    FBackColor: TColor;
    procedure SetFontEffect(const Value: TAAEffect);
  public
    constructor Create; reintroduce;
    {* 类构造器}
    destructor Destroy; override;
    {* 类析构器}
    procedure Assign(Source: TPersistent); override;
    {* 对象赋值方法}
  published
    property Fade: Boolean read FFade write FFade default True;
    {* 是否允许淡入淡出显示}
    property FadeDelay: Cardinal read FFadeDelay write FFadeDelay
      default 600;
    {* 淡入淡出显示延时}
    property Color: TColor read FColor write FColor default clBlue;
    {* 高亮时的高亮时的字体颜色}
    property BackColor: TColor read FBackColor write FBackColor default clBtnface;
    {* 高亮时的背景颜色}
    property FontEffect: TAAEffect read FFontEffect write SetFontEffect;
    {* 高亮时的字体特效参数}
    property URL: string read FURL write FURL;
    {* 超链接内容或文件名，例如：
     |<PRE>
       http://www.yygw.net      - 网页
       mailto:[e-mail]      - 邮件地址
       mailto:[e-mail]?subject=你好 - 带邮件标题的邮件地址链接
       c:\tools\anyexe.exe      - 可执行文件
       d:\aafont\readme.txt     - 文本文件等其它文件
       其它有效的超链接地址或文件名，相当于“开始”菜单中的“运行”命令
     |</PRE>}
    property UnderLine: Boolean read FUnderLine write FUnderLine
      default False;
    {* 高亮时是否显示下划线}
    property Transparent;
    {* 高亮时的透明设置}
    property BackGround;
    {* 高亮时的背景图像}
    property BackGroundMode;
    {* 高亮时的背景图像显示模式}
  end;

{ TAALinkLabel }

  TFadeStyle = (fsNone, fsIn, fsOut);

  TAALinkLabel = class(TAALabel)
  {* 平滑特效超链接标签控件，用于显示超链接，支持切换时的淡入淡出效果}
  private
    { Private declarations }
    HotBmp: TBitmap;
    BlendBmp: TBitmap;
    FadeTimer: TTimer;
    FFadeStyle: TFadeStyle;
    FProgress: TProgress;
    FHotLink: THotLink;
    FMouseIn: Boolean;
    NewProg: Double;

    procedure OnFadeTimer(Sender: TObject);
    procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
    procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
    procedure SetProgress(const Value: TProgress);
    procedure SetFadeStyle(const Value: TFadeStyle);
    procedure SetHotLink(const Value: THotLink);
  protected
    { Protected declarations }
    property Progress: TProgress read FProgress write SetProgress;
    property FadeStyle: TFadeStyle read FFadeStyle write SetFadeStyle;
    procedure DrawHot;
    procedure PaintCanvas; override;
    procedure SetEnabled(Value: Boolean); override;
    procedure LoadedEx; override;
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    {* 类构造器}
    destructor Destroy; override;
    {* 类析构器}
    procedure Click; override;
    {* 模拟用户点击该控件，调用HotLink的URL属性}
  published
    { Published declarations }
    property HotLink: THotLink read FHotLink write SetHotLink;
    {* 超链接属性}
  end;

{ TTextParam }

  TTextParam = class(TCustomTextParam)
  {* 平滑特效文本控件参数类}
  protected
    function IsLinesStored: Boolean; override;
  public
    constructor Create(AOwner: TAAGraphicControl; ChangedProc:
      TNotifyEvent); override;
    {* 类构造器}
    destructor Destroy; override;
    {* 类析构器}
  published
    property WordWrap;
    {* 是否允许自动换行}
    property RowPitch;
    {* 文本行间距，单位为字体高度的百分比}
    property Lines;
    {* 文本内容属性，允许使用字体标签和用户标签来控制每一行文本的对齐方式和字体特效。
       使用标签时用一对尖括号'<'、'>'将标签名引起来，控制标签的作用范围由LabelEffect
       决定。另见文本控件的Fonts、Labels属性。}
    property Transparent;
    {* 是否允许控件透明}
    property Alignment;
    {* 默认的文本对齐方式，如果文本内有对齐标签，则由对齐标签决定。
     |<BR> 另见LabelEffect、Lines、Labels属性}
    property Quality;
    {* 平滑字显示精度}
    property FontEffect;
    {* 默认的字体特效参数，如果文本内有字体标签，则由字体标签决定。
     |<BR> 另见LabelEffect、Lines、Fonts、Font属性}
    property LabelEffect;
    {* 字体、对齐标签作用范围}
    property BackColor;
    {* 控件背景颜色}
    property BackGround;
    {* 控件背景图像}
    property BackGroundMode;
    {* 控件背景显示模式}
  end;

{ TAAText }

  TAAText = class(TAACustomText)
  {* 平滑特效文本控件，用于显示多行文本，通过使用标签，允许每行文本使用不同的
     对齐方式和字体特效。}
  private
    { Private declarations }
    FText: TTextParam;
    procedure SetText(const Value: TTextParam);
  protected
    { Protected declarations }
    TextBmp: TBitmap;
    procedure PaintCanvas; override;
    procedure LoadedEx; override;
    function UseDefaultLabels: Boolean; override;
    procedure CalcSize;
    procedure DrawCanvas(ACanvas: TCanvas);
    procedure CreateText;
    procedure TransparentPaint;
    procedure Reset; override;
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    {* 类构造器}
    destructor Destroy; override;
    {* 类析构器}
  published
    { Published declarations }
    property AutoSize;
    {* 是否自动设置控件尺寸}
    property Border;
    {* 控件边界保留宽度}
    property Font;
    {* 控件字体}
    property Width default 46;
    {* 控件宽度}
    property Height default 12;
    {* 控件高度}
    property Text: TTextParam read FText write SetText;
    {* 控件文本内容及显示参数}
  end;

  TAAScrollText = class;

{ TScrollTextParam }

  TScrollTextParam = class(TCustomTextParam)
  {* 平滑滚动文本控件参数类}
  private
    FFade: Boolean;
    FFadeHeight: Integer;
    FTailSpace: Integer;
    FHeadSpace: Integer;

    procedure SetFade(const Value: Boolean);
    procedure SetFadeHeight(const Value: Integer);
    procedure SetTailSpace(const Value: Integer);
    procedure SetHeadSpace(const Value: Integer);
  protected
    function IsLinesStored: Boolean; override;
  public
    constructor Create(AOwner: TAAGraphicControl; ChangedProc:
    {* 类构造器}
      TNotifyEvent); override;
    destructor Destroy; override;
    {* 类析构器}
  published
    property Fade: Boolean read FFade write SetFade default True;
    {* 是否允许控件上下边界淡入淡出}
    property FadeHeight: Integer read FFadeHeight write SetFadeHeight default 10;
    {* 淡入淡出边界的高度}
    property HeadSpace: Integer read FHeadSpace write SetHeadSpace default 0;
    {* 滚动内容头部空白高度，单位为控件高度的百分比}
    property TailSpace: Integer read FTailSpace write SetTailSpace default 60;
    {* 滚动内容尾部空白高度，单位为控件高度的百分比}
    property Alignment default taCenter;
    {* 默认的文本对齐方式，如果文本内有对齐标签，则由对齐标签决定。
     |<BR> 另见LabelEffect、Lines、Labels属性}
    property RowPitch;
    {* 文本行间距，单位为字体高度的百分比}
    property WordWrap;
    {* 是否允许自动换行}
    property Lines;
    {* 文本内容属性，允许使用字体标签和用户标签来控制每一行文本的对齐方式和字体特效。
       使用标签时用一对尖括号'<'、'>'将标签名引起来，控制标签的作用范围由LabelEffect
       决定。另见文本控件的Fonts、Labels属性。}
    property Quality;
    {* 平滑字显示精度}
    property FontEffect;
    {* 默认的字体特效参数，如果文本内有字体标签，则由字体标签决定。
     |<BR> 另见LabelEffect、Lines、Fonts、Font属性}
    property LabelEffect;
    {* 字体、对齐标签作用范围}
    property Font;
    {* 默认的字体参数，如果文本内有字体标签，则由字体标签决定。
     |<BR> 另见LabelEffect、Lines、Fonts属性}
    property BackColor default clWhite;
    {* 控件背景颜色}
    property BackGround;
    {* 控件背景图像}
    property BackGroundMode default bmTiled;
    {* 控件背景显示模式}
  end;

{ TAAScrollText }

  TAAScrollText = class(TAACustomText)
  {* 平滑滚动文本控件，用于多行文本的动态滚动显示}
  private
    { Private declarations }
    FScrollDelay: Word;
    FScrollStep: Integer;
    FRepeatDelay: Word;
    FRepeatCount: TBorderWidth;
    FRepeatedCount: Integer;
    FText: TScrollTextParam;
    FCurrPos: Integer;
    TextBmp: TBitmap;
    CurrBmp: TBitmap;
    DelayTimer: TTimer;
    ScrollTimer: TAATimer;
    FActive: Boolean;

    procedure CreateText;
    procedure OnDelayTimer(Sender: TObject);
    procedure OnScrollTimer(Sender: TObject);
    procedure SetActive(const Value: Boolean);
    procedure SetScrollDelay(const Value: Word);
    procedure SetScrollStep(const Value: Integer);
    procedure SetRepeatDelay(const Value: Word);
    procedure SetRepeatCount(const Value: TBorderWidth);
    procedure SetText(const Value: TScrollTextParam);
    procedure SetCurrPos(const Value: Integer);
    function GetBmpHeight: Integer;
  protected
    { Protected declarations }
    procedure CreateDefFonts; override;
    procedure PaintCanvas; override;
    function UseDefaultLabels: Boolean; override;
    procedure LoadedEx; override;
    function CanResize(var NewWidth, NewHeight: Integer): Boolean; override;
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    {* 类构造器}
    destructor Destroy; override;
    {* 类析构器}
    procedure Reset; override;
    {* 重新创建滚动内容，用于AutoUpdate为假时，在运行期动态修改控件参数后初始化控件滚动。}
    procedure ReStart;
    {* 重新开始滚动，清滚动计数器，文本从头开始滚动}
    property RepeatedCount: Integer read FRepeatedCount;
    {* 已循环滚动次数，运行期只读属性}
    property CurrPos: Integer read FCurrPos write SetCurrPos;
    {* 当前显示的内容在整个图像中的位置，用户可用它来手动控制控件滚动}
    property BmpHeight: Integer read GetBmpHeight;
    {* 整个图象的高度}
  published
    { Published declarations }
    property AutoUpdate;
    {* 是否允许控件参数变更时自动重新创建滚动内容。如果有很多参数需要在运行时设置，
       可将该属性设为False，待设定完参数后调用Reset方法。}
    property Active: Boolean read FActive write SetActive default True;
    {* 是否允许文本滚动}
    property Height default 280;
    {* 控件高度}
    property Width default 240;
    {* 控件宽度}