aactrls.pas

AAFONT是一款Delphi控件

    property ScrollDelay: Word read FScrollDelay write SetScrollDelay default 60;
    {* 滚动时的延时，单位为毫秒}
    property ScrollStep: Integer read FScrollStep write SetScrollStep default 1;
    {* 一次滚动的象素数，如果设定为负数将向下滚动}
    property RepeatCount: TBorderWidth read FRepeatCount write SetRepeatCount default 0;
    {* 允许循环次数，指定次数的循环结束将自动停止滚动，并产生OnComplete事件。
     |<BR> 该值设为0将无限循环。}
    property RepeatDelay: Word read FRepeatDelay write SetRepeatDelay default 2000;
    {* 完成一次滚动循环后的延时，如果不需要延时，可设为0}
    property Text: TScrollTextParam read FText write SetText;
    {* 滚动文本内容和参数属性}
    property OnComplete;
    {* 指定次数的滚动循环结束事件，见RepeatCount}
    property OnTextReady;
    {* 滚动内容已初始化事件}
    property OnPainted;
    {* 控件重绘事件}
  end;

{ TFadeTextParam }

  TFadeTextParam = class(TCustomTextParam)
  {* 平滑特效渐隐文本控件参数类}
  private
    FFadeDelay: Cardinal;
    procedure SetFadeDelay(const Value: Cardinal);
    procedure SetLineDelay(const Value: Cardinal);
    function GetLineDelay: Cardinal;
  protected
    function IsLinesStored: Boolean; override;
  public
    constructor Create(AOwner: TAAGraphicControl; ChangedProc:
      TNotifyEvent); override;
    {* 类构造器}
    destructor Destroy; override;
    {* 类析构器}
    procedure Assign(Source: TPersistent); override;
    {* 对象赋值方法}
  published
    property FadeDelay: Cardinal read FFadeDelay write SetFadeDelay default 600;
    {* 文本淡入淡出切换延时}
    property LineDelay: Cardinal read GetLineDelay write SetLineDelay default 3000;
    {* 每行文本显示延时}
    property Lines;
    {* 文本内容属性，允许使用字体标签和用户标签来控制每一行文本的对齐方式和字体特效。
       使用标签时用一对尖括号'<'、'>'将标签名引起来，控制标签的作用范围由LabelEffect
       决定。另见文本控件的Fonts、Labels属性。}
    property Transparent;
    {* 是否允许控件透明}
    property Alignment default taCenter;
    {* 默认的文本对齐方式，如果文本内有对齐标签，则由对齐标签决定。
     |<BR> 另见LabelEffect、Lines、Labels属性}
    property Layout default tlCenter;
    {* 文本垂直方向对齐方式}
    property Quality;
    {* 平滑字显示精度}
    property FontEffect;
    {* 默认的字体特效参数，如果文本内有字体标签，则由字体标签决定。
     |<BR> 另见LabelEffect、Lines、Fonts、Font属性}
    property LabelEffect;
    {* 字体、对齐标签作用范围}
    property BackColor default clWhite;
    {* 控件背景颜色}
    property BackGround;
    {* 控件背景图像}
    property BackGroundMode;
    {* 控件背景显示模式}
  end;

