在Delphi中如何实现文字的滚动？115分

Question

我也编过类似的程序。方法嘛，开始就象上面老兄说的，用文字标签，不过闪烁得太利害，用TextOut方法直接在窗体上写然后再刷新也不行，还是闪烁。最后解决的办法是用TStaticText控件，只有它在滚动时不闪烁，效果很好。你可以试试。

Answer 1

在内存中创建一个bitmap,首先在内存bitmap中textout or draw....然后画到窗口上.

Answer 2

to Triumph;TStaticText可以在什么地方下载？谢谢

Answer 3

您好!请教您是怎做[email protected]

Answer 4

用一个timer控件，和一个label控件，在timer中的事件中加入代码，大概的代码是label.top:=label.top-5;具体的你自己看着写就行了！

Answer 5

to yypp:TStaticText是delphi的标准控件，在Additional标签下，在一个下凹框里有个A的就是。

Answer 6

代码一，和代码二一起使用！{ Component "RunText V1.0" is a Panel with gradient and running text.  Udo Juerss
  57078 Siegen, Germany
  April 1999  e-mail: [email protected]
}unit
  RunText;interfaceuses
  Windows,Classes,Graphics,Controls,ExtCtrls,TTimer;
{------------------------------------------------------------------------------}type
  TDirection = (gdTopToBottom, gdBottomToTop, gdLeftToRight, gdRightToLeft);
  TAlign = (alNone,alClient);
  TColorCount = 1..255;
  TStyle = (rlNormal,rlRaised,rlLowered);
  TRunDirection  = (rdStatic,rdRightToLeft,rdLeftToRight,rdTopToBottom,rdBottomToTop);  TGradientParameter = class(TPersistent)
  private
    FGradientFill: Boolean;
    FDirection: TDirection;
    FBeginColor: TColor;
    FEndColor: TColor;
    FColorCount: TColorCount;
    procedure SetColor(Index: Integer; Value: TColor);
  public
    constructor Create;
  published
    property GradientFill: Boolean read FGradientFill write FGradientFill default True;
    property Direction: TDirection read FDirection write FDirection default gdTopToBottom;
    property BeginColor: TColor index 1 read FBeginColor write SetColor default clBlue;
    property EndColor: TColor index 2 read FEndColor write SetColor default clBlack;
    property ColorCount: TColorCount read FColorCount write FColorCount default 16;
  end;  TRunText = class(TCustomPanel)
  private
    FTimer: TThreadTimer;
    FLines: TStringList;
    FFont: TFont;
    FGradientParameter: TGradientParameter;
    FMaxStrings: Integer;
    FStyle: TStyle;
    FRunDirection: TRunDirection;
    FLineDist: Integer;
    FSteps: Integer;
    FSpeed: Integer;
    FRunning: Boolean;
    FColor: TColor;
    FUpperShadow: TColor;
    FLowerShadow: TColor;
    FShadow: Integer;
    FOnBegin: TNotifyEvent;
    FOnStep: TNotifyEvent;
    FOnEnd: TNotifyEvent;
    FOnNextLine: TNotifyEvent;
    CurrentStep: Integer;
    RTWidth: Integer;
    RTHeight: Integer;
    CnX: Integer;
    CnY: Integer;
    procedure FontChanged(Sender: TObject);
    procedure SetLines(Value: TStringList);
    procedure SetStyle(Value: TStyle);
    procedure SetFont(Value: TFont);
    procedure SetRunDirection(Value: TRunDirection);
    procedure SetColor(Value: TColor);
    procedure SetInteger(Index,Value: Integer);
    procedure SetRunning(Value: Boolean);
    procedure DoTextOut(ACanvas: TCanvas; X,Y: Integer; AText: string);
  protected
    procedure Paint; override;
    procedure TimerTick(Sender: TObject);
    procedure DrawText;
  public
    FStringPos: Integer;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function GetCurrentStep: Integer;
    procedure Step;
  published
    property BevelInner;
    property BevelOuter;
    property BevelWidth;
    property BorderStyle;
    property BorderWidth;
    property OnClick;
    property Gradient: TGradientParameter read FGradientParameter write FGradientParameter;
    property Lines: TStringList read FLines write SetLines;
    property LabelStyle: TStyle read FStyle write SetStyle default rlNormal;
    property Steps: Integer index 1 read FSteps write SetInteger default 1;
    property Speed: Integer index 2 read FSpeed write SetInteger default 30;
    property Shadow: Integer index 3 read FShadow write SetInteger default 1;
    property Running: Boolean read FRunning write SetRunning default True;
    property Color: TColor read FColor write SetColor default clBtnFace;
    property UpperShadow: TColor read FUpperShadow write FUpperShadow default clBtnHighlight;
    property LowerShadow: TColor read FLowerShadow write FLowerShadow default clBtnShadow;
    property Font: TFont read FFont write SetFont;
    property Direction: TRunDirection read FRunDirection write SetRunDirection default rdRightToLeft;
    property OnBegin: TNotifyEvent read FOnBegin write FOnBegin;
    property OnStep: TNotifyEvent read FOnStep write FOnStep;
    property OnEnd: TNotifyEvent read FOnEnd write FOnEnd;
    property OnNextLine: TNotifyEvent read FOnNextLine write FOnNextLine;
  end;
{------------------------------------------------------------------------------}procedure Register;
procedure GradientFill(Canvas: TCanvas; Rect: TRect; BeginColor,EndColor: TColor;
                       Direction: TDirection; Colors: Byte);implementation
{------------------------------------------------------------------------------}procedure Register;
begin
  RegisterComponents('Udo',[TRunText]);
