水平滚动控件实现左右往返滚动
有些方面需要左右往返滚动,修改一下即可实现,以下修改未考虑字幕超出长度的情况,有需要的朋友可以搞搞,修改完以后重新编译一下包即可
【CnAAFont.pas】
THoriScrollType = (stNone, stRightToLeft, stLeftToRight, stRoundtrip); // 加入stRoundtrip
{* 横向滚动类型
|<PRE>
stNone - 不动
stRightToLeft - 从右到左滚动
stLeftToRight - 从左到右滚动
stRoundtrip - 往返滚动
|</PRE>}
---------------------------------------------------------------------------------
【CnAACtrls.pas】
TCnAAMarqueeText = class(TCnAAGraphicControl)
{* 平滑字幕文本控件,用于文本的水平滚动显示}
private
...
FSteps: Integer; -> 修改为 FCaptionWidth: Integer;
constructor TCnAAMarqueeText.Create(AOwner: TComponent);
begin
...
FSteps := 0; -> 修改为 FCaptionWidth := 0;
...
end;
//复位
procedure TCnAAMarqueeText.Reset;
var
Bmp: TBitmap;
tActive: Boolean;
begin
...
FSteps := Bmp.Canvas.TextWidth(Caption) + Width;
-> 修改为 FCaptionWidth := Bmp.Canvas.TextWidth(Caption);
...
end;
//初始化
constructor TCnAAMarqueeText.Create(AOwner: TComponent);
begin
...
FTimer.Tag := 0; -> 插入
FTimer.Enabled := FActive;
...
end;
//定时器事件 ->修改为以下语句
procedure TCnAAMarqueeText.OnTimer(Sender: TObject);
begin
if not FTimer.Enabled or not Visible then Exit;
if FScrollType = stRoundtrip then
begin
if FTimer.Tag = 0 then
Inc(FCurrentStep, FScrollStep)
else
Dec(FCurrentStep, FScrollStep);
if FCurrentStep > Width - FCaptionWidth then
begin
FCurrentStep := Width - FCaptionWidth;
FTimer.Tag := 1;
end
else if FCurrentStep < 0 then
begin
FCurrentStep := 0;
FTimer.Tag := 0;
end;
Paint;
end
else begin
Inc(FCurrentStep, FScrollStep);
Paint;
if FCurrentStep >= FCaptionWidth + Width then
FCurrentStep := 0;
end;
end;
//绘制画布 -> 修改为一下语句
procedure TCnAAMarqueeText.PaintCanvas;
var
R: TRect;
X, Y: Integer;
lpPaint: tagPAINTSTRUCT;
MemBmp: TBitmap;
begin
...
if FScrollType = stRightToLeft then
X := Width - FCurrentStep
else if FScrollType = stLeftToRight then
X := - Canvas.TextWidth(Caption) + FCurrentStep
else
X := FCurrentStep;
...
end;
|