delphi制作字幕滚动窗体.rar

delphi的字幕滚动窗体程序代码如下unit Unit1; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls, ComCtrls; type TForm1 = class(TForm) Timer1: TTimer; Edit1: TEdit; Button3: TButton; Button2: TButton; TrackBar1: TTrackBar; Panel1: TPanel; Label1: TLabel; Label2: TLabel; procedure FormCreate(Sender: TObject); procedure Timer1Timer(Sender: TObject); procedure Button2Click(Sender: TObject); procedure Button3Click(Sender: TObject); procedure TrackBar1Change(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; 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 bmpnil 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; 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; 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.Button3Click(Sender: TObject); begin timer1.Enabled :=false; Currline:=0; Button2.Click; end; procedure TForm1.TrackBar1Change(Sender: TObject); begin Timer1.Interval:=TrackBar1.Position*5; end; procedure TForm1.FormDestroy(Sender: TObject); begin if Bmpnil then Bmp.Free; end.