end;
{------------------------------------------------------------------------------}constructor TRunText.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlStyle:=ControlStyle - [csOpaque];
  Width:=360;
  Height:=60;
  FColor:=clBtnFace;
  FUpperShadow:=clBtnHighlight;
  FLowerShadow:=clBtnShadow;
  FSteps:=1;
  FSpeed:=30;
  CurrentStep:=0;
  FShadow:=1;
  FLineDist:=50;
  FRunDirection:=rdBottomToTop;
  FRunning:=True;
  FStyle:=rlRaised;
  BevelInner:=bvLowered;
  BevelOuter:=bvRaised;
  BevelWidth:=2;
  FFont:=TFont.Create;
  with FFont do
  begin
    Name:='Arial';
    Size:=24;
    Style:=[fsBold,fsItalic];
    Color:=clMaroon;
  end;
  FFont.OnChange:=FontChanged;  FGradientParameter:=TGradientParameter.Create;  FLines:=TStringList.Create;
  FLines.Add('Component RunText');
  FLines.Add('1998 U.Juerss');
  FLines.Add('57078 Siegen');
  FLines.Add('Germany');
  FMaxStrings:=Pred(FLines.Count);
  FStringPos:=0;  FTimer:=TThreadTimer.Create(Self);
  FTimer.OnTimer:=TimerTick;
  FTimer.ThreadPriority:=tpTimeCritical;
  FTimer.Interval:=FSpeed;
  FTimer.Enabled:=True;
end;
{------------------------------------------------------------------------------}destructor TRunText.Destroy;
begin
  FFont.Free;
  FGradientParameter.Free;
  FLines.Free;
  Running:=False;
  if Assigned(FTimer) then FTimer.Free;
  inherited Destroy;
end;
{------------------------------------------------------------------------------}procedure TRunText.DoTextOut(ACanvas: TCanvas; x,y: Integer; AText: string);
begin
  with ACanvas do
  begin
    Font:=FFont;
    Brush.Style:=bsClear;
    case FStyle of
      rlRaised : begin
                   Font.Color:=FUpperShadow;
                   TextOut(x,y,AText);
                   Font.Color:=FLowerShadow;
                   TextOut(x + 2 * FShadow,y + 2 * FShadow,AText);
                  end;
      rlLowered : begin
                    Font.Color:=FLowerShadow;
                    TextOut(x,y,AText);
                    Font.Color:=FUpperShadow;
                    TextOut(x + 2 * FShadow,y + 2 * FShadow,AText);
                  end;
    end;
    Font.Color:=FFont.Color;
    TextOut(x + FShadow,y + FShadow,AText);
  end;
