aactrls.pas

AAFONT是一款Delphi控件

    FLabel.Effect.Gradual.EndColor := $002210FF;
    FLabel.Effect.Outline := True;
    FLabel.Effect.Blur := 50;
  end;
  FLabel := Fonts.AddItem('Text3', '隶书', 11, clBlue, [], True, 1, 1);
  if Assigned(FLabel) then
  begin
    FLabel.Effect.Gradual.Enabled := True;
    FLabel.Effect.Gradual.Style := gsTopToBottom;
    FLabel.Effect.Gradual.StartColor := $00CC3311;
    FLabel.Effect.Gradual.EndColor := $00FF22AA;
  end;
end;

//默认文本创建默认标签
function TAAScrollText.UseDefaultLabels: Boolean;
begin
  Result := not FText.IsLinesStored;
end;

//控件属性已装载
procedure TAAScrollText.LoadedEx;
begin
  inherited;
  Reset;
end;

{ TScrollTextParam }

//--------------------------------------------------------//
//平滑滚动文本参数                                        //
//--------------------------------------------------------//

//初始化
constructor TScrollTextParam.Create(AOwner: TAAGraphicControl;
  ChangedProc: TNotifyEvent);
begin
  inherited;
  TStringList(Lines).Text := csAAScrollTextCopyRight;
  FFade := True;
  FFadeHeight := 10;
  FHeadSpace := 0;
  FTailSpace := 60;
  Alignment := taCenter;
  BackGroundMode := bmTiled;
end;

//释放
destructor TScrollTextParam.Destroy;
begin
  inherited;
end;

//设置淡入淡出
procedure TScrollTextParam.SetFade(const Value: Boolean);
begin
  if FFade <> Value then
  begin
    FFade := Value;
    Changed;
  end;
end;

//设置淡入淡出高度
procedure TScrollTextParam.SetFadeHeight(const Value: Integer);
begin
  if FFadeHeight <> Value then
  begin
    FFadeHeight := Value;
    Changed;
  end;
end;

//设置头部空白
procedure TScrollTextParam.SetHeadSpace(const Value: Integer);
begin
  if FHeadSpace <> Value then
  begin
    FHeadSpace := Value;
    if FHeadSpace < 0 then
      FHeadSpace := 0;
    if FHeadSpace > 150 then
      FHeadSpace := 150;
    Changed;
  end;
end;

//设置尾部空白
procedure TScrollTextParam.SetTailSpace(const Value: Integer);
begin
  if FTailSpace <> Value then
  begin
    FTailSpace := Value;
    if FTailSpace < 0 then
      FTailSpace := 0;
    if FTailSpace > 150 then
      FTailSpace := 150;
    Changed;
  end;
end;

//文本内容是否存储
function TScrollTextParam.IsLinesStored: Boolean;
begin
  Result := Lines.Text <> csAAScrollTextCopyRight;
end;

{ TAAFadeText }

//--------------------------------------------------------//
//平滑特效渐隐文本控件                                    //
//--------------------------------------------------------//

//创建
constructor TAAFadeText.Create(AOwner: TComponent);
begin
  inherited;
  ControlStyle := ControlStyle + [csReplicatable];
  TextBmp := TBitmap.Create;
  TextBmp.PixelFormat := pf24bit;
  InBmp := TBitmap.Create;
  InBmp.PixelFormat := pf24bit;
  OutBmp := TBitmap.Create;
  OutBmp.PixelFormat := pf24bit;
  FadeTimer := TTimer.Create(Self);
  FadeTimer.Interval := 25;
  FadeTimer.Enabled := False;
  FadeTimer.OnTimer := OnFadeTimer;
  DelayTimer := TTimer.Create(Self);
  DelayTimer.Enabled := False;
  DelayTimer.OnTimer := OnDelayTimer;
  FText := TFadeTextParam.Create(Self, OnLabelChanged);
  FLineIndex := -1;
  FFadeProgress := 0;
  FRepeatCount := 0;
  FRepeatedCount := 0;
  FActive := True;
  Color := clWhite;
  LastText := '';
  CurrText := '';
  NewProg := 0;
  SetBounds(0, 0, 240, 34);
end;

//创建默认字体标签
procedure TAAFadeText.CreateDefFonts;
var
  FLabel: TFontLabel;
