程序把一个文本文件在屏幕上缓慢输出,完全输出后再从头循环输出
修改后可以使用的程序源代码（还是不完善：还不能实现从一侧飞入的效果，容易出错）：unit Unit1;interfaceuses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls, ComCtrls, ColorGrd, RxCombos;type TForm1 = class(TForm) Button1: TButton; Edit1: TEdit; OpenDialog1: TOpenDialog; Button2: TButton; Button3: TButton; TrackBar1: TTrackBar; Panel1: TPanel; Panel2: TPanel; Panel3: TPanel; Label1: TLabel; Label2: TLabel; Timer1: TTimer; Button4: TButton; ColorDialog1: TColorDialog; FontDialog1: TFontDialog; Button6: TButton; Button7: TButton; ComboBox1: TComboBox; Panel4: TPanel; Edit2: TEdit; Edit3: TEdit; Label3: TLabel; Label4: TLabel; Label5: TLabel; Label6: TLabel; Edit4: TEdit; Edit5: TEdit; Button8: TButton; Button5: TButton; procedure Button1Click(Sender: TObject); procedure FormCreate(Sender: TObject); procedure Timer1Timer(Sender: TObject); procedure Button2Click(Sender: TObject); procedure Button3Click(Sender: TObject); procedure TrackBar1Change(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure Button4Click(Sender: TObject); procedure Button7Click(Sender: TObject); procedure Button6Click(Sender: TObject); procedure Button8Click(Sender: TObject); procedure Button5Click(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}const bWidth=200;var currline, LineHeight:integer; sItem:TStringList; bmp:TBitMap; bRect,R1:TRect; iDc:HDC;procedure TForm1.Button1Click(Sender: TObject);beginOpenDialog1.Execute;Edit1.Text:=OpenDialog1.FileName;end;procedure TForm1.FormCreate(Sender: TObject);begin Form1.WindowState:=wsMaximized; Panel1.Top:=80; Panel1.Left:=96; Panel1.Height:=385; Panel1.Width:=433; Timer1.Enabled:=False; Label2.Caption:='100'; 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); Inc(Currline,1); if Currline>=bRect.Bottom-panel1.Height+100 then//循环条件？ begin Timer1.Enabled:=False; Currline:=0; end;end;procedure TForm1.zShowText;var i:integer; ss:string; ReadFile:TextFile;begin AssignFile(ReadFile,Edit1.Text); Reset(ReadFile); i:=1; sItem:=TStringList.Create; with sItem do while not eof(ReadFile) do begin Readln(ReadFile,ss); add(ss); i:=i+1; end; CloseFile(ReadFile); zBmpCreate; sItem.Free;//释放串end;procedure TForm1.zBmpCreate; //创建图片var i,y:integer; //ybegin 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; if Combobox1.Text='中间对齐' then //显示图片 DrawText(Bmp.Canvas.Handle,pChar(sItem[i]),-1,R1,Dt_Center or Dt_Top) else if Combobox1.Text='左对齐' then DrawText(Bmp.Canvas.Handle,pChar(sItem[i]),-1,R1,Dt_Left or Dt_Top) else if Combobox1.Text='右对齐'then DrawText(Bmp.Canvas.Handle,pChar(sItem[i]),-1,R1,Dt_Right or Dt_Top) else DrawText(Bmp.Canvas.Handle,pChar(sItem[i]),-1,R1,Dt_Center 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 Font:=FontDialog1.Font; //Font:=self.Font;//form所设置的字体 Brush.Color:=ColorDialog1.Color; FillRect(bRect); Brush.Style:=bsClear; end; end;end;procedure TForm1.zSetLineHeight;{设置行间隔}var Metrics:TTextMetric; //设置字体 APIbegin GetTextMetrics(iDc,Metrics); LineHeight:=Metrics.tmHeight+Metrics.tmInternalLeading-Bmp.Canvas.Font.Height;end;procedure TForm1.Button2Click(Sender: TObject);beginif Edit1.Text='' then ShowMessage('请输入文件地址')elsebegin if Button2.Caption='开始' then Button2.Caption:='暂停' else Button2.Caption:='开始'; Timer1.Enabled:=not Timer1.Enabled;end;end;procedure TForm1.Button3Click(Sender: TObject);begin timer1.Enabled :=false; Currline:=0; Button2.Click; Button2.Caption:='暂停';end;procedure TForm1.TrackBar1Change(Sender: TObject);begin Timer1.Interval:=TrackBar1.Position*5; Label2.Caption:=inttostr(Timer1.Interval);end;procedure TForm1.FormDestroy(Sender: TObject);begin if Bmp<>nil then Bmp.Free;end;procedure TForm1.Button4Click(Sender: TObject);beginclose;end;procedure TForm1.Button7Click(Sender: TObject);beginFontDialog1.Execute;end;procedure TForm1.Button6Click(Sender: TObject);beginColorDialog1.Execute;end;procedure TForm1.Button8Click(Sender: TObject);begin if ((strtoint(Edit2.Text)>=600) or (strtoint(Edit3.text)>=500) or ((strtoint(Edit5.Text)>=553) or (strtoint(Edit4.Text)>=630))) then showmessage('范围超界') else begin Panel1.Top:=strtoint(Edit2.text); Panel1.Left:=strtoint(Edit3.text); Panel1.Width:=strtoint(Edit4.text); Panel1.Height:=strtoint(Edit5.text); end;end;procedure TForm1.Button5Click(Sender: TObject);begin Panel1.Top:=0; Panel1.Left:=0; Panel1.Width:=Panel3.Width; Panel1.Height:=Panel3.Height;end;end.
详细讨论在：http://www.csdn.net/expert/topic/97/97371.shtm