end;
{------------------------------------------------------------------------------}procedure TRunText.Paint;
begin
  inherited Paint;
end;
{------------------------------------------------------------------------------}procedure TRunText.DrawText;
var
  TmpBmp: TBitMap;
  I,StX,StY: Integer;
  R: TRect;
begin
  FMaxStrings:=Pred(FLines.Count);
  TmpBmp:=TBitMap.Create;
  try
    TmpBmp.Width:=Width;
    TmpBmp.Height:=Height;    with TmpBmp.Canvas do
    begin
      R:=ClientRect;
      I:=BorderWidth;
      if BevelInner <> bvNone then I:=I + BevelWidth;
      if BevelOuter <> bvNone then I:=I + BevelWidth;
      R:=Rect(R.Left + I,R.Top + I,R.Right - I,R.Bottom - I);
      Brush.Color:=Color;
      if Gradient.GradientFill then
        GradientFill(TmpBmp.Canvas,GetClientRect,Gradient.BeginColor,
                     Gradient.EndColor,Gradient.Direction,Gradient.ColorCount)
      else FillRect(R);      Font:=FFont;
      RTWidth:=TextWidth(FLines.Strings[FStringPos]) + 2 * FShadow;
      RTHeight:=TextHeight(FLines.Strings[FStringPos]) + 2 * FShadow;
      Brush.Color:=FColor;
      Brush.Style:=bsSolid;
    end;    if RTWidth >= Width then CnX:=0 else CnX:=(Width - RTWidth) div 2;
    if RTHeight >= Height then CnY:=0 else CnY:=(Height - RTHeight) div 2;    case FRunDirection of
      rdRightToLeft : begin
                        StY:=CnY;
                        StX:=Width - CurrentStep;
                      end;
      rdLeftToRight : begin
                        StY:=CnY;
                        StX:=-CurrentStep;
                      end;
      rdBottomToTop : begin
                        StX:=CnX;
                        StY:=Height - CurrentStep;
                      end;
      rdTopToBottom : begin
                        StX:=CnX;
                        StY:=CurrentStep - RTHeight;
                      end;
                 else begin
                        StX:=CnX;
                        StY:=CnY;
                      end;
    end;
    SetBkMode(TmpBmp.Canvas.Handle,Transparent);
    DoTextOut(TmpBmp.Canvas,StX,StY,FLines.Strings[FStringPos]);
    Canvas.CopyRect(R,TmpBmp.Canvas,R);
  finally
    TmpBmp.Free;
  end;
end;
{------------------------------------------------------------------------------}procedure TRunText.FontChanged(Sender: TObject);
begin
  with Canvas do
  begin
    Font:=FFont;
    RTWidth:=TextWidth(FLines.Strings[FStringPos]) + 2 * FShadow;
    RTHeight:=TextHeight(FLines.Strings[FStringPos]) + 2 * FShadow;
  end;  if RTWidth >= Width then CnX:=0 else CnX:=(Width - RTWidth) div 2;
  if RTHeight >= Height then CnY:=0 else CnY:=(Height - RTHeight) div 2;  if Sender = Self then Invalidate;
end;
{------------------------------------------------------------------------------}procedure TRunText.SetLines(Value: TStringList);
begin
  FLines.Clear;
  FLines.Assign(Value);
  FMaxStrings:=Pred(FLines.Count);
  FStringPos:=0;
end;
{------------------------------------------------------------------------------}procedure TRunText.SetStyle(Value: TStyle);
begin
  if FStyle <> Value then
  begin
    FStyle:=Value;
    FontChanged(Self);
  end;
