关于拉幕程序的讨论和源码

原创 2001年05月12日 10:33:00

程序把一个文本文件在屏幕上缓慢输出,完全输出后再从头循环输出

修改后可以使用的程序源代码(还是不完善:还不能实现从一侧飞入的效果,容易出错):
unit Unit1;

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;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure TrackBar1Change(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button7Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure Button8Click(Sender: TObject);
    procedure Button5Click(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}
const
  bWidth=200;
var
  currline, LineHeight:integer;
  sItem:TStringList;
  bmp:TBitMap;
  bRect,R1:TRect;
  iDc:HDC;

procedure TForm1.Button1Click(Sender: TObject);
begin
OpenDialog1.Execute;
Edit1.Text:=OpenDialog1.FileName;
end;

procedure TForm1.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;

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);
  Inc(Currline,1);
  if Currline>=bRect.Bottom-panel1.Height+100 then//循环条件?
  begin
    Timer1.Enabled:=False;
    Currline:=0;
  end;
end;


procedure TForm1.zShowText;
var
  i:integer;
  ss:string;
  ReadFile:TextFile;
begin
  AssignFile(ReadFile,Edit1.Text);
  Reset(ReadFile);
  i:=1;
  sItem:=TStringList.Create;
  with sItem do
    while not eof(ReadFile) do
    begin
      Readln(ReadFile,ss);
      add(ss);
      i:=i+1;
    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;
    if Combobox1.Text='中间对齐' then  //显示图片
    DrawText(Bmp.Canvas.Handle,pChar(sItem[i]),-1,R1,Dt_Center or Dt_Top)
    else
    if Combobox1.Text='左对齐' then
    DrawText(Bmp.Canvas.Handle,pChar(sItem[i]),-1,R1,Dt_Left or Dt_Top)
    else
    if Combobox1.Text='右对齐'then
    DrawText(Bmp.Canvas.Handle,pChar(sItem[i]),-1,R1,Dt_Right or Dt_Top)
    else
    DrawText(Bmp.Canvas.Handle,pChar(sItem[i]),-1,R1,Dt_Center 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
      Font:=FontDialog1.Font;
      //Font:=self.Font;//form所设置的字体
      Brush.Color:=ColorDialog1.Color;
      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
begin
  if Button2.Caption='开始' then Button2.Caption:='暂停'
  else Button2.Caption:='开始';
  Timer1.Enabled:=not Timer1.Enabled;
end;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  timer1.Enabled :=false;
  Currline:=0;
  Button2.Click;
  Button2.Caption:='暂停';
end;

procedure TForm1.TrackBar1Change(Sender: TObject);
begin
  Timer1.Interval:=TrackBar1.Position*5;
  Label2.Caption:=inttostr(Timer1.Interval);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  if Bmp<>nil then Bmp.Free;
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
close;
end;


procedure TForm1.Button7Click(Sender: TObject);
begin
FontDialog1.Execute;
end;

procedure TForm1.Button6Click(Sender: TObject);
begin
ColorDialog1.Execute;
end;

procedure TForm1.Button8Click(Sender: TObject);
begin
  if ((strtoint(Edit2.Text)>=600) or (strtoint(Edit3.text)>=500)  or ((strtoint(Edit5.Text)>=553) or (strtoint(Edit4.Text)>=630)))
    then showmessage('范围超界')
    else
    begin
      Panel1.Top:=strtoint(Edit2.text);
      Panel1.Left:=strtoint(Edit3.text);
      Panel1.Width:=strtoint(Edit4.text);
      Panel1.Height:=strtoint(Edit5.text);
    end;

end;



procedure TForm1.Button5Click(Sender: TObject);
begin
  Panel1.Top:=0;
  Panel1.Left:=0;
  Panel1.Width:=Panel3.Width;
  Panel1.Height:=Panel3.Height;
end;

end.

详细讨论在:http://www.csdn.net/expert/topic/97/97371.shtm

无领导小组讨论面试真题解析(五)——沙漠求生记

五、经典题目及参考答案(一) 沙漠求生记
  • xiaoshuoladashou
  • xiaoshuoladashou
  • 2015年05月05日 11:33
  • 7450

图像处理软件开发记录(四) 美肤功能实现

专栏地址:http://blog.csdn.net/column/details/imagep.html 这一篇文章主要谈谈美肤操作。这个功能基本上很多软件都有,比如美图秀秀,女生们的最爱。 美肤的原...
  • Linoi
  • Linoi
  • 2014年03月31日 20:38
  • 4792

云计算学习笔记(二):云计算机制

文章转载只能用于非商业性质,且不能带有虚拟货币、积分、注册等附加条件。转载须注明出处http://blog.csdn.net/flowingflying以及作者@恺风Wei 一些术语和概念 逻辑网络边...
  • flowingflying
  • flowingflying
  • 2015年03月05日 20:42
  • 2148

APK程序Dex文件无源码调试方法讨论

那些不靠谱的工具 先来说说那些不靠谱的工具,就是今天吭了我小半天的各种工具,看官上坐,待我细细道来。 IDA pro IDA pro6.6之后加入了dex动态调试功能,一时间普天同庆...
  • QQ1084283172
  • QQ1084283172
  • 2015年10月22日 09:52
  • 1603

windows java应用程序录音并转为wav格式,使用欧拉蜜语音识别java sdk源码

  • 2017年08月06日 14:13
  • 3.13MB
  • 下载

一个网页弹幕的简单实现(附源码和运行程序)

  • 2016年01月08日 16:34
  • 107KB
  • 下载

QT实现windows全屏弹幕程序(源码)

  • 2017年11月22日 14:53
  • 5.53MB
  • 下载

【微信小程序经验】各类图表相关组件+Demo源码(折线图,柱状图,K线,分时图)

各类图表功能,小程序自带API并没有提供,所以很多人就用了其他方法来实现,我将这些实现方法和教程聚合一下,以便能够迅速而方便的使用; 相关文章: 在微信小程序中绘制图表(part1) 在微信...
  • rolan1993
  • rolan1993
  • 2017年06月15日 11:06
  • 6476

【android-tips】android程序执行adb shell命令(实例源码)

(转载请注明出处:http://blog.csdn.net/buptgshengod) package net.gimite.nativeexe; import java.io.BufferedR...
  • gshengod
  • gshengod
  • 2014年02月18日 13:27
  • 6983

Java源码——一个简单的数据库应用程序(通讯录)

无数据,不应用。现实生活中的很多系统都离不开数据库,而数据的增删改查则是最基本的功能。 这几天实现了以下个人在技术上的突破: 1. Java程序直连Oracle数据库,而之前的玩法是: a. 直...
  • hpdlzu80100
  • hpdlzu80100
  • 2017年04月20日 00:17
  • 1763
内容举报
返回顶部
收藏助手
不良信息举报
您举报文章:关于拉幕程序的讨论和源码
举报原因:
原因补充:

(最多只允许输入30个字)