如何实现字幕自动向上翻滚效果？
同时可以单独对字幕中的某些字进行色彩和大小进行设置（类似WORD中文字处理效果），最好不要直接用LABEL实现，听说效果不好（也欢迎介绍这方面的），希望了解的兄弟姐妹能把方法都介绍下，万分感谢！！！
同时可以单独对字幕中的某些字进行色彩和大小进行设置（类似WORD中文字处理效果），最好不要直接用LABEL实现，听说效果不好（也欢迎介绍这方面的），希望了解的兄弟姐妹能把方法都介绍下，万分感谢！！！
TSlidePict = class(TObject)
private
FCount : integer; //Slide Position
FContent: string; //Content to display
FCanvas: TCanvas; //On which the picture will be shown
FDelay : integer; //Slider delay
FTimer : TTimer; //
FRect : TRect; //Display area
FBitmap: TBitmap; //Temp bitmap procedure CreateTmpImage;
procedure SliderShow; public
constructor Create(ACanvas: TCanvas; ARect: TRect; AContent: string; ADelay: integer);
destructor Destroy; override; end;constructor TSlidePict.Create(ACanvas: TCanvas; ARect: TRect; AContent: string; ADelay: integer);
begin
inherited Create;
FContent := AContent;
FCount := 0;
FRect := TRect;
FCanvas := TCanvas;
FDelay := ADelay; FBitmap := nil;
CreateTmpImage; FTimer := TTimer.Create(nil);
FTimer.OnTimer := SliderShow;
FTimer.Interval:= ADelay;
FTimer.Enabled := true;
end;destructor TSlidePict.Destroy;
begin
if Assigned(FBitmap) then FreeAndNil(FBigmap);
if Assigned(FTimer) then FreeAndNIl(FTimer); inherited;
end;procedure CreateTmpImage;
begin
//这里我就不写了，其实就是在TBimap上写字
//如下：
if not Assigned(FBitmap) then
FBitmap:= TBitmap.Create; FBitmap.Width := FRect.Right - FRect.Left;
FBitmap.Height:= 1000; //这里要设置大一点，在画好后自己调整，调整方法就是计算画上去的文字的高度，不写了，用FBitmap.Canvas.TextHeight(FContent)来取得一行的高度，然后累加每一行的高度 DrawText(FBitmap.Canvas.Handle,
PChar(FContent), Length(FContent),
FRect,
DT_VCENTER or DT_LEFT or DT_WORDBREAK); //FBitmap.Height := ....;
end;procedure TSlidePict.SliderShow;
begin
if FBitmap.Height < FRect.Bottom - FRect.Top then
begin
if FCount < FBitmap.Height then
BitBlt(FCanvas.Handle,
FRect.Left, FRect.Bottom - FCount, FRect.Right - FRect.Left,
FCount, FBitmap.Canvas.Handle, 0, 0, SRCCOPY)
else if FCount > (FRect.Bottom - FRect.Top) then
BitBlt(FCanvas.Handle, FRect.Left, FRect.Top,
FRect.Right - FRect.Left,
FBitmap.Height - (FCount - (FRect.Bottom - FRect.Top)),
FBitmap.Canvas.Handle, 0, FCount - (FRect.Bottom - FRect.Top), SRCCOPY)
else
BitBlt(FCanvas.Handle, FRect.Left, FRect.Bottom - FCount,
FRect.Right - FRect.Left, FBitmap.Height, FImage.Canvas.Handle,
0, 0, SRCCOPY)
end
else begin
BitBlt(FCanvas.Handle, FRect.Left, FRect.Top,
FRect.Right - FRect.Left, FRect.Bottom- FRect.Top,
FBitmap.Canvas.Handle, 0, FCount, SRCCOPY);
end; inc(FCount);
if FBitmap.Height > (FRect.Bottom - FRect.Top) then
begin
if FCount > FBitmap.Height then
FCount := -(FRect.Bottom - FRect.Top);
end
else begin
if FCount > (FRect.Bottom - FRect.Top) + FBitmap.Height then
FCount := 0;
end;
end;
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls, ComCtrls;type
TForm1 = class(TForm)
Timer1: TTimer;
Edit1: TEdit;
Button2: TButton;
Panel1: TPanel;
Label1: TLabel;
procedure FormCreate(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
procedure zShowText;
Procedure zBmpCreate;
procedure zSetBmp;
procedure zSetLineHeight;
procedure zShowLine(sender :TObject);
{ Private declarations }
public
{ Public declarations }
end;var
Form1: TForm1;implementation{$R *.DFM}
var
currline, LineHeight:integer;
sItem:TStringList;
bmp:TBitMap;
bRect,R1:TRect;
iDc:HDC;procedure TForm1.FormCreate(Sender: TObject);
begin
Timer1.Enabled:=False;
iDC:=GetDc(Panel1.handle);
Currline:=0;
end;procedure TForm1.zShowLine(sender :TObject);
begin
zShowText;
end; procedure TForm1.Timer1Timer(Sender: TObject);
begin
zShowLine(self);//显示字符串
//bitblt 转移矩形图 (目标句柄，LS x,y,宽，高，源句柄，LS x,y,光栅运算符）
BitBlt(iDc,0,0,Panel1.Width,Panel1.Height,
Bmp.Canvas.Handle,0,Currline,srcCopy); //改变currline可实现左移右移
Inc(Currline,1);
if Currline>=bRect.Bottom-panel1.Height+100 then
begin
Timer1.Enabled:=False;
Currline:=0;
end;
end;
procedure TForm1.zShowText;
var
ss:string;
ReadFile:TextFile;
begin
AssignFile(ReadFile,Edit1.Text);
Reset(ReadFile);
sItem:=TStringList.Create;
with sItem do
while not eof(ReadFile) do
begin
Readln(ReadFile,ss);
add(ss);
end;
CloseFile(ReadFile);
zBmpCreate;
sItem.Free;//释放串
end;procedure TForm1.zBmpCreate; //创建图片
var
i,y:integer; //y
begin
if bmp<>nil then bmp.free;
bmp:=TBitMap.Create;
zSetBmp;
R1.Right:=bRect.Right;
R1.Bottom:=bRect.Bottom;
y:=Panel1.Height-100;
for i:=0 to sItem.Count-1 do // 从0到行数 循环显示图片
begin
R1.Top:=y;
R1.Bottom:=R1.Top+LineHeight;
//中对齐
DrawText(Bmp.Canvas.Handle,pChar(sItem[i]),-1,R1,Dt_Center or Dt_Top);
//左对齐
//DrawText(Bmp.Canvas.Handle,pChar(sItem[i]),-1,R1,Dt_Left or Dt_Top);
//右对齐
//DrawText(Bmp.Canvas.Handle,pChar(sItem[i]),-1,R1,Dt_Right or Dt_Top); Inc(y,LineHeight);
end;
end;procedure TForm1.zSetBmp;
begin
zSetLineHeight;
with bRect do //Rect 矩形坐标(左上x,左下y,右上x,右下y)
begin
Top:=0;
Left:=0;
Right:=Panel1.Width;
Bottom:=LineHeight*sItem.Count+Height;//行高*行数+form高度
end;
with Bmp do
begin
Height:=bRect.Bottom+100;//图片高度
Width:=bRect.Right;
with Canvas do //canvas 画布
begin FillRect(bRect);
Brush.Style:=bsClear;
end;
end;
end;procedure TForm1.zSetLineHeight;
{设置行间隔}
var
Metrics:TTextMetric; //设置字体 API
begin
GetTextMetrics(iDc,Metrics);
LineHeight:=Metrics.tmHeight+Metrics.tmInternalLeading-Bmp.Canvas.Font.Height;
end;procedure TForm1.Button2Click(Sender: TObject);
begin
if Edit1.Text='' then
ShowMessage('请输入文件地址')
else
Timer1.Enabled:=not Timer1.Enabled;
end;procedure TForm1.FormDestroy(Sender: TObject);
begin
if Bmp<>nil then Bmp.Free;
end;end.