CnPack Forum


 
Subject: 水平滚动控件实现左右往返滚动
shangying
新警察
Rank: 1



UID 41344
Digest Posts 1
Credits 21
Posts 3
点点分 21
Reading Access 10
Registered 2008-11-26
Status Offline
Post at 2008-11-27 18:50  Profile | Blog | P.M.  | QQ
水平滚动控件实现左右往返滚动

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



【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;
Top
Passion (LiuXiao)
管理员
Rank: 9Rank: 9Rank: 9


UID 359
Digest Posts 19
Credits 6838
Posts 3591
点点分 6838
Reading Access 102
Registered 2004-3-28
Status Offline
Post at 2008-11-27 20:17  Profile | Blog | P.M. 
请问楼主这样的改动是否兼容以前的例子?如果兼容,可否将完整的文件发上来,我们合并入CnPack组件包的新版本中。
Top
 




All times are GMT++8, the time now is 2024-11-22 12:14

    本论坛支付平台由支付宝提供
携手打造安全诚信的交易社区 Powered by Discuz! 5.0.0  © 2001-2006 Comsenz Inc.
Processed in 0.007810 second(s), 7 queries , Gzip enabled

Clear Cookies - Contact Us - CnPack Website - Archiver - WAP