如何实现文本字幕的滚动，象其他软件的about对话框一样？我急用呀？

Question

用两个bitmap,一个显示，一个后台缓冲，textout文本到上面去

Answer 1

直接textout 改坐标就可以了

Answer 2

用timer控件控制滚动和滚动速度
每隔一段时间修改文本坐标

Answer 3

{
这是《Delphi5 开发人员指南 》中的一个组件，包含在一个包中，现在
我把它分离出来，可以加到VCL的Samples页中，效果达到影视专业级。
它的实现原理是先把需要输出的文本拷贝到内存，再从内存中拷由到画布
把本组件加到窗体上后，在组件的Items属性中添加你要输出的文本，
并设置对齐方式
}
unit Marquee;interfaceuses
  SysUtils, Windows, Classes, Forms, Controls, Graphics,
  Messages, ExtCtrls, Dialogs;const
  ScrollPixels = 1;     // 每次移动的点数，数值越小越平滑，最小为1
  TimerInterval = 50;   // 两次移动之间的时间间隔，你可以修改这两个数的缺省值type
  TJustification = (tjCenter, tjLeft, tjRight);  EMarqueeError = class(Exception);  TddgMarquee = class(TCustomPanel)
  private
    MemBitmap: TBitmap;
    InsideRect: TRect;
    FItems: TStringList;
    FJust: TJustification;
    FScrollDown: Boolean;
    LineHi : Integer;
    CurrLine : Integer;
    VRect: TRect;
    FTimer: TTimer;
    FActive: Boolean;
    FOnDone: TNotifyEvent;
    procedure SetItems(Value: TStringList);
    procedure DoTimerOnTimer(Sender: TObject);
    procedure PaintLine(R: TRect; LineNum: Integer);
    procedure SetLineHeight;
    procedure SetStartLine;
    procedure IncLine;
    procedure SetActive(Value: Boolean);
  protected
    procedure Paint; override;
    procedure FillBitmap; virtual;
  public
    property Active: Boolean read FActive write SetActive;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property ScrollDown: Boolean read FScrollDown write FScrollDown;
    property Justify: TJustification read FJust write FJust default tjCenter;
    property Items: TStringList read FItems write SetItems;
    property OnDone: TNotifyEvent read FOnDone write FOnDone;
    { Publish inherited properties: }
    property Align;
    property Alignment;
    property BevelInner;
    property BevelOuter;
    property BevelWidth;
    property BorderWidth;
    property BorderStyle;
    property Color;
    property Ctl3D;
    property Font;
    property Locked;
    property ParentColor;
    property ParentCtl3D;
    property ParentFont;
    property Visible;
    property OnClick;
    property OnDblClick;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnResize;
  end;procedure Register;implementation{$R *.DCR}  {组件的图标文件，用Image Editor建立一个"Marquee.dcu"文件
            (Marquee.dcu与本程序文件应在同一目录下)在其中包含一个
            名为TDDGMARQUEE的24×24×16色位图。
            此句可删除，VCL将用缺省的图标。}constructor TddgMarquee.Create(AOwner: TComponent);
{ constructor for TddgMarquee class }  procedure DoTimer;
  { procedure sets up TddgMarquee's timer }
  begin
    FTimer := TTimer.Create(Self);
    with FTimer do
    begin
      Enabled := False;
      Interval := TimerInterval;
      OnTimer := DoTimerOnTimer;
    end;
  end;begin
  inherited Create(AOwner);
  FItems := TStringList.Create;  { instanciate string list }
  DoTimer;                       { set up timer }
  { set instance variable default values }
  Width := 100;
  Height := 75;
  FActive := False;
  FScrollDown := False;
  FJust := tjCenter;
  BevelWidth := 3;
end;destructor TddgMarquee.Destroy;
{ destructor for TddgMarquee class }
begin
  SetActive(False);
  FTimer.Free;             // free allocated objects
  FItems.Free;
  inherited Destroy;
end;procedure TddgMarquee.DoTimerOnTimer(Sender: TObject);
{ This method is executed in respose to a timer event }
begin
  IncLine;
  { only repaint within borders }
  InvalidateRect(Handle, @InsideRect, False);
end;procedure TddgMarquee.IncLine;
{ this method is called to increment a line }
begin
  if not FScrollDown then       // if Marquee is scrolling upward
  begin
    { Check to see if marquee has scrolled to end yet }
    if FItems.Count * LineHi + ClientRect.Bottom -
      ScrollPixels  >= CurrLine then
      { not at end, so increment current line }
      Inc(CurrLine, ScrollPixels)
    else SetActive(False);
  end
  else begin                   // if Marquee is scrolling downward
    { Check to see if marquee has scrolled to end yet }
    if CurrLine >= ScrollPixels then
      { not at end, so decrement current line }
      Dec(CurrLine, ScrollPixels)
    else SetActive(False);
  end;
end;procedure TddgMarquee.SetItems(Value: TStringList);
begin
  if FItems <> Value then
    FItems.Assign(Value);
end;procedure TddgMarquee.SetLineHeight;
{ this virtual method sets the LineHi instance variable }
var
  Metrics : TTextMetric;
begin
  { get metric info for font }
  GetTextMetrics(Canvas.Handle, Metrics);
  { adjust line height }
  LineHi := Metrics.tmHeight + Metrics.tmInternalLeading;
end;procedure TddgMarquee.SetStartLine;
{ this virtual method initializes the CurrLine instance variable }
begin
  // initialize current line to top if scrolling up, or...
  if not FScrollDown then CurrLine := 0
  // bottom if scrolling down
  else CurrLine := VRect.Bottom - Height;
end;procedure TddgMarquee.PaintLine(R: TRect; LineNum: Integer);
{ this method is called to paint each line of text onto MemBitmap }
const
  Flags: array[TJustification] of DWORD = (DT_CENTER, DT_LEFT, DT_RIGHT);
var
  S: string;
begin
  { Copy next line to local variable for clarity }
  S := FItems.Strings[LineNum];
  { Draw line of text onto memory bitmap }
  DrawText(MemBitmap.Canvas.Handle, PChar(S), Length(S), R,
    Flags[FJust] or DT_SINGLELINE or DT_TOP);
end;procedure TddgMarquee.FillBitmap;
var
  y, i : Integer;
  R: TRect;
begin
  SetLineHeight;                 // set height of each line
  { VRect rectangle represents entire memory bitmap }
  VRect := Rect(0, 0, Width, LineHi * FItems.Count + Height * 2);
  { InsideRect rectangle represents interior of beveled border }
  InsideRect := Rect(BevelWidth, BevelWidth, Width - (2 * BevelWidth),
    Height - (2 * BevelWidth));
  R := Rect(InsideRect.Left, 0, InsideRect.Right, VRect.Bottom);
  SetStartLine;
  MemBitmap.Width := Width;      // initialize memory bitmap
  with MemBitmap do
  begin
    Height := VRect.Bottom;
    with Canvas do
    begin
      Font := Self.Font;
      Brush.Color := Color;
      FillRect(VRect);
      Brush.Style := bsClear;
    end;
  end;
  y := Height;
  i := 0;
  repeat
    R.Top := y;
    PaintLine(R, i);
    { increment y by the height (in pixels) of a line }
    inc(y, LineHi);
    inc(i);
  until i >= FItems.Count;      // repeat for all lines
end;procedure TddgMarquee.Paint;
{ this virtual method is called in response to a }
{ Windows paint message }
begin
  if FActive then
    { Copy from memory bitmap to screen }
    BitBlt(Canvas.Handle, 0, 0, InsideRect.Right, InsideRect.Bottom,
      MemBitmap.Canvas.Handle, 0, CurrLine, srcCopy)
  else
    inherited Paint;
end;procedure TddgMarquee.SetActive(Value: Boolean);
{ called to activate/deactivate the marquee }
begin
  if Value and (not FActive) and (FItems.Count > 0) then
  begin
    FActive := True;                // set active flag
    MemBitmap := TBitmap.Create;
    FillBitmap;                     // Paint Image on bitmap
    FTimer.Enabled := True;         // start timer
  end
  else if (not Value) and FActive then
  begin
    FTimer.Enabled := False;   // disable timer,
    if Assigned(FOnDone)       // fire OnDone event,
      then FOnDone(Self);
    FActive := False;          // set FActive to False
    MemBitmap.Free;            // free memory bitmap
    Invalidate;                // clear control window
  end;
end;procedure Register;
begin
  RegisterComponents('Samples', [TddgMarquee]);
end;end.

Answer 4

怎么加到sample组建当中去呀？

Answer 5

1.首先打开Marquee.pas程序文件，选菜单中的Component下的Install Component项。2.进入Install Component对话框，你可以选新建一个包"Into new package"。3.在Into new package的Unit file name输入包的文件名并设置路径后"OK",如果你  对包不熟悉，最好将路径设置为Marquee.pas所在目录。4.在Package窗口中选Options项，再选Directories/Conditionals将顶部两项的
  
  路径设置为Marquee.pas文件所在目录,用于编译后的文件存放目录。5.回到Package对话框Compile编译组件，成功后按Install安装即可。

Answer 6

上面的组件已经在Win98+Delphi5.0中通过。

Answer 7

快在帮帮我！我在2000下Delphi5中按照上面的方法，可就是不行？
问题是“file not find marquee.dcr”然后就编译不过去。还有如果包的名字和文件名同名的话还会返回如下错误：“identifier redeclared:marquee”快快再帮我一次。谢谢！！！

Answer 8

用label会闪的
用statictext不会闪
用一个变量与TTimmer控件来设置statictext的top属性就行了

Answer 9

用DriectX for Delphi组件吧，保证没有闪动！！！在网上到处都有下载，而且使用比VC＋＋中
更方便。

Answer 10

你再看看程序文件中下面的注释：(上面错写成Marquee.dcu了){$R *.DCR}  {组件的图标文件，用Image Editor建立一个"Marquee.dcr"文件
            (Marquee.dcu与本程序文件应在同一目录下)在其中包含一个
            名为TDDGMARQUEE的24×24×16色位图。
            此句可删除，VCL将用缺省的图标。}包的名字可以换一下。

Answer 11

要想使文本滚动还要在主窗口的OnCreate事件中加入如下代码：procedure TForm1.FormCreate(Sender: TObject);
begin
  ddgMarquee1.Active:=True;
end;ddgMarquee1的ScrollDown属性表示滚动的方向，可以从上向下。最好把ddgMarquee1.BevelInner和ddgMarquee1.BevelOuter均设置为bvNone

Answer 12

我有示例,你可以试一下（BCB)
简单示例：
在private:// User declarations中声明int x;
在Form1上拖放Image1 Timer1 Button1
void __fastcall TForm1::FormCreate(TObject *Sender)
{
  Timer1->Interval=10;
  x=Image1->Height+20;
  Image1->Canvas->Brush->Color=clBlack;
  Image1->Canvas->FillRect(Rect(0,0,Image1->Width,Image1->Height));
  Image1->Canvas->Refresh();//先填充Image1背景
}
//---------------------------------------------------------------------------
void __fastcall TForm1::Timer1Timer(TObject *Sender)
{
  x-=1;
  if (x<-100)  //字幕移出顶部
  {
      x=Image1->Height+20;
  }
  Image1->Canvas->Font->Size=12;
  Image1->Canvas->Font->Color=clWhite;
  Image1->Canvas->TextOut
                (0,x,"                    简单应用：                ");
  Image1->Canvas->TextOut(0,x+30,"        行距由字体大小决定 ");
  Image1->Canvas->TextOut(0,x+60,"  内容可从Memo或文件中读取");
}
//---------------------------------------------------------------------------
void __fastcall TForm1::Button1Click(TObject *Sender)
{
  Timer1->Enabled =false;
  Close();
}

Answer 13

RxLib控件包中有一个实现你所要求的控件，是RX Tools页的SecretPanel控件

Answer 14

RX Tools页的SecretPanel控件 和上面的控件基本是一样的