可滚动的字幕

Question

我想实现这样的功能：
    我以前曾经有这样一个例子是有图案背景的窗体上的字幕和背景一起向上滚动，但我想实现在一个有图案背景的窗体上有一个自下而上的滚动字幕，请问高手怎么实现，最好有源代码。

Answer 1

用label就可以，把label设置为透明，然后用Timer控制Top就可以了，判断如果到了最上面就把他放下来，最好打开双缓冲区，这样不会闪。

Answer 2

思路：放一个Timer控件，一个Label
根据label的移动速度设置时间间隔
在OnTime事件里：Label.Top := Label.Top + dictance

Answer 3

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  if Label1.Top>Form1.Height then
    Label1.Top:=-Label1.Height
    else
    Label1.Top:= Label1.Top+1;
  Form1.DoubleBuffered:=true;
end;

Answer 4

//MWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWM 
//  Scroll Text Component 
// Author: Jorge Abel Ayala Marentes 
// Created: 25/01/2001 
//MWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWM 
unit ScrollText; interface uses 
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 
  ExtCtrls; type 
  TColorType = (ctGreen, ctRed, ctBlue);   TScrollText = class(TComponent) 
  private 
    FText: String; 
    FTimer: TTimer; 
    FTextColor: TColorType; 
    vi_Mv, vi_St: Integer; 
    procedure SetText(const Value: String); 
    procedure CustomOnTimer(Sender: TObject); 
    procedure SetTextColor(const Value: TColorType); 
  protected 
  public 
    procedure ScrollText; 
    constructor Create(AOwner: TComponent);override; 
    destructor Destroy;override; 
  published 
    property Text: String read FText write SetText; 
    property TextColor: TColorType read FTextColor write SetTextColor; 
  end; procedure Register; implementation procedure Register; 
begin 
  RegisterComponents('prueba', [TScrollText]); 
end; { TScrollText } constructor TScrollText.Create(AOwner: TComponent); 
begin 
  inherited; 
  vi_Mv := 0; 
  vi_St := 1;   FTimer := TTimer.Create(Self); 
  with FTimer do 
  begin 
    Enabled := True; 
    Interval := 5; 
    OnTimer := CustomOnTimer; 
  end;   if not (AOwner.InheritsFrom(TForm)) then 
    raise Exception.Create('This Component can only be dropped on Forms!');   //Set the Forms Height 
  with (Owner as TForm) do 
  begin 
    Height := 90; 
    Color := clBlack; 
    BorderStyle := bsDialog; 
    Caption := ''; 
  end;   ScrollText; 
end;//end of TScrollText.Create 
//MWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWM procedure TScrollText.CustomOnTimer(Sender: TObject); 
begin 
  ScrollText;   //Move text 
  Inc(vi_Mv, vi_St); 
end;//end of TScrollText.CustomOnTimer 
//MWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWM destructor TScrollText.Destroy; 
begin 
  FTimer.Free; 
  inherited; 
end;//end of TScrollText.Destroy 
//MWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWM procedure TScrollText.ScrollText; 
var 
  Bitmap: TBitmap; 
  Rect: TRect; 
  vi_Counter: Integer; 
