aafont.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 AAFont;
{* |<PRE>
================================================================================
* 软件名称：平滑特效字体控件包
* 单元名称：平滑特效字体单元
* 单元作者：CnPack 开发组 周劲羽
* 下载网址：http://www.yygw.net
* Eamil   ：[e-mail]
* 开发平台：PWin2000Pro + Delphi 5.01
* 兼容测试：PWin9X/2000/XP + Delphi 5/6/7 + C++Build 5/6
* 备　　注：平滑字体算法由李文松朋友提供的AAFont修改而来
* 最后更新：2003.12.02
================================================================================
|</PRE>}

interface

{$I AAFont.inc}

uses
  Windows, Messages, Classes, Graphics, SysUtils, Consts, Controls, Forms,
  Registry, StdCtrls, ExtCtrls, Math, IniFiles;

type

  TAAQuality = (aqHigh, aqNormal, aqLow, aqNone);
  {* 平滑字体显示精度类型
   |<PRE>
     aqHigh     - 4X4采样的最高显示精度，速度较慢
     aqNormal   - 3X3采样的普通显示精度，最佳性能速度比
     aqLow      - 2X2采样的低显示精度，速度较快
     aqNone     - 无平滑效果
   |</PRE>}
  TAlpha = 0..100;
  {* 不透明度类型，0为完全透明，100为完全不透明}
  TBlurStrength = 0..100;
  {* 模糊度类型，0为不模糊，100为最大模糊度}
  TOffset = -20..20;
  {* 阴影偏移量范围}
  TSprayRange = 0..100;
  {* 喷溅效果参数范围}
  TAngle = -360..360;
  {* 旋转角度}
  TGradualStyle = (gsLeftToRight, gsRightToLeft, gsTopToBottom, gsBottomToTop,
    gsCenterToLR, gsCenterToTB);
  {* 渐变方式类型
   |<PRE>
     gsLeftToRight      - 从左向右渐变
     gsRightToLeft      - 从右向左渐变
     gsTopToBottom      - 从上向下渐变
     gsBottomToTop      - 从下向上渐变
     gsCenterToLR       - 从中间向左右渐变
     gsCenterToTB       - 从中间向上下渐变
   |</PRE>}
  TTextureMode = (tmTiled, tmStretched, tmCenter, tmNormal);
  {* 纹理图像显示模式
   |<PRE>
     tmTiled            - 平铺显示
     tmStretched        - 自动缩放显示
     tmCenter           - 在中心位置显示
     tmNormal           - 在左上角显示
   |</PRE>}

  TAAEffect = class;
  TAAMask = class;
  TAABlend = class;
  TAAFont = class;
  TAAFontEx = class;

{ TNotifyClass }

  TNotifyClass = class(TPersistent)
  {* 带更新通知的持久性类，控件包中大部分持久类的基类，一般不需要直接使用}
  private
    FOnChanged: TNotifyEvent;
  protected
    FOwner: TPersistent;
    procedure Changed; virtual;
    procedure OnChildChanged(Sender: TObject); virtual;
    function GetOwner: TPersistent; override;
  public
    constructor Create(ChangedProc: TNotifyEvent); virtual;
    {* 类构造器，参数为通知事件}
    procedure Assign(Source: TPersistent); override;
    {* 对象赋值方法}
    property OnChanged: TNotifyEvent read FOnChanged write FOnChanged;
    {* 属性已变更事件}
  end;

{ TEnabledClass }

  TEnabledClass = class(TNotifyClass)
  {* 带Enabled功能的更新通知的持久性类，一般不需要直接使用}
  private
    FEnabled: Boolean;
  protected
    procedure SetEnabled(const Value: Boolean); virtual;
    procedure Changed; override;
  public
    constructor Create(ChangedProc: TNotifyEvent); override;
    {* 类构造器，参数为通知事件}
    procedure Assign(Source: TPersistent); override;
    {* 对象赋值方法}
  published
    property Enabled: Boolean read FEnabled write SetEnabled default False;
    {* 是否允许使用}
  end;

{ TAAShadow }

  TAAShadow = class(TEnabledClass)
  {* 平滑特效字体阴影显示参数类，一般不需要用户直接创建}
  private
    FBlur: TBlurStrength;
    FAlpha: TAlpha;
    FColor: TColor;
    FOffsetX: TOffset;
    FOffsetY: TOffset;
    procedure SetBlur(const Value: TBlurStrength);
    procedure SetColor(const Value: TColor);
    procedure SetOffsetX(const Value: TOffset);
    procedure SetOffsetY(const Value: TOffset);
    procedure SetAlpha(const Value: TAlpha);
  public
    constructor Create(ChangedProc: TNotifyEvent); override;
    {* 类构造器，参数为通知事件}
    procedure Assign(Source: TPersistent); override;
    {* 对象赋值方法}
  published
    property Blur: TBlurStrength read FBlur write SetBlur default 80;
    {* 阴影模糊度，参数范围为0..100，0为不模糊}
    property Alpha: TAlpha read FAlpha write SetAlpha default 70;
    {* 阴影不透明度，参数范围为0..100，0为全透明，100为不透明}
    property Color: TColor read FColor write SetColor default $00444444;
    {* 阴影颜色}
    property OffsetX: TOffset read FOffsetX write SetOffsetX default 2;
    {* 阴影水平方向偏移量，为负值时向左偏移}
    property OffsetY: TOffset read FOffsetY write SetOffsetY default 2;
    {* 阴影垂直方向偏移量，为负值时向上偏移}
  end;

