關於拉幕程序的討論和源碼

　　修改後可以使用的程序源代碼（還是不完善：還不能實現從一側飛入的效果，容易出錯）：
　　unit Unit1;
　　
　　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;
　　    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);
　　begin
　　OpenDialog1.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; //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;
　　    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;  //設置字體 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
　　begin
　　  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);
　　begin
　　close;
　　end;
　　
　　
　　procedure TForm1.Button7Click(Sender: TObject);
　　begin
　　FontDialog1.Execute;
　　end;
　　
　　procedure TForm1.Button6Click(Sender: TObject);
　　begin
　　ColorDialog1.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;