end;
{------------------------------------------------------------------------------}procedure TRunText.SetRunDirection(Value: TRunDirection);
begin
  if FRunDirection <> Value then FRunDirection:=Value;
end;
{------------------------------------------------------------------------------}procedure TRunText.SetInteger(Index,Value: Integer);
begin
  case Index of
    1: if FSteps <> Value then FSteps:=Value;
    2: if FSpeed <> Value then
       begin
         FSpeed:=Value;
         if FTimer <> nil then FTimer.Interval:=FSpeed;
       end;
    3:  if FShadow <> Value then
        begin
          FShadow:=Value;
          FontChanged(Self);
        end;
  end;
end;
{------------------------------------------------------------------------------}procedure TRunText.SetColor(Value : TColor);
begin
  if FColor <> Value then
  begin
    FColor:=Value;
    FontChanged(Self);
  end;
end;
{------------------------------------------------------------------------------}procedure TRunText.SetFont(Value: TFont);
begin
  FFont.Assign(Value);
end;
{------------------------------------------------------------------------------}procedure TRunText.SetRunning(Value: Boolean);
begin
  if FRunning <> Value then
  begin
    FRunning:=Value;
    if FRunning then
    begin
      FTimer:=TThreadTimer.Create(Self);
      FTimer.Enabled:=True;
      FTimer.ThreadPriority:=tpTimeCritical;
      FTimer.OnTimer:=TimerTick;
      FTimer.Interval:=FSpeed;
    end
    else
    begin
      FTimer.Enabled:=False;
      FTimer.OnTimer:=nil;
      FTimer.Free;
      FTimer:=nil;
    end;
  end;
end;
{------------------------------------------------------------------------------}function TRunText.GetCurrentStep: Integer;
begin
  Result:=CurrentStep;
end;
{------------------------------------------------------------------------------}procedure TRunText.TimerTick(Sender: TObject);
begin
  if FTimer.Enabled then Step;
end;
{------------------------------------------------------------------------------}procedure TRunText.Step;
begin
  if CurrentStep = 0 then
  begin
    if (FStringPos = 0) and Assigned(FOnBegin) then FOnBegin(Self);
    if Assigned(FOnNextLine) then FOnNextLine(Self);
  end;
  if Assigned(FOnStep) then FOnStep(Self);
  Inc(CurrentStep,FSteps);
  if CurrentStep >= Height + RTHeight then
  begin
    CurrentStep:=0;
    Inc(FStringPos);
    if FStringPos > FMaxStrings then
    begin
      if Assigned(FOnEnd) then FOnEnd(Self);
      FStringPos:=0;
    end;
  end;
  DrawText;
end;
{------------------------------------------------------------------------------}constructor TGradientParameter.Create;
begin
  inherited Create;
  FGradientFill:=True;
  FDirection:=gdTopToBottom;
  FBeginColor:=clBlue;
  FEndColor:=clBlack;
  FColorCount:=16;
end;
{------------------------------------------------------------------------------}procedure TGradientParameter.SetColor(Index: Integer; Value: TColor);
begin
  case Index of
    1: FBeginColor:=Value;
    2: FEndColor:=Value;
  end;
end;
{------------------------------------------------------------------------------}procedure GradientFill(Canvas: TCanvas; Rect: TRect; BeginColor,EndColor: TColor;
                       Direction: TDirection; Colors: Byte);