begin 
  if not (csDesigning in Self.ComponentState) then 
  begin 
    //Create a Bitmap to draw the text 
    Bitmap := TBitmap.Create; 
    try 
     //set Bitmap´s Height to equal the Message´s Height 
     Bitmap.Height := Bitmap.Canvas.TextHeight(Text);      //If the text has reaced the end then rewind 
     if vi_Mv >= Bitmap.Canvas.Textwidth(Text) then 
      vi_St:=-16;      //if its at the beginning, go forward 
     if vi_Mv <= 0 then 
       vi_St:=1;      //Set Bitmap&acute;s Width 
     Bitmap.Width := (Owner as TForm).Width div 4;      with Bitmap.Canvas do 
     begin 
       //We are Filling it with Solid Dark Green 
       Brush.Style:=bssolid; 
       //The colour goes BBGGRR in hex - look up TColor 
       case TextColor of 
         ctGreen: begin 
                    Brush.Color := $005000; 
                    Fillrect(ClipRect); 
                    Font.Color:=$00FF00; 
                  end; 
         ctRed:   begin 
                    Brush.Color := $000050; 
                    Fillrect(ClipRect); 
                    Font.color := $0000FF; 
                  end; 
         ctBlue:  begin 
                    Brush.Color := $500000; 
                    Fillrect(ClipRect); 
                    Font.color := $FF0000; 
                  end; 
       end; 
       Textout(-vi_Mv, 0, Text); 
       Rect := Cliprect; 
       //Enlarge the image to twice its original size 
       Bitmap.Height := Bitmap.Height * 2; 
       Bitmap.Width := Bitmap.Width * 2;        CopyRect(ClipRect, Bitmap.canvas, Rect); 
       //Set up pen for solid black 
       Pen.Style := pssolid; 
       Pen.Color := clblack;       //Draw a grid of lines across the bitmap in X+Y 
      for vi_Counter := 0 to Bitmap.Height div 2 do 
      begin 
        MoveTo(0, vi_Counter*2); 
        LineTo(Bitmap.width, vi_Counter*2); 
      end;       for vi_Counter:=0 to Bitmap.width div 2 do 
      begin 
       MoveTo(vi_Counter*2,0); 
       LineTo(vi_counter*2,Bitmap.height); 
      end;       //Stretch bitmap again and draw twice its size on the form 
      Rect := Bitmap.Canvas.ClipRect; 
      Rect.Bottom := Rect.Bottom*2; 
      Rect.Right:= Rect.Right*2; 
      (Owner as TForm).Canvas.StretchDraw(Rect,Bitmap); 
    end; 
    finally 
      Bitmap.Free; 
    end; 
  end; 
end;//end of TScrollText.ScrollText 
//MWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWM procedure TScrollText.SetText(const Value: String); 
begin 
  if Value <> FText then 
    FText := Value;   ScrollText; 
end;//end of TScrollText.SetText 
//MWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWM procedure TScrollText.SetTextColor(const Value: TColorType); 
begin 
  if FTextColor <> Value then 
    FTextColor := Value; 
end;//end of TScrollText.SetTextColor 
//MWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWMWM end.

Answer 5

哇，楼上的那么复杂，吓死我了
放一个timer控件，然后在属性里设好移动的频率，然后就是两句代码：label1.left:=label1.left+1（左右移动）
label1.top:=label1.top+1（上下移动）
到达边界有一个判断：
if label1.left>form1.width then
  label1.left:=-label1.width;
没了

Answer 6

我晕我也做过,好做的，
timer,和label就行了用不了那么多的代码的

Answer 7

去看看Delphi 6开发者指南吧，里面有一个完整的实现方法

Answer 8

反复去试，发现用TextOut方法实现在背景图上滚动效果一些也不好，最好的还是楼上诸兄弟所说Image+Timer+Label+窗体双缓冲，你调一下Label在Image上的位置，参考一下：
var
  y: Integer;{$R *.dfm}procedure TForm1.FormCreate(Sender: TObject);
begin
  tmr.Interval := 25;
  Label1.Transparent := true;
  Label1.Caption := '我是一匹来自北方的狼' + #13 +
                    '流浪在无垠旷野中';
  self.DoubleBuffered := true;
end;procedure TForm1.tmrTimer(Sender: TObject);
begin
  y := y - 1;
  if y < 0 then y := 200;
  Label1.Top := y;
end;

Answer 9

同意weizi2000(秋风啊-秋的叹息) 的

Answer 10

TO yijiuqiliu (无名者之天下无敌)  
procedure TForm1.Timer1Timer(Sender: TObject);
begin
 label1.width:=300;
label1.Caption:='测试通过，可以根据你的需要修改一下就可以了';
 if (label1.top+label1.Height)<=form1.Top then
Label1.Top:=SpeedButton1.top //将SpeedButton1放在Form1的低部，作为判断
else
label1.top:=label1.top-1;end;procedure TForm1.FormShow(Sender: TObject);
begin
SpeedButton1.caption:='我要退出';
timer1.Enabled:=true;
end;procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
close;
end;

Answer 11

用label不就行么，还那么麻烦

Answer 12

用TextOut和Label都不行的，除非你的是P4 3.0以上CPU.
想要真正的平滑移动必须把内容先绘制到一个Bitmap里，再用BitBlt贴图。

Answer 13

你可以去下载个AAFont控件用，非常好用，他就是用Bitblt的，有源码的。
在www.2ccc.com有下载。

Answer 14

用CANVAS直接TXTOUT 这个方法也不错的！我试过！