寻找能够实现字幕渐出的完整程序(100分)

程序要把一个文本文件在屏幕上缓慢输出,完全输出后再从头循环输出
1.通过选择字幕飞入方式控制字幕渐出,基本方式有两种:从底部向上渐出;从侧面飞入多行,然后向上渐出.
2.能够设置字体(含字体颜色),每行字符数,每行字符高度,两行字符间隔,字符出现位置,字符消失位置.
3.侧面飞入方式能够设置飞入几行后开始向上移动.
看了以下以前的贴子,自己做的时候还是困难重重.
请把源程序(Form等)发到我的邮箱:jjdelphi@163.net,也请在此讨论

该问题在delphi开发指南中有现成的例子, 可满足的要求。

挺花俏的啊！！

我没有这本书阿

用一个timer就可以了啊。
举个例子给你。
一个EDIT 和TIMER
PROCEDURE TFORM1.TIMER1TIMER(SENDER:tOBJECT);
BEGIN
EDIT1.LEFT:=EDIT1.LEFT +1;
EDIT1.TOP:=EDIT1.TOP+1;
END;
你自己举一反三吧。

可不向Lovefox说的那么简单，下面是一个练习:

unit UShowText;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls, jpeg, ComCtrls, Buttons ;

type
TForm1 = class(TForm)
Button1: TButton;
Timer1: TTimer;
Button2: TButton;
TrackBar1: TTrackBar;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
BitBtn1: TBitBtn;
Panel1: TPanel;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure TrackBar1Change(Sender: TObject);
private
procedure zShowText;
procedure zSetLineHeight;
procedure zBmpCreate;
procedure zSetBmp;
procedure zShowLine(sender :TObject);

public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

const
bWidth=200;
var
bmp :TBitMap;
sItem:TStringList;
iDc :HDC;
LineHeight,Currline:integer;
R1,bRect :TRect;

procedure TForm1.zShowText;
var j:integer;
begin
sItem:=TStringList.Create;
with sItem do
begin
for j:=1 to 12 do
begin
add('序号：'+inttostr(j)+' 这是第'+Inttostr(j)+'行');
end;
add('----------#@######---------------');
add('共有'+IntToStr(j-1)+'行');
end;

zBmpCreate;
sitem.Free;
end;

procedure TForm1.zShowLine(sender :TObject);
begin
zShowText;
end;

procedure Tform1.zBmpCreate;
var
i,y:integer;
begin
if bmp<>nil then bmp.free;
bmp:=TBitMap.Create;
// bmp.LoadFromFile('g:abc.bmp');
zSetBmp;

R1.Right:=bRect.Right;
R1.Bottom :=bRect.Bottom;

y:=Panel1.Height-100;
for i:=0 to sItem.Count-1 do
begin
R1.Top:=y;
R1.Bottom :=R1.top+LineHeight;
DrawText(bmp.Canvas.handle,pChar(sItem),-1,R1,dt_center or Dt_TOP);
Inc(y,LineHeight);
end;
end;

procedure TForm1.zSetBmp;
begin
zSetLineHeight;
With bRect do
begin
Top :=0;
Left :=0;
Right:=panel1.Width-2;
Bottom:=LineHeight*sItem.Count+Height;
end;
with Bmp do
begin
Height:=bRect.Bottom;
Width :=bRect.Right-7;

With Canvas do
begin
Font:=self.font;
font.Color :=Rgb(245,235,20);
Brush.Color:=clBlack;
FillRect(bRect);
Brush.Style:=bsClear;
end;
end;
end;

procedure TForm1.zSetLineHeight;
var
Metrics :TTextMetric;
begin
GetTextMetrics(iDc,Metrics);
LineHeight :=Metrics.tmHeight+Metrics.tmInternalLeading;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
label3.Caption :='间隔'#13'时间';
Label4.Caption :='100';
// idc:=Image1.Canvas.Handle;
iDC:=GetDc(Panel1.Handle);
Currline:=0;//LineHeight;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
if bmp<>nil then bmp.free;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
zShowLine(self);
BitBlt(iDc,7,50,Panel1.Width-14,Panel1.Height-100,
bmp.canvas.Handle,0,Currline,srcCopy);
Inc(Currline,1);//LineHeight);
if Currline>=bRect.Bottom-panel1.Height+200 then
begin
timer1.Enabled :=false;
Currline:=0;
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
Timer1.Enabled:=not Timer1.Enabled;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
timer1.Enabled :=false;
Currline:=0;//LineHeight;
button1.Click;
end;

procedure TForm1.TrackBar1Change(Sender: TObject);
begin
Timer1.Interval:=TrackBar1.Position*5;
Label4.Caption :=inttostr(Timer1.Interval);
end;

end

给你做了一个小程序，供参考：
{ Put a TImage and load a bitmap of 24 bits
or 32 bits; put a TButton and put this
code in its OnClick event }

procedure TForm1.Button1Click(Sender: TObject);
procedure FadeOut(const BMP:TImage; Pause:integer);
var
BytesPorScan: integer;
w,h: integer;
p: pByteArray;
counter: integer;
begin
{ This only works with 24 or 32 bits bitmaps }

If Not (BMP.Picture.Bitmap.PixelFormat in [pf24Bit, pf32Bit])
then raise exception.create('Error, bitmap format not supported.');

try
BytesPorScan := Abs ( Integer(BMP.Picture.Bitmap.ScanLine[1])-
Integer(BMP.Picture.Bitmap.ScanLine[0]));
except
raise exception.create('Error');
end;

{ Decrease the RGB components of each single pixel }
for counter := 1 to 256 do
begin
for h := 0 to BMP.Picture.Bitmap.Height - 1 do
begin
P := BMP.Picture.Bitmap.ScanLine[h];
for w := 0 to BytesPorScan - 1 do
if P^[w] >0 then P^[w] := P^[w]-1;
end;
Sleep(Pause);
BMP.Refresh;
end;
end; {procedure FadeOut}

begin
FadeOut(Image1, 5);
end;

to zhang w:你的程序很好，怎么从侧面飞入呢？

这个练习原是为了能在Caption上生成横向字幕的，大在概也就是jdelphi所说的侧面飞入吧？
程序的核心是将字符串先画到内存中的位图上相应的位置，再通过计时器将位图逐渐显示。
你只要将字符串横向画在位图上，将位图也横向逐渐显示，不就行了吗？同理，能实现多种
特技字幕。
另：你该送分了吧！

多人接受答案了。