unit1.pas

《Delphi7编程100例》代码,书配资料

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.