Subject: 水平滚动控件实现左右往返滚动 [Print This Page]

---

Author: shangying    Time: 2008-11-27 18:50     Subject: 水平滚动控件实现左右往返滚动

有些方面需要左右往返滚动，修改一下即可实现，以下修改未考虑字幕超出长度的情况，有需要的朋友可以搞搞，修改完以后重新编译一下包即可



【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;

---

Author: Passion    Time: 2008-11-27 20:17

请问楼主这样的改动是否兼容以前的例子？如果兼容，可否将完整的文件发上来，我们合并入CnPack组件包的新版本中。

---

Welcome to CnPack Forum (http://bbs.cnpack.org/)

Powered by Discuz! 5.0.0