<dfn id="is4kg"></dfn>
  • <ul id="is4kg"></ul>
  • <abbr id="is4kg"></abbr>
  • <ul id="is4kg"></ul>
    <bdo id="is4kg"></bdo>
    以文本方式查看主題

    -  曙海教育集團論壇  (http://www.hufushizhe.com/bbs/index.asp)
    --  Delphi程序設計  (http://www.hufushizhe.com/bbs/list.asp?boardid=76)
    ----  關于拉幕程序的討論和源碼  (http://www.hufushizhe.com/bbs/dispbbs.asp?boardid=76&id=2572)

    --  作者:wangxinxin
    --  發布時間:2010-12-14 11:20:34
    --  關于拉幕程序的討論和源碼

      修改后可以使用的程序源代碼(還是不完善:還不能實現從一側飛入的效果,輕易出錯):
      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.