滚动显示，希望可以加入精华贴；

Question

将不同的字幕滚动显示在某一容器中；
不同的字幕又连接不同的操作，如何实现？相当于滚动的超连接；
将仅有的82分送上，希望大家可以帮我解决；谢谢；

Answer 1

//easy!
//////////
unit ScrollingLabel_San;interface
uses
windows,sysutils,classes,extctrls,stdctrls,controls;type
  TScrollingLabel_San=class(TLabel)
  private
  protected
    Timer:TTimer;
    CurrentIndex:integer;
    TotalString:string;
    ShowAll:boolean;
    Spaces:integer;
    procedure ClearText;
    function AddSpaces(AStr:string;Count:integer):string;
    procedure OnTimer(Sender:TObject);
    function GetLastSpace:integer;
    function GetTextWidth:integer;
  public
    procedure SetString(AStr:string);
    function GetString:string;
    function IsGoing:boolean;
    function GetInterval:integer;
    procedure SetInterval(new:integer);
    procedure Start;
    procedure Pause;
    procedure Go;
    constructor Create(AOwner:TWinControl;AString:string;RefreshInterval:integer;StartNow:boolean=true);
    destructor Destroy;override;
  end;
implementation{ TScrollingLabel_San }function TScrollingLabel_San.AddSpaces(AStr: string;
  Count: integer): string;
var
i:integer;
begin
result:=astr;
  for i:=1 to count do
  begin
    result:=result+' ';
  end;
end;procedure TScrollingLabel_San.ClearText;
begin
  canvas.FillRect(canvas.ClipRect);
end;constructor TScrollingLabel_San.Create(AOwner: TWinControl;AString:string; RefreshInterval: integer; StartNow: boolean);
begin
  inherited create(aowner);
  self.Alignment:=taRightJustify;
  //parent:=aowner;
  autosize:=false;
  width:=30;
  height:=18;
  timer:=ttimer.Create(self);
  timer.Interval:=refreshinterval;
  timer.OnTimer:=self.ontimer;
  timer.Enabled:=startnow;
  
  totalstring:=astring;  currentindex:=1;end;destructor TScrollingLabel_San.Destroy;
begin
  timer.Free;
  inherited;
end;function TScrollingLabel_San.GetInterval: integer;
begin
  result:=timer.Interval;
end;function TScrollingLabel_San.GetLastSpace: integer;
var
j,i:integer;
begin
  j:=0;
  for i:=length(caption) downto 1 do
  begin
    if caption[i]<>' ' then break;
    inc(j);
  end;
  result:=j;
end;function TScrollingLabel_San.GetString: string;
begin
  result:=totalstring;
end;function TScrollingLabel_San.GetTextWidth: integer;
begin
  result:=canvas.TextWidth(copy(totalstring,currentindex,length(totalstring)));
end;procedure TScrollingLabel_San.Go;
begin
  timer.Enabled:=true;
end;function TScrollingLabel_San.IsGoing: boolean;
begin
  result:=timer.Enabled;
end;procedure TScrollingLabel_San.OnTimer(Sender: TObject);
var
c:string;
begin
     if currentindex>length(totalstring) then
     begin
       c:=addspaces('',self.GetLastSpace);
       if canvas.TextWidth(c)<clientwidth then
         caption:=caption+' '
       else
         currentindex:=1;  
     end
     else
     begin
        caption:=copy(totalstring,1,currentindex);
        inc(currentindex);
     end; 
end;procedure TScrollingLabel_San.Pause;
begin
  timer.Enabled:=false;
end;procedure TScrollingLabel_San.SetInterval(new: integer);
begin
  timer.Interval:=new;
end;procedure TScrollingLabel_San.SetString(AStr: string);
begin
  totalstring:=astr;
end;procedure TScrollingLabel_San.Start;
begin
  caption:='';
  currentindex:=1;
  timer.Enabled:=true;
end;end.

Answer 2

“不同的字幕”用Label，“容器”用Panel，可以吗？
在一个Timer里写吧

Answer 3

TO  cornermoss(角落的青苔:射手无弓?你混得太糗了吧~) 
那个应该不行的，会有闪动的；

Answer 4

TO stanely(俺是邢她汉子) 
你那个也只是可以滚动显示，而并没有让它可以打开其它事件的功能

Answer 5

刚给你的就是个类
你看public部分，就那几个函数，很容易使用！一个实例就是一个label，可以滚动，但是目前只能从右向左滚动。

Answer 6

谢谢，我以前没有用过，试一试；
有DEMO吗？