{ TAAFadeText }

  TAAFadeText = class(TAACustomText)
  {* 平滑特效渐隐文本控件，用于多行文本的淡入淡出切换显示}
  private
    { Private declarations }
    FActive: Boolean;
    FLineIndex: Integer;
    FText: TFadeTextParam;
    FFadeProgress: TProgress;
    InBmp, OutBmp, TextBmp: TBitmap;
    FadeTimer: TTimer;
    DelayTimer: TTimer;
    LastText: string;
    CurrText: string;
    CurrAlign: TAlignment;
    FRepeatedCount: Integer;
    FRepeatCount: TBorderWidth;
    NewProg: Double;

    procedure SetActive(const Value: Boolean);
    procedure SetLineIndex(const Value: Integer);
    procedure SetText(const Value: TFadeTextParam);
    procedure OnFadeTimer(Sender: TObject);
    procedure OnDelayTimer(Sender: TObject);
    procedure SetFadeProgress(const Value: TProgress);
    procedure DrawFadeBmp(AText: string; Bmp: TBitmap);
    procedure SetRepeatCount(const Value: TBorderWidth);
  protected
    { Protected declarations }
    procedure CreateDefFonts; override;
    procedure PaintCanvas; override;
    function UseDefaultLabels: Boolean; override;
    procedure LoadedEx; override;
    procedure Reset; override;
    property FadeProgress: TProgress read FFadeProgress write SetFadeProgress;
  public
    constructor Create(AOwner: TComponent); override;
    {* 类构造器}
    destructor Destroy; override;
    {* 类析构器}
    property LineIndex: Integer read FLineIndex write SetLineIndex;
    {* 当前显示的行索引号，用户可手动设置}
    property RepeatedCount: Integer read FRepeatedCount;
    {* 已循环滚动次数，运行期只读属性}
    procedure FadeTo(Line: Integer);
    {* 淡入淡出切换到指定行}
    procedure FadeToNext;
    {* 淡入淡出切换到下一行}
    procedure FadeToStr(AText: string);
    {* 淡入淡出切换到指定文本}
  published
    { Published declarations }
    property Active: Boolean read FActive write SetActive default True;
    {* 是否允许文本淡入淡出切换}
    property Height default 34;
    {* 控件高度}
    property Width default 240;
    {* 控件宽度}
    property Font;
    {* 控件字体}
    property RepeatCount: TBorderWidth read FRepeatCount write SetRepeatCount default 0;
    {* 允许循环次数，指定次数的循环结束将自动停止滚动，并产生OnComplete事件。
     |<BR> 该值设为0将无限循环。}
    property Text: TFadeTextParam read FText write SetText;
    {* 控件文本内容和参数属性}
    property OnComplete;
    {* 指定次数的滚动循环结束事件，见RepeatCount}
    property OnPainted;
    {* 控件重绘事件}
  end;

procedure Register;

implementation

{$R-}

procedure Register;
begin
  RegisterComponents('AAFont', [TAAFadeText]);
  RegisterComponents('AAFont', [TAALabel]);
  RegisterComponents('AAFont', [TAALinkLabel]);
  RegisterComponents('AAFont', [TAAText]);
  RegisterComponents('AAFont', [TAAScrollText]);
  
  RegisterComponents('AAFont', [TAATimer]);
  RegisterComponents('AAFont', [TAATimerList]);
end;

const
  csAACopyRight =
    '<Title2>版权声明'#13#10 +
    '<Text1>本控件为免费控件'#13#10 +
    '允许免费用于共享、商业软件中'#13#10 +
    '更多说明参见Readme.txt文件'#13#10 +
    '如发现错误请与作者联系'#13#10#13#10 +

  '<Title2>控件作者'#13#10 +
    '<Text1>作者：周劲羽'#13#10 +
    'Email：[e-mail]'#13#10 +
    'Http://www.cnvcl.org'#13#10 +
    'Http://www.yygw.net'#13#10 +
    'CnPack 开发组'#13#10;

  csAACopyRightStart =
    #13#10'<Title2>用户资料'#13#10 +
    '<Text1><Owner>'#13#10 +
    '<Organization>'#13#10#13#10 +

  '<Title2>控件功能'#13#10;

  csAACopyRightEnd =
    '允许使用不同风格的字体'#13#10 +
    '和对齐方式'#13#10 +
    '支持阴影、渐变色、纹理等特效'#13#10 +
    '提供多个系统变量并'#13#10 +
    '允许自定义变量'#13#10 +
    '所有字体采用平滑显示'#13#10#13#10 +

  '<Title2>使用说明'#13#10 +
    '<Text1>控件的属性、方法、事件'#13#10 +
    '详见Readme.txt文件'#13#10#13#10 +

  '<Title2>特别感谢'#13#10 +
    '<Text1>李文松朋友提供'#13#10 +
    '平滑字体显示算法'#13#10 +
    '[e-mail]'#13#10 +
    'http://member.netease.com/~lws'#13#10 +
    'Passion兄帮助制作控件图标'#13#10 +
    '[e-mail]'#13#10#13#10 +

  '<Title2>备注'#13#10 +
    '<Text1>该控件为免费控件'#13#10 +
    '如果您对这个控件还感满意'#13#10 +
    '请给作者发一封贺卡或邮件'#13#10 +
    '以示支持'#13#10#13#10#13#10 +

  '<Title3>CnPack 开发组'#13#10 +
    '2004.07'#13#10;

  csAATextCopyRight =
    '<Title1><Center>平滑特效文本控件 ' + verAAFont + #13#10#13#10 +
    csAACopyRight;

  csAAFadeTextCopyRight =
    '<Title1><Center>平滑特效渐隐文本控件 ' + verAAFont + #13#10#13#10 +
    csAACopyRight + csAACopyRightStart +
    '<Text1>用于显示淡入淡出文本'#13#10 +
    csAACopyRightEnd;

  csAAScrollTextCopyRight =
    '<Title1>平滑滚动文本控件 ' + verAAFont + #13#10#13#10 +
    csAACopyRight + csAACopyRightStart +
    '<Text1>用于显示滚动文本信息'#13#10 +
    csAACopyRightEnd;

{ TAALabel }

//--------------------------------------------------------//
//平滑特效字体标签                                        //
//--------------------------------------------------------//

//初始化
constructor TAALabel.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  MemBmp := TBitmap.Create;
  MemBmp.PixelFormat := pf24bit;
  FEffect := TAAFontEffect.Create(Self, OnEffectChanged);
  ControlStyle := ControlStyle + [csReplicatable, csSetCaption];
  Width := 46;
  Height := 12;
end;

//释放
destructor TAALabel.Destroy;
begin
  FEffect.Free;
  MemBmp.Free;
  inherited;
end;

//重绘
procedure TAALabel.Reset;
begin
  if not Effect.Transparent then
    DrawMem;
  inherited;
end;

//绘制缓冲区
procedure TAALabel.DrawMem;
var
  OffPoint: TPoint;
  th, tw: Integer;
begin
  AAFont.Canvas := MemBmp.Canvas;
  MemBmp.Canvas.Font.Assign(Font); //字体
  th := AAFont.TextHeight(Caption); //文本高度
  tw := AAFont.TextWidth(Caption); //文本宽度
  //自动设定大小
  if AutoSize and (Align in [alNone, alLeft, alRight]) then
    ClientWidth := tw + 2 * Border;
  if AutoSize and (Align in [alNone, alTop, alBottom]) then
    ClientHeight := th + 2 * Border;
  case Effect.Alignment of    //水平对齐方式
    taLeftJustify: OffPoint.x := Border;
    taCenter: OffPoint.x := (ClientWidth - tw) div 2;
    taRightJustify: OffPoint.x := ClientWidth - Border - tw;
  end;
  case Effect.Layout of       //垂直对齐方式
    tlTop: OffPoint.y := Border;
    tlCenter: OffPoint.y := (ClientHeight - th) div 2;
    tlBottom: OffPoint.y := ClientHeight - Border - th;
  end;
  MemBmp.Height := ClientHeight;
  MemBmp.Width := ClientWidth;
  MemBmp.Canvas.Brush.Color := Color;
  MemBmp.Canvas.Brush.Style := bsSolid;
  if Effect.Transparent then  //透明
  begin
    CopyParentImage(MemBmp.Canvas); //复制父控件画布
  end else if not Effect.IsBackEmpty then
  begin                       //绘制背景图
    DrawBackGround(MemBmp.Canvas, Rect(0, 0, MemBmp.Width, MemBmp.Height),
      Effect.BackGround.Graphic, Effect.BackGroundMode);
  end else
  begin                       //填充背景色
    MemBmp.Canvas.FillRect(ClientRect);
  end;
  MemBmp.Canvas.Brush.Style := bsClear;
  AAFont.TextOut(OffPoint.x, OffPoint.y, Caption); //平滑字体输出
