<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.
      


    主站蜘蛛池模板: 一区二区视频网| 亚洲精品无码久久毛片| 4虎永免费最新永久免费地址| 开心久久婷婷综合中文字幕| 亚洲乱色伦图片区小说| 特级毛片www| 国产乱码精品一区二区三区四川 | 亚洲日韩一区二区三区| 男爵夫人的调教| 国产人妖ts在线视频观看| 888亚洲欧美国产VA在线播放| 夫妻免费无码V看片| 久久人妻夜夜做天天爽| 曰批免费视频播放在线看片二| 人人妻人人澡人人爽人人精品浪潮| 美团外卖chinesegayvideos| 国产成人综合久久亚洲精品 | 欧美伊人久久久久久久久影院| 北条麻妃国产九九九精品视频| 色宅男午夜电影在线观看| 精品国产柚木在线观看| 国产精品观看在线亚洲人成网| 中文天堂最新版www官网在线| 日本爽爽爽爽爽爽在线观看免| 亚洲日韩精品欧美一区二区 | 久久精品成人一区二区三区| 欧美一区二区激情三区| 亲密爱人免费完整在线观看| 精品久久久中文字幕二区| 国产制服丝袜在线观看| 18禁网站免费无遮挡无码中文| 夜夜爽夜夜叫夜夜高潮漏水| 中文字幕99页| 成人综合激情另类小说| 久久精品男人影院| 日韩精品无码成人专区| 亚洲欧洲在线播放| 欧美牲交a欧美牲交aⅴ免费下载| 免费黄网站大全| 精品人妻少妇一区二区三区 | 日本久久中文字幕精品|