begin
  inherited;
  FLabel := Fonts.AddItem('Title4', '隶书', 22, clBlack, [], True, 2, 2);
  if Assigned(FLabel) then
  begin
    FLabel.Effect.Gradual.Enabled := True;
    FLabel.Effect.Gradual.Style := gsLeftToRight;
    FLabel.Effect.Gradual.StartColor := $00FF2200;
    FLabel.Effect.Gradual.EndColor := $002210FF;
    FLabel.Effect.Outline := True;
    FLabel.Effect.Blur := 50;
  end;
  FLabel := Fonts.AddItem('Text3', '隶书', 11, clBlue, [], True, 1, 1);
  if Assigned(FLabel) then
  begin
    FLabel.Effect.Gradual.Enabled := True;
    FLabel.Effect.Gradual.Style := gsTopToBottom;
    FLabel.Effect.Gradual.StartColor := $00CC8811;
    FLabel.Effect.Gradual.EndColor := $00FF22AA;
  end;
end;

//释放
destructor TAAFadeText.Destroy;
begin
  FText.Free;
  DelayTimer.Free;
  FadeTimer.Free;
  OutBmp.Free;
  InBmp.Free;
  TextBmp.Free;
  inherited;
end;

//绘制渐隐图
procedure TAAFadeText.DrawFadeBmp(AText: string; Bmp: TBitmap);
var
  OffPoint: TPoint;
  th, tw: Integer;
begin
  AAFont.Canvas := Bmp.Canvas;
  if Text.LabelEffect = leOnlyALine then
  begin
    Bmp.Canvas.Font.Assign(Font);
    AAFont.Effect.Assign(Text.FontEffect);
    CurrAlign := Text.Alignment;
  end;
  Fonts.Check(AText, Bmp.Canvas.Font, AAFont.Effect); //检查字体标签
  Labels.Check(AText, CurrAlign); //检查用户标签
  th := AAFont.TextHeight(AText); //文本高度
  tw := AAFont.TextWidth(AText); //文本宽度
  case CurrAlign of           //水平对齐方式
    taLeftJustify: OffPoint.x := 0;
    taRightJustify: OffPoint.x := ClientWidth - tw;
    taCenter: OffPoint.x := (ClientWidth - tw) div 2;
  end;
  case Text.Layout of         //垂直对齐方式
    tlTop: OffPoint.y := 0;
    tlCenter: OffPoint.y := (ClientHeight - th) div 2;
    tlBottom: OffPoint.y := ClientHeight - th;
  end;
  Bmp.Height := ClientHeight;
  Bmp.Width := ClientWidth;
  Bmp.Canvas.Brush.Color := Color;
  Bmp.Canvas.Brush.Style := bsSolid;
  if Text.Transparent then    //透明
  begin
    CopyParentImage(Bmp.Canvas); //复制父控件画布
  end else if not Text.IsBackEmpty then
  begin                       //绘制背景图
    DrawBackGround(Bmp.Canvas, Rect(0, 0, Bmp.Width, Bmp.Height),
      Text.BackGround.Graphic, Text.BackGroundMode);
  end else
  begin                       //填充背景色
    Bmp.Canvas.FillRect(ClientRect);
  end;
  Bmp.Canvas.Brush.Style := bsClear;
  AAFont.TextOut(OffPoint.x, OffPoint.y, AText); //平滑字体输出
end;

//渐隐到指定行
procedure TAAFadeText.FadeTo(Line: Integer);
begin
  if Text.Lines.Count <= 0 then
    Exit;
  if Line < 0 then
    Line := 0;
  if Line > Text.Lines.Count - 1 then
  begin
    Line := 0;
    Inc(FRepeatedCount);
    if (FRepeatCount > 0) and (FRepeatedCount >= FRepeatCount) then
    begin
      Active := False;
      FRepeatedCount := 0;
      FLineIndex := -1;
      FadeToStr('');
      if Assigned(OnComplete) then
        OnComplete(Self);
      Exit;
    end;
  end;
  FadeToStr(Text.Lines[Line]);
  FLineIndex := Line;
end;

//渐隐到下一行
procedure TAAFadeText.FadeToNext;
begin
  FadeTo(LineIndex + 1);
end;

//渐隐到指定文本
procedure TAAFadeText.FadeToStr(AText: string);
begin
  OutBmp.Assign(TextBmp);
  DrawFadeBmp(AText, InBmp);
  LastText := CurrText;
  CurrText := AText;
  FFadeProgress := 0;
  FadeTimer.Enabled := False;
  FadeTimer.Enabled := True;
  if DelayTimer.Enabled then
  begin
    DelayTimer.Enabled := False;
    DelayTimer.Enabled := True;
  end;