var
  BeginRGBValue: array[0..2] of Byte;    // RGB Farbstartwerte
  RGBDifference: array[0..2] of Integer; // Differenz zwischen Start- und End RGB Werten
  ColorBand: TRect;                      // Farbrechteck Koordinaten
  I: Integer;                            // Index von Farbrecheck
  R,G,B: Byte;                           // Farbband RGB Werte
  begin
  case Direction of
    gdTopToBottom,gdLeftToRight:
    begin                                // RGB Farben setzen
      BeginRGBValue[0]:=GetRValue(ColorToRGB(BeginColor));
      BeginRGBValue[1]:=GetGValue(ColorToRGB(BeginColor));
      BeginRGBValue[2]:=GetBValue(ColorToRGB(BeginColor));
      // Differenzwerte zwischen Start- und Endfarben berechnen
      RGBDifference[0]:=GetRValue(ColorToRGB(EndColor)) - BeginRGBValue[0];
      RGBDifference[1]:=GetGValue(ColorToRGB(EndColor)) - BeginRGBValue[1];
      RGBDifference[2]:=GetBValue(ColorToRGB(EndColor)) - BeginRGBValue[2];
    end;
    gdBottomToTop,gdRightToLeft:
    begin                                // RGB Farben setzen und Farbwerte umkehren
      BeginRGBValue[0]:=GetRValue(ColorToRGB(EndColor));
      BeginRGBValue[1]:=GetGValue(ColorToRGB(EndColor));
      BeginRGBValue[2]:=GetBValue(ColorToRGB(EndColor));
                                        // Farbdifferenz berechnen und Richtungen umkehren
      RGBDifference[0]:=GetRValue(ColorToRGB(BeginColor)) - BeginRGBValue[0];
      RGBDifference[1]:=GetGValue(ColorToRGB(BeginColor)) - BeginRGBValue[1];
      RGBDifference[2]:=GetBValue(ColorToRGB(BeginColor)) - BeginRGBValue[2];
    end;
  end;
  case Direction of                      // Farbband Koordinaten berechnen
    gdTopToBottom,gdBottomToTop:
    begin
      ColorBand.Left:=Rect.Left;
      ColorBand.Right:=Rect.Right - Rect.Left;
    end;
    gdLeftToRight,gdRightToLeft:
    begin
      ColorBand.Top:=Rect.Top;
      ColorBand.Bottom:=Rect.Bottom - Rect.Top;
    end;
  end;
  with Canvas.Pen do
  begin                                  // Penstyle und mode setzen
    Style:=psSolid;
    Mode:=pmCopy;
  end;
  if Colors = 0 then Colors := 1;
  for I:=0 to Colors do                  // Farbband f黮len
  begin
    case Direction of                    
      gdTopToBottom,gdBottomToTop:       // Top und Bottom von Farbband berechnen
      begin
        ColorBand.Top:=Rect.Top + MulDiv(I,Rect.Bottom - Rect.Top,Colors);
        ColorBand.Bottom:=Rect.Top + MulDiv(I + 1,Rect.Bottom - Rect.Top, Colors);
      end;
      gdLeftToRight,gdRightToLeft:       // Left und Right von Farbband berechnen
      begin
        ColorBand.Left:=Rect.Left + MulDiv(I, Rect.Right - Rect.Left,Colors);
        ColorBand.Right:=Rect.Left + MulDiv(I + 1, Rect.Right - Rect.Left, Colors);
      end;
    end;
    if Colors > 1 then                   // Farben f黵 B鋘der berechnen
    begin
      R:=BeginRGBValue[0] + MulDiv(I,RGBDifference[0],Colors - 1);
      G:=BeginRGBValue[1] + MulDiv(I,RGBDifference[1],Colors - 1);
      B:=BeginRGBValue[2] + MulDiv(I,RGBDifference[2],Colors - 1);
    end
    else
    begin                                // Nur eine Farbe, dann Startfarbe setzen
      R:=BeginRGBValue[0];
      G:=BeginRGBValue[1];
      B:=BeginRGBValue[2];
    end;
    with Canvas do
    begin
      Brush.Color:=RGB(R,G,B);
      FillRect(ColorBand);
    end;
  end;
end;
{------------------------------------------------------------------------------}initialization
end.

Answer 7

