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

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


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

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

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

    返回版面帖子列表

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








    簽名
    主站蜘蛛池模板: 日日婷婷夜日日天干| 色欲综合久久中文字幕网| 成人3d黄动漫无尽视频网站| 亚洲日韩精品欧美一区二区| 网络色综合久久| 国产精品h在线观看| yy6080久久亚洲精品| 新疆女人啪啪毛片| 亚洲人成伊人成综合网久久久| 深夜a级毛片免费视频| 国产乱子伦一区二区三区| 69式互添免费视频| 天天干天天爽天天射| 久久亚洲国产伦理| 最近中文字幕无| 亚洲精品视频在线观看视频| 精品久久久久香蕉网| 国产女人乱人伦精品一区二区| 99久久免费精品国产72精品九九| 婷婷六月久久综合丁香可观看| 久久精品国产69国产精品亚洲 | 精品无码一区二区三区爱欲 | 欧美性极品hd高清视频| 公与秀婷厨房猛烈进出视频| 色偷偷888欧美精品久久久| 国产福利免费视频| 99热在线观看免费| 女人18毛片a级毛片一区二区| 久久久久久久久久久久久久久 | 亚洲综合色区中文字幕| 福利视频导航大全| 国产亚洲欧美视频| 麻豆乱码国产一区二区三区 | 国产精品一国产精品| eeuss影院免费92242部| 婷婷国产成人精品视频| 久久亚洲色www成人欧美| 日韩欧美aⅴ综合网站发布| 亚洲成人免费网址| 欧美高清视频一区| 全部在线播放免费毛片|