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

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


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

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

    美女呀,離線,留言給我吧!
    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單帖管理 | 引用 | 回復 回到頂部

    返回版面帖子列表

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








    簽名
    主站蜘蛛池模板: 97大香伊在人人线色| 免费国产黄网站在线观看视频| 中国china体内谢o精| 日韩高清在线免费看| 免费日本三级电影| 菠萝蜜国际通道麻豆三区| 国产高清免费观看| 中文字幕在线播放第一页| 日韩欧美卡一卡二卡新区| 亚洲综合国产成人丁香五月激情 | 日本中文字幕有码在线视频| 亚洲男人的天堂在线| 精品一区二区三区电影| 国产成人AAAAA级毛片| 99热精品久久只有精品| 思思久久99热只有频精品66| 九色综合狠狠综合久久| 欧美性猛交xxxx免费看| 再深点灬舒服灬太大了网站| 色综合综合色综合色综合| 国产精品成人一区二区三区| 人妻无码aⅴ不卡中文字幕| 久久精品免视看国产陈冠希| 用手指搅乱吧~打烊后的...| 国产亚洲精品精品国产亚洲综合| 5252色欧美在线男人的天堂| 天堂一区二区三区在线观看| 久久99精品久久久久久园产越南| 日韩一中文字幕| 亚洲国产韩国一区二区| 波多野吉衣中文字幕| 啦啦啦手机完整免费高清观看| 菠萝蜜视频在线观看入口| 国产精品第100页| yy6080久久亚洲精品| 少妇群交换BD高清国语版| 久久大香香蕉国产免费网站| 欧美伊香蕉久久综合类网站| 什么网站可以看毛片| 福利视频757| 国产69精品久久久久APP下载|