代码二，和代码一一起使用！
unit
  TTimer;interfaceuses
  Windows,Classes;
{------------------------------------------------------------------------------}type
  TTimerThread = class(TThread)
  private
    FOwner: TComponent;
  protected
    procedure Execute; override;
  public
    FTerminate: Boolean;
    constructor Create(AOwner: TComponent);
  end;  TThreadTimer = class(TComponent)
  private
    FEnabled: Boolean;
    FInterval: Cardinal;
    FOnTimer: TNotifyEvent;
    FTimerThread: TTimerThread;
    FThreadPriority: TThreadPriority;
    procedure SetEnabled(Value: Boolean);
    procedure SetInterval(Value: Cardinal);
    procedure SetThreadPriority(Value: TThreadPriority);
  protected
    procedure Timer; dynamic;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property Enabled: Boolean read FEnabled write SetEnabled default True;
    property Interval: Cardinal read FInterval write SetInterval default 1000;
    property ThreadPriority: TThreadPriority read FThreadPriority write SetThreadPriority default tpNormal;
    property OnTimer: TNotifyEvent read FOnTimer write FOnTimer;
  end;
{------------------------------------------------------------------------------}procedure Register;implementationuses
  Forms,Consts;
{------------------------------------------------------------------------------}constructor TTimerThread.Create(AOwner: TComponent);
begin
  inherited Create(False);
  FOwner:=AOwner;
end;
{------------------------------------------------------------------------------}procedure TTimerThread.Execute;
begin
  Priority:=(FOwner as TThreadTimer).FThreadPriority;
  repeat
    if not FTerminate and (SleepEx((FOwner as TThreadTimer).Interval,False) = 0) 
      then Synchronize((FOwner as TThreadTimer).Timer);
  until FTerminate;
end;
{------------------------------------------------------------------------------}constructor TThreadTimer.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FEnabled:=True;
  FInterval:=1000;
  FThreadPriority:=tpNormal;
  FTimerThread:=TTimerThread.Create(Self);
end;
{------------------------------------------------------------------------------}destructor TThreadTimer.Destroy;
begin
  Enabled:=False;
  FOnTimer:=nil;
  if Assigned(FTimerThread) then
  begin
    FTimerThread.FTerminate:=True;
    FTimerThread.Terminate;
    FTimerThread.Free;
  end;
  inherited Destroy;
end;
{------------------------------------------------------------------------------}procedure TThreadTimer.SetEnabled(Value: Boolean);
begin
  if Value <> FEnabled then
  begin
    FEnabled:=Value;
    if Assigned(FTimerThread) then
      if FEnabled then FTimerThread.Suspend else FTimerThread.Resume;
  end;    
end;
{------------------------------------------------------------------------------}procedure TThreadTimer.SetInterval(Value: Cardinal);
begin
  if Value <> FInterval then FInterval:=Value;
end;
{------------------------------------------------------------------------------}procedure TThreadTimer.SetThreadPriority(Value: TThreadPriority);
begin
  if Value <> FThreadPriority then
  begin
    FThreadPriority:=Value;
    if Assigned(FTimerThread) then FTimerThread.Priority:=Value;
  end;
end;
{------------------------------------------------------------------------------}procedure TThreadTimer.Timer;
begin
  if FEnabled and Assigned(FOnTimer) then FOnTimer(Self);
end;
{------------------------------------------------------------------------------}procedure Register;
begin
  RegisterComponents('Udo',[TThreadTimer]);
end;
{------------------------------------------------------------------------------}initialization
end.

Answer 8

unit Unit1;interfaceuses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls;type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Label1: TLabel;
    Panel2: TPanel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Timer1: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;var
  Form1: TForm1;implementation{$R *.DFM}procedure TForm1.FormCreate(Sender: TObject);
var hr :thandle;
begin
     Label1.Caption:='设计：王    华'+#13+#13+'编程：席建江'+#13+#13+'测试：青    君'+#13+#13+'配音：王玉江';
end;procedure TForm1.Timer1Timer(Sender: TObject);
begin
     Label1.Top:=Label1.Top-1;
     if(Label1.Top < -Label1.Width-30) then
         Label1.Top:=Panel1.Height;
end;end.