<dfn id="is4kg"></dfn>
  • <ul id="is4kg"></ul>
  • <abbr id="is4kg"></abbr>
  • <ul id="is4kg"></ul>
    <bdo id="is4kg"></bdo>

    曙海教育集團論壇開發語言培訓專區Delphi程序設計 → 關于拉幕程序的討論和源碼


      共有7274人關注過本帖樹形打印

    主題:關于拉幕程序的討論和源碼

    美女呀,離線,留言給我吧!
    wangxinxin
      1樓 個性首頁 | 博客 | 信息 | 搜索 | 郵箱 | 主頁 | UC


    加好友 發短信
    等級:青蜂俠 帖子:1393 積分:14038 威望:0 精華:0 注冊:2010-11-12 11:08:23
    關于拉幕程序的討論和源碼  發帖心情 Post By: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.
      


    支持(0中立(0反對(0單帖管理 | 引用 | 回復 回到頂部

    返回版面帖子列表

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








    簽名
    主站蜘蛛池模板: 亲密爱人之无限诱惑| chinese猛攻打桩机体育生| 绿巨人app入口| 最近最新中文字幕| 国内大量揄拍人妻精品視頻| 亚洲伊人色欲综合网| 老司机久久影院| 天天爽亚洲中文字幕| 亚洲国产美女精品久久久久| 色多多www视频在线观看免费| 女人被男人躁到呻吟的| 亚洲国产一区二区三区在线观看| 美妇乱人伦交换小说| 在线免费观看污污视频| 久久精品老司机| 男人边吃奶边做性视频| 国产精品一区二区久久国产| 久久久久亚洲av成人网人人软件| 波多野结衣中文一区二区免费| 国产男人女人做性全过程视频| 中文字幕日产每天更新40| 欧美又大粗又爽又黄大片视频黑人| 国产免费一区二区三区免费视频| va亚洲va欧美va国产综合| 日韩欧美久久一区二区| 动漫小舞被吸乳羞羞漫画在线| 91高清完整版在线观看| 拧花蒂尿用力按凸起喷水尿| 亚洲精品无码永久在线观看| 色欲色av免费观看| 在线观看国产福利| 久久精品中文字幕第一页| 污视频网站免费在线观看| 国产啪精品视频网站| ssswww日本免费网站片| 日本猛妇色xxxxx在线| 人人妻人人澡人人爽欧美精品| 精品国产男人的天堂久久| 国产精品午夜小视频观看| 中文字幕日韩人妻不卡一区| 日本暴力喉深到呕吐hd|