end;

//属性已装载
procedure TAAFadeText.LoadedEx;
begin
  inherited;
  CurrAlign := Text.Alignment;
  Reset;
  FRepeatedCount := 0;
  DelayTimer.Enabled := FActive;
  if FActive then
    OnDelayTimer(Self);
end;

//渐隐切换文本定时事件
procedure TAAFadeText.OnDelayTimer(Sender: TObject);
begin
  FadeToNext;
end;


//渐隐过程定时事件
procedure TAAFadeText.OnFadeTimer(Sender: TObject);
begin
  if Abs(NewProg - FadeProgress) > 1 then
    NewProg := FadeProgress;
  NewProg := NewProg + csMaxProgress * FadeTimer.Interval div Text.FadeDelay;
  if NewProg > csMaxProgress then
  begin
    NewProg := csMaxProgress;
    FadeTimer.Enabled := False;
  end;
  FadeProgress := Round(NewProg);
end;

//绘制控件画布
procedure TAAFadeText.PaintCanvas;
begin
  inherited;
  if Text.Transparent then
  begin                       //透明且完整重绘
    if FadeProgress = 0 then
      DrawFadeBmp(CurrText, TextBmp)
    else begin
      DrawFadeBmp(LastText, OutBmp);
      DrawFadeBmp(CurrText, InBmp);
    end;
  end;
  if FadeProgress <> 0 then   //渐隐中
    Blend(TextBmp, OutBmp, InBmp, FFadeProgress);
  Bitblt(Canvas.Handle, 0, 0, Width, Height, TextBmp.Canvas.Handle, 0, 0,
    SRCCOPY);
  if Assigned(OnPainted) then
    OnPainted(Self);
end;

//更新显示
procedure TAAFadeText.Reset;
begin
  if FadeProgress = 0 then
    DrawFadeBmp(CurrText, TextBmp)
  else begin
    DrawFadeBmp(LastText, OutBmp);
    DrawFadeBmp(CurrText, InBmp);
    Blend(TextBmp, OutBmp, InBmp, FFadeProgress);
  end;
  inherited;
end;

//设置活跃
procedure TAAFadeText.SetActive(const Value: Boolean);
begin
  if FActive <> Value then
  begin
    FActive := Value;
    DelayTimer.Enabled := FActive;
    if FActive then
    begin
      FRepeatedCount := 0;
      OnDelayTimer(Self);
    end;
  end;
end;

//设置渐隐进程
procedure TAAFadeText.SetFadeProgress(const Value: TProgress);
begin
  if FFadeProgress <> Value then
  begin
    FFadeProgress := Value;
    Paint;
  end;
end;

//设置当前行
procedure TAAFadeText.SetLineIndex(const Value: Integer);
begin
  if FLineIndex <> Value then
  begin
    FadeTo(FLineIndex);
  end;
end;

//设置总循环次数
procedure TAAFadeText.SetRepeatCount(const Value: TBorderWidth);
begin
  if FRepeatCount <> Value then
  begin
    FRepeatCount := Value;
    if FRepeatedCount >= FRepeatCount then
  end;
end;

//设置文本
procedure TAAFadeText.SetText(const Value: TFadeTextParam);
begin
  FText.Assign(Value);
end;

//是默认文本时创建默认标签
function TAAFadeText.UseDefaultLabels: Boolean;
begin
  Result := not FText.IsLinesStored;
end;

{ TFadeTextParam }

//--------------------------------------------------------//
//平滑特效渐隐文本参数                                    //
//--------------------------------------------------------//

//赋值
procedure TFadeTextParam.Assign(Source: TPersistent);
begin
  inherited;
  if Source is TFadeTextParam then
  begin
    FFadeDelay := TFadeTextParam(Source).FadeDelay;
    LineDelay := TFadeTextParam(Source).LineDelay;
  end;
end;

//创建
constructor TFadeTextParam.Create(AOwner: TAAGraphicControl;
  ChangedProc: TNotifyEvent);
begin
  inherited;
  TStringList(Lines).Text := csAAFadeTextCopyRight;
  FadeDelay := 600;
  LineDelay := 3000;
  Alignment := taCenter;
  Layout := tlCenter;
end;

//释放
destructor TFadeTe