Answer 7

我有控件，很漂亮的。
需要的话， 发EMail给我  [email protected]
我明天发给你。

Answer 8

使用n个label+1个timer很简单的就做出来了，如果不会，我给你作个例子

Answer 9

这个问题，其实Didi已经解决了啊，他那个软件上边就有的；
再者，好像不是用n个Label 的，不太清楚

Answer 10

To xgto(陪我去看流星雨，可以吗？) 
  哈好久不见呀!现在还好吗?Didi ~~~ 还记得我呢!^o^我的那个也闪只是闪的小没Image那么夸张！ 一般看不出来 不过我用本本运行 就能看出来了……DirectX一点不闪 解决方法可以用DelphiX实现 无闪滚动 而且要加什么有什么呀!哈哈~~

Answer 11

我也觉的加连接有点不好做的；
Didi，你用本本运行？切，什么本本？呵呵；
unit Main;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls;type
  TForm1 = class(TForm)
    Timer1: TTimer;
    procedure FormPaint(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    Procedure CanvasClear;
    Procedure ClearCanvas(ACanvas : TCanvas);
    Procedure ClearCanva;
    procedure FormActivate(Sender: TObject);
  private
    StrV : Array of String;
    { Private declarations }
  public
  LeftX,TopX : Integer;
  RT : TRect;
    { Public declarations }
  end;var
  Form1: TForm1;implementation{$R *.dfm}
procedure TForm1.CanvasClear;
var
  R : TRect ;
begin
  R.Left := Self.Left;
  R.Top := Self.Top;
  R.Right := Self.Left - Self.Width;
  R.Bottom :=  Self.Top + Self.Height ;
  with Canvas do
  begin
    Brush.Color := ClWhite;
    Canvas.FillRect(R);
  end;
end;procedure TForm1.FormPaint(Sender: TObject);
var
  Str : String;
  I : Integer;
begin
  I := 15;
  with Canvas do
  begin
    //ClearCanvas(Canvas);
    ClearCanva;
    Font.Color := clred;
    Str := '网络的懈怠';
    TextOut(leftX,TopX ,Str);
    Str := '曾经以为';
    TextOut(leftX,TopX + I,Str);
    Inc(I,15);
    Str := '自己将带着一颗心去流浪;';
    TextOut(leftX,TopX + I,Str);
    Inc(I,15);
    Str := '没有为自己设想过“家”、';
    TextOut(leftX,TopX + I,Str);
        Font.Color := clred;
    Str := '有的只有一颗飘零的心和影子相伴；';
    TextOut(leftX,TopX ,Str);
    Str := '就如：风筝断了线……';
    TextOut(leftX,TopX + I,Str);
    Inc(I,15);
    Str := '曾经以为';
    TextOut(leftX,TopX + I,Str);
    Inc(I,15);
    Str := '只有代码和流浪歌陪我上路；';
    TextOut(leftX,TopX + I,Str);
  end;
  DoubleBuffered := True;
end;procedure TForm1.Timer1Timer(Sender: TObject);
begin
  Inc(TopX,-20) ;
  Self.OnPaint(Sender);
end;procedure TForm1.ClearCanvas(ACanvas: TCanvas);
var
  R : TRect;
begin
  with ACanvas do
  begin
    Brush.Style := bsSolid;
    Brush.Color := ClWhite;
    GetWindowRect(Handle,R);
    R.TopLeft := ScreenToClient(R.TopLeft);
    R.BottomRight := ScreenToClient(R.BottomRight);
    FillRect(R);
  end;
end;procedure TForm1.ClearCanva;
begin
  with Canvas do
  begin
    Brush.Style := bsSolid;
    Brush.Color := ClWhite;
    FillRect(ClientRect);
  end;
end;procedure TForm1.FormActivate(Sender: TObject);
var
  R : TRect;
  GaoY : TextFile;
  I : Integer;
begin
  I := 0;
  AssignFile(GaoY , 'abc.txt');
  ReSet(GaoY);
  while Not Eof(GaoY) do
  begin
    Inc(I);
    Readln(GaoY);
  end;
  {CloseFile(GaoY);
  SetLength(StrV,I + 5);
  ReSet(GaoY);
  I := 1;  while Not Eof(GaoY) do
  begin
    Readln(GaoY,StrV[I],I);
    Inc(I);
  end;   }
  TopX := self.Top - 10 ;
  R := ClientRect;
  TopX := R.Bottom;
  LeftX := R.Left + 10;
  RT := ClientRect;
end;end.