开发工具:
文件大小: 181kb
下载次数: 0
上传时间: 2012-02-26
详细说明： delphi的字幕滚动窗体程序 代码如下 unit Unit1; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls, ComCtrls; type TForm1 = class(TForm) Timer1: TTimer; Edit1: TEdit; Button3: TButton; Button2: TButton; TrackBar1: TTrackBar; Panel1: TPanel; Label1: TLabel; Label2: TLabel; procedure FormCreate(Sender: TObject); procedure Timer1Timer(Sender: TObject); procedure Button2Click(Sender: TObject); procedure Button3Click(Sender: TObject); procedure TrackBar1Change(Sender: TObject); procedure FormDestroy(Sender: TObject); private procedure zShowText; Procedure zBmpCreate; procedure zSetBmp; procedure zSetLineHeight; procedure zShowLine(sender :TObject); { Private declarations } public { Public declarations } end; var Form1: TForm1; implementation {$R *.DFM} var currline, LineHeight:integer; sItem:TStringList; bmp:TBitMap; bRect,R1:TRect; iDc:HDC; procedure TForm1.FormCreate(Sender: TObject); begin Timer1.Enabled:=False; iDC:=GetDc(Panel1.handle); Currline:=0; end; procedure TForm1.zShowLine(sender :TObject); begin zShowText; end; procedure TForm1.Timer1Timer(Sender: TObject); begin zShowLine(self);//显示字符串 //bitblt 转移矩形图 (目标句柄，LS x,y,宽，高，源句柄，LS x,y,光栅运算符） BitBlt(iDc,0,0,Panel1.Width,Panel1.Height, Bmp.Canvas.Handle,0,Currline,srcCopy); //改变currline可实现左移右移 Inc(Currline,1); if Currline>=bRect.Bottom-panel1.Height+100 then begin Timer1.Enabled:=False; Currline:=0; end; end; procedure TForm1.zShowText; var ss:string; ReadFile:TextFile; begin AssignFile(ReadFile,Edit1.Text); Reset(ReadFile); sItem:=TStringList.Create; with sItem do while not eof(ReadFile) do begin Readln(ReadFile,ss); add(ss); end; CloseFile(ReadFile); zBmpCreate; sItem.Free;//释放串 end; procedure TForm1.zBmpCreate; //创建图片 var i,y:integer; //y begin if bmp<>nil then bmp.free; bmp:=TBitMap.Create; zSetBmp; R1.Right:=bRect.Right; R1.Bottom:=bRect.Bottom; y:=Panel1.Height-100; for i:=0 to sItem.Count-1 do // 从0到行数 循环显示图片 begin R1.Top:=y; R1.Bottom:=R1.Top+LineHeight; //中对齐 DrawText(Bmp.Canvas.Handle,pChar(sItem[i]),-1,R1,Dt_Center or Dt_Top); //左对齐 //DrawText(Bmp.Canvas.Handle,pChar(sItem[i]),-1,R1,Dt_Left or Dt_Top); //右对齐 //DrawText(Bmp.Canvas.Handle,pChar(sItem[i]),-1,R1,Dt_Right or Dt_Top); Inc(y,LineHeight); end; end; procedure TForm1.zSetBmp; begin zSetLineHeight; with bRect do //Rect 矩形坐标(左上x,左下y,右上x,右下y) begin Top:=0; Left:=0; Right:=Panel1.Width; Bottom:=LineHeight*sItem.Count+Height;//行高*行数+form高度 end; with Bmp do begin Height:=bRect.Bottom+100;//图片高度 Width:=bRect.Right; with Canvas do //canvas 画布 begin FillRect(bRect); Brush.Style:=bsClear; end; end; end; procedure TForm1.zSetLineHeight; {设置行间隔} var Metrics:TTextMetric; //设置字体 API begin GetTextMetrics(iDc,Metrics); LineHeight:=Metrics.tmHeight+Metrics.tmInternalLeading-Bmp.Canvas.Font.Height; end; procedure TForm1.Button2Click(Sender: TObject); begin if Edit1.Text='' then ShowMessage('请输入文件地址') else Timer1.Enabled:=not Timer1.Enabled; end; procedure TForm1.Button3Click(Sender: TObject); begin timer1.Enabled :=false; Currline:=0; Button2.Click; end; procedure TForm1.TrackBar1Change(Sender: TObject); begin Timer1.Interval:=TrackBar1.Position*5; end; procedure TForm1.FormDestroy(Sender: TObject); begin if Bmp<>nil then Bmp.Free; end; end. ...展开收缩
(系统自动生成,下载前可以参看下载内容)
下载文件列表
相关说明
- 本站资源为会员上传分享交流与学习,如有侵犯您的权益,请联系我们删除.
- 本站是交换下载平台，提供交流渠道，下载内容来自于网络，除下载问题外，其它问题请自行百度。
- 本站已设置防盗链，请勿用迅雷、QQ旋风等多线程下载软件下载资源，下载后用WinRAR最新版进行解压.
- 如果您发现内容无法下载，请稍后再次尝试；或者到消费记录里找到下载记录反馈给我们.
- 下载后发现下载的内容跟说明不相乎，请到消费记录里找到下载记录反馈给我们，经确认后退回积分.
- 如下载前有疑问，可以通过点击"提供者"的名字，查看对方的联系方式，联系对方咨询.