end;

// 透明绘制
procedure TAALabel.TransparentPaint;
var
  OffPoint: TPoint;
  th, tw: Integer;
begin
  AAFont.Canvas := Canvas;
  Canvas.Font.Assign(Font); //字体
  th := AAFont.TextHeight(Caption); //文本高度
  tw := AAFont.TextWidth(Caption); //文本宽度
  //自动设定大小
  if AutoSize and (Align in [alNone, alLeft, alRight]) then
    ClientWidth := tw + 2 * Border;
  if AutoSize and (Align in [alNone, alTop, alBottom]) then
    ClientHeight := th + 2 * Border;
  case Effect.Alignment of    //水平对齐方式
    taLeftJustify: OffPoint.x := Border;
    taCenter: OffPoint.x := (ClientWidth - tw) div 2;
    taRightJustify: OffPoint.x := ClientWidth - Border - tw;
  end;
  case Effect.Layout of       //垂直对齐方式
    tlTop: OffPoint.y := Border;
    tlCenter: OffPoint.y := (ClientHeight - th) div 2;
    tlBottom: OffPoint.y := ClientHeight - Border - th;
  end;
  Canvas.Brush.Color := Color;
  Canvas.Brush.Style := bsSolid;
  Canvas.Brush.Style := bsClear;
  AAFont.TextOut(OffPoint.x, OffPoint.y, Caption); //平滑字体输出
end;

//控件重绘
procedure TAALabel.PaintCanvas;
begin
  if Effect.Transparent then
    TransparentPaint
  else
    Bitblt(Canvas.Handle, 0, 0, Width, Height, MemBmp.Canvas.Handle, 0, 0,
      SRCCOPY);
end;

//设置字体特效
procedure TAALabel.SetEffect(const Value: TAAFontEffect);
begin
  FEffect.Assign(Value);
end;

{ THotLink }

//--------------------------------------------------------//
//超链接参数类                                            //
//--------------------------------------------------------//

//链接参数
procedure THotLink.Assign(Source: TPersistent);
begin
  inherited;
  if Source is THotLink then
  begin
    FFade := THotLink(Source).Fade;
    FUnderLine := THotLink(Source).UnderLine;
    FFadeDelay := THotLink(Source).FadeDelay;
    FURL := THotLink(Source).URL;
    FColor := THotLink(Source).Color;
    FBackColor := THotLink(Source).BackColor;
    FFontEffect.Assign(THotLink(Source).FontEffect);
  end;
end;

//初始化
constructor THotLink.Create;
begin
  inherited Create(nil, nil);
  FFade := True;
  FUnderLine := False;
  FFadeDelay := 600;
  FURL := '';
  FColor := clBlue;
  FBackColor := clBtnface;
  FFontEffect := TAAEffect.Create(nil);
end;

//释放
destructor THotLink.Destroy;
begin
  FFontEffect.Free;
  inherited;
end;

procedure THotLink.SetFontEffect(const Value: TAAEffect);
begin
  FFontEffect.Assign(Value);
  Changed;
end;

{ TAALinkLabel }

//--------------------------------------------------------//
//平滑特效超链接标签                                      //
//--------------------------------------------------------//

//初始化
constructor TAALinkLabel.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FHotLink := THotLink.Create;
  HotBmp := TBitmap.Create;
  HotBmp.PixelFormat := pf24bit;
  BlendBmp := TBitmap.Create;
  BlendBmp.PixelFormat := pf24bit;
  FadeTimer := TTimer.Create(Self);
  FadeTimer.Interval := 55;
  FadeTimer.OnTimer := OnFadeTimer;
  FadeTimer.Enabled := False;
  FProgress := 0;
  FFadeStyle := fsNone;
  NewProg := 0;
end;

//释放
destructor TAALinkLabel.Destroy;
begin
  HotBmp.Free;
  BlendBmp.Free;
  FadeTimer.Free;
  HotLink.Free;
  inherited;
end;