塑料排水板-植草格-土工膜厂家-泰安东诺工程材料有限公司

　　修改后可以使用的程序源代碼（還是不完善：還不能實現從一側飛入的效果，輕易出錯）：
　　unitUnit1;
　　
　　interface
　　
　　uses
　　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;
　　procedureButton1Click(Sender:TObject);
　　procedureFormCreate(Sender:TObject);
　　procedureTimer1Timer(Sender:TObject);
　　procedureButton2Click(Sender:TObject);
　　procedureButton3Click(Sender:TObject);
　　procedureTrackBar1Change(Sender:TObject);
　　procedureFormDestroy(Sender:TObject);
　　procedureButton4Click(Sender:TObject);
　　procedureButton7Click(Sender:TObject);
　　procedureButton6Click(Sender:TObject);
　　procedureButton8Click(Sender:TObject);
　　procedureButton5Click(Sender:TObject);
　　private
　　procedurezShowText;
　　ProcedurezBmpCreate;
　　procedurezSetBmp;
　　procedurezSetLineHeight;
　　procedurezShowLine(sender:TObject);
　　{Privatedeclarations}
　　public
　　{Publicdeclarations}
　　end;
　　
　　var
　　Form1:TForm1;
　　
　　implementation
　　
　　{$R*.DFM}
　　const
　　bWidth=200;
　　var
　　currline,LineHeight:integer;
　　sItem:TStringList;
　　bmp:TBitMap;
　　bRect,R1:TRect;
　　iDc:HDC;
　　
　　procedureTForm1.Button1Click(Sender:TObject);
　　begin
　　OpenDialog1.Execute;
　　Edit1.Text:=OpenDialog1.FileName;
　　end;
　　
　　procedureTForm1.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;
　　
　　procedureTForm1.zShowLine(sender:TObject);
　　begin
　　zShowText;
　　end;
　　
　　procedureTForm1.Timer1Timer(Sender:TObject);
　　begin
　　zShowLine(self);//顯示字符串
　　//bitblt轉移矩形圖(目標句柄，LSx,y,寬，高，源句柄，LSx,y,光柵運算符）
　　BitBlt(iDc,0,0,Panel1.Width,Panel1.Height,
　　Bmp.Canvas.Handle,0,Currline,srcCopy);
　　Inc(Currline,1);
　　ifCurrline>=bRect.Bottom-panel1.Height 100then//循環條件？
　　begin
　　Timer1.Enabled:=False;
　　Currline:=0;
　　end;
　　end;
　　
　　
　　procedureTForm1.zShowText;
　　var
　　i:integer;
　　ss:string;
　　ReadFile:TextFile;
　　begin
　　AssignFile(ReadFile,Edit1.Text);
　　Reset(ReadFile);
　　i:=1;
　　sItem:=TStringList.Create;
　　withsItemdo
　　whilenoteof(ReadFile)do
　　begin
　　Readln(ReadFile,ss);
　　add(ss);
　　i:=i 1;
　　end;
　　CloseFile(ReadFile);
　　zBmpCreate;
　　sItem.Free;//釋放串
　　end;
　　
　　procedureTForm1.zBmpCreate;//創建圖片
　　var
　　i,y:integer;//y
　　begin
　　ifbmp<>nilthenbmp.free;
　　bmp:=TBitMap.Create;
　　zSetBmp;
　　R1.Right:=bRect.Right;
　　R1.Bottom:=bRect.Bottom;
　　y:=Panel1.Height-100;
　　fori:=0tosItem.Count-1do//從0到行數循環顯示圖片
　　begin
　　R1.Top:=y;
　　R1.Bottom:=R1.Top LineHeight;
　　ifCombobox1.Text=\'中間對齊\'then//顯示圖片
　　DrawText(Bmp.Canvas.Handle,pChar(sItem[i]),-1,R1,Dt_CenterorDt_Top)
　　else
　　ifCombobox1.Text=\'左對齊\'then
　　DrawText(Bmp.Canvas.Handle,pChar(sItem[i]),-1,R1,Dt_LeftorDt_Top)
　　else
　　ifCombobox1.Text=\'右對齊\'then
　　DrawText(Bmp.Canvas.Handle,pChar(sItem[i]),-1,R1,Dt_RightorDt_Top)
　　else
　　DrawText(Bmp.Canvas.Handle,pChar(sItem[i]),-1,R1,Dt_CenterorDt_Top);
　　Inc(y,LineHeight);
　　end;
　　end;
　　
　　
　　
　　
　　
　　procedureTForm1.zSetBmp;
　　begin
　　zSetLineHeight;
　　withbRectdo//Rect矩形坐標(左上x,左下y,右上x,右下y)
　　begin
　　Top:=0;
　　Left:=0;
　　Right:=Panel1.Width;
　　Bottom:=LineHeight*sItem.Count Height;//行高*行數 form高度
　　end;
　　withBmpdo
　　begin
　　Height:=bRect.Bottom 100;//圖片高度
　　Width:=bRect.Right;
　　withCanvasdo//canvas畫布
　　begin
　　Font:=FontDialog1.Font;
　　//Font:=self.Font;//form所設置的字體
　　Brush.Color:=ColorDialog1.Color;
　　FillRect(bRect);
　　Brush.Style:=bsClear;
　　end;
　　end;
　　end;
　　
　　
　　
　　
　　
　　procedureTForm1.zSetLineHeight;
　　{設置行間隔}
　　var
　　Metrics:TTextMetric;//設置字體API
　　begin
　　GetTextMetrics(iDc,Metrics);
　　LineHeight:=Metrics.tmHeight Metrics.tmInternalLeading-Bmp.Canvas.Font.Height;
　　end;
　　
　　
　　
　　procedureTForm1.Button2Click(Sender:TObject);
　　begin
　　ifEdit1.Text=\'thenShowMessage(\'請輸入文件地址\')
　　else
　　begin
　　ifButton2.Caption=\'開始\'thenButton2.Caption:=\'暫停\'
　　elseButton2.Caption:=\'開始\';
　　Timer1.Enabled:=notTimer1.Enabled;
　　end;
　　end;
　　
　　procedureTForm1.Button3Click(Sender:TObject);
　　begin
　　timer1.Enabled:=false;
　　Currline:=0;
　　Button2.Click;
　　Button2.Caption:=\'暫停\';
　　end;
　　
　　procedureTForm1.TrackBar1Change(Sender:TObject);
　　begin
　　Timer1.Interval:=TrackBar1.Position*5;
　　Label2.Caption:=inttostr(Timer1.Interval);
　　end;
　　
　　procedureTForm1.FormDestroy(Sender:TObject);
　　begin
　　ifBmp<>nilthenBmp.Free;
　　end;
　　
　　procedureTForm1.Button4Click(Sender:TObject);
　　begin
　　close;
　　end;
　　
　　
　　procedureTForm1.Button7Click(Sender:TObject);
　　begin
　　FontDialog1.Execute;
　　end;
　　
　　procedureTForm1.Button6Click(Sender:TObject);
　　begin
　　ColorDialog1.Execute;
　　end;
　　
　　procedureTForm1.Button8Click(Sender:TObject);
　　begin
　　if((strtoint(Edit2.Text)>=600)or(strtoint(Edit3.text)>=500)or((strtoint(Edit5.Text)>=553)or(strtoint(Edit4.Text)>=630)))
　　thenshowmessage(\'范圍超界\')
　　else
　　begin
　　Panel1.Top:=strtoint(Edit2.text);
　　Panel1.Left:=strtoint(Edit3.text);
　　Panel1.Width:=strtoint(Edit4.text);
　　Panel1.Height:=strtoint(Edit5.text);
　　end;
　　
　　end;
　　
　　
　　
　　procedureTForm1.Button5Click(Sender:TObject);
　　begin
　　Panel1.Top:=0;
　　Panel1.Left:=0;
　　Panel1.Width:=Panel3.Width;
　　Panel1.Height:=Panel3.Height;
　　end;
　　
　　end.