{ TAAGradual }

  TAAGradual = class(TEnabledClass)
  {* 平滑特效字体渐变显示参数类，一般不需要用户直接创建}
  private
    FStyle: TGradualStyle;
    FStartColor: TColor;
    FEndColor: TColor;
    procedure SetStyle(const Value: TGradualStyle);
    procedure SetStartColor(const Value: TColor);
    procedure SetEndColor(const Value: TColor);
  public
    constructor Create(ChangedProc: TNotifyEvent); override;
    {* 类构造器，参数为通知事件}
    procedure Assign(Source: TPersistent); override;
    {* 对象赋值方法}
  published
    property Style: TGradualStyle read FStyle write SetStyle default gsLeftToRight;
    {* 渐变显示风格}
    property StartColor: TColor read FStartColor write SetStartColor
      default clWhite;
    {* 渐变起始色}
    property EndColor: TColor read FEndColor write SetEndColor default clBlack;
    {* 渐变结束色}
  end;

{ TAATexture }

  TAATexture = class(TEnabledClass)
  {* 平滑特效字体纹理参数类，一般不需要用户直接创建}
  private
    FPicture: TPicture;
    FMode: TTextureMode;
    procedure SetMode(const Value: TTextureMode);
    procedure SetPicture(const Value: TPicture);
    procedure PictureChanged(Sender: TObject);
  public
    constructor Create(ChangedProc: TNotifyEvent); override;
    {* 类构造器，参数为通知事件}
    destructor Destroy; override;
    {* 类析构器}
    procedure Assign(Source: TPersistent); override;
    {* 对象赋值方法}
  published
    property Mode: TTextureMode read FMode write SetMode default tmTiled;
    {* 纹理图像显示模式}
    property Picture: TPicture read FPicture write SetPicture;
    {* 纹理图像}
  end;

{ TAAEffect }

  TAAEffect = class(TNotifyClass)
  {* 平滑特效字体参数类，一般不需要用户直接创建}
  private
    FAlpha: TAlpha;
    FBlur: TBlurStrength;
    FGradual: TAAGradual;
    FShadow: TAAShadow;
    FTexture: TAATexture;
    FOutline: Boolean;
    FNoise: Byte;
    FSpray: TSprayRange;
    FAngle: TAngle;
    FHorzMirror: Boolean;
    FVertMirror: Boolean;
    procedure SetAlpha(const Value: TAlpha);
    procedure SetBlur(const Value: TBlurStrength);
    procedure SetGradual(const Value: TAAGradual);
    procedure SetShadow(const Value: TAAShadow);
    procedure SetTexture(const Value: TAATexture);
    procedure SetOutline(const Value: Boolean);
    procedure SetNoise(const Value: Byte);
    procedure SetSpray(const Value: TSprayRange);
    procedure SetAngle(const Value: TAngle);
    procedure SetHorzMirror(const Value: Boolean);
    procedure SetVertMirror(const Value: Boolean);
  public
    constructor Create(ChangedProc: TNotifyEvent); override;
    {* 类构造器，参数为通知事件}
    destructor Destroy; override;
    {* 类析构器}
    procedure Assign(Source: TPersistent); override;
    procedure LoadFromIni(Ini: TCustomIniFile; const Section: string); virtual;
    procedure SaveToIni(Ini: TCustomIniFile; const Section: string); virtual;
    {* 对象赋值方法}
  published
    property Shadow: TAAShadow read FShadow write SetShadow;
    {* 字体阴影参数}
    property Gradual: TAAGradual read FGradual write SetGradual;
    {* 渐变显示参数}
    property Texture: TAATexture read FTexture write SetTexture;
    {* 字体纹理参数}
    property Alpha: TAlpha read FAlpha write SetAlpha default 100;
    {* 不透明度，参数范围为0..100，0为完全透明，100为不透明}
    property Blur: TBlurStrength read FBlur write SetBlur default 0;
    {* 模糊度，参数范围为0..100，0为不模糊}
    property Angle: TAngle read FAngle write SetAngle default 0;
    {* 字体旋转角度，参数范围为-360..360，单位为度}
    property Noise: Byte read FNoise write SetNoise default 0;
    {* 噪声效果，参数范围为0..255}
    property Spray: TSprayRange read FSpray write SetSpray default 0;
    {* 喷溅效果，参数范围为0..100}
    property Outline: Boolean read FOutline write SetOutline default False;
    {* 是否显示轮廓效果}
    property HorzMirror: Boolean read FHorzMirror write SetHorzMirror default False;
    {* 是否水平镜象}
    property VertMirror: Boolean read FVertMirror write SetVertMirror default False;
    {* 是否垂直镜象}
  end;

{ TAAMask }

  EInvalidPixel = class(Exception);
  EInvalidLine = class(Exception);

  PByteArray = ^TByteArray;
  {* 字节数组指针}
  TByteArray = array[0..32767] of Byte;
  {* 字节数组类型}

  PRGBArray = ^TRGBArray;
  {* RGB数组指针}
  TRGBArray = array[0..8192] of tagRGBTriple;
  {* RGB数组类型}

  TAAMask = class(TPersistent)
  {* 平滑特效字体蒙板处理类，供绘制平滑字体时内部使用}
  private
    FQuality: TAAQuality;
    FpMaskBuff: PByteArray;
    FHeight: Integer;
    FWidth: Integer;
    BytesLineGray: Integer;
    BytesLineMask: Integer;
    Scale: Integer;
    AAFont: TAAFont;
    GrayBmp: TBitmap;
    procedure InitGrayBmp;
    procedure FreeGrayBmp;
    procedure SetQuality(const Value: TAAQuality);
    function TextExtentEx(s: string; var Point: TPoint): TSize;
  protected
    function ScanLine(Line: Integer; pAData: PByteArray): PByteArray; overload;
    property pMaskBuff: PByteArray read FpMaskBuff;
  public
    constructor Create(AOwner: TAAFont);
    {* 类构造器}
    destructor Destroy; override;
    {* 类析构器}
    procedure Assign(Source: TPersistent); override;
    {* 对象赋值方法}
    procedure DrawMask(Text: string);
    {* 绘制文本蒙板图}
    procedure DrawMaskEx(Text: string; Extend: TSize; Point: TPoint);
    {* 绘制文本蒙板图增强版}
    procedure Blur(Blur: TBlurStrength);
    {* 对蒙板图进行模糊处理}
    procedure Outline;
    {* 对蒙板图进行轮廓处理}
    procedure Spray(Amount: Integer);
    {* 对蒙板图进行喷溅处理}
    procedure HorzMirror;
    {* 对蒙板图进行水平镜象处理}
    procedure VertMirror;
    {* 对蒙板图进行垂直镜象处理}
    function TextExtent(s: string): TSize;
    {* 返回文本高、宽}
    function TextHeight(s: string): Integer;
    {* 返回文本高度}
    function TextWidth(s: string): Integer;
    {* 返回文本宽度}
    function ScanLine(Line: Integer): Pointer; overload;
    {* 返回蒙板图扫描线地址}
    function Pixel(x, y: Integer): Byte;
    {* 返回蒙板图指定象素灰度值}
    function PixelAddr(x, y: Integer): Pointer;
    {* 返回蒙板图指定象素地址}
    property Height: Integer read FHeight;
    {* 蒙板图的高度}
    property Width: Integer read FWidth;
    {* 蒙板图的宽度}
    property Quality: TAAQuality read FQuality write SetQuality;
    {* 平滑字体绘制精度}
  end;

{ TAABlend }

  EInvalidForeBmp = class(Exception);

  TAABlend = class(TPersistent)
  {* 平滑特效字体图像混合处理类，供绘制平滑字体时内部使用}
  private
    FForeBmp: TBitmap;
    RGBBmp: TBitmap;
    AAFont: TAAFont;
    procedure SetForeBmp(const Value: TBitmap);
  public
    constructor Create(AOwner: TAAFont);
    {* 类构造器}
    destructor Destroy; override;
    {* 类析构器}
    procedure Assign(Source: TPersistent); override;
    {* 对象赋值方法}
    procedure Blend(x, y: Integer; AColor: TColor; Alpha: TAlpha; Mask: TAAMask);
    {* 按指定颜色进行混合}
    procedure BlendEx(x, y: Integer; Alpha: TAlpha; Mask: TAAMask);
    {* 使用前景图ForeBmp进行混合}
    property ForeBmp: TBitmap read FForeBmp write SetForeBmp;
    {* 字体前景图}
  end;

{ TAAFont }

  TAAFont = class
  {* 平滑特效字体绘制类，封装了基本的平滑字体绘制方法，用户可手动使用。
   |<BR>如果需要在其它地方绘制平滑字体，可使用下面的方法：
   !var
   !  AAFont: TAAFont;
   !  W, H: Integer;
   !  S: string;
   !begin
   !  // 创建TAAFont实例，并指定它使用PaintBox1的画布进行绘制
   !  AAFont := TAAFont.Create(PaintBox1.Canvas);
   !  try
   !    with PaintBox1.Canvas do
   !    begin
   !      Font.Name := '宋体'; // 设置字体
   !      Font.Size := 24;
   !      Font.Color := clBlue;
   !      Brush.Style := bsClear; // 设置透明绘制
   !    end;
   !    S := '这是一个使用平滑字体的例子';
   !    W := AAFont.TextWidth(S);
   !    H := AAFont.TextHeight(S);