源码出处：https://download.csdn.net/download/guofang/3691061
-------------只为记录本人需要的部分------
以下代码有对源码进行少量修改，但是还有一点小问题，不影响正常使用，本人不想弄，弄了也是浪费时间-
废话不多说
----------
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComCtrls, ExtCtrls, Menus, StrUtils, Gauges;
type
TForm1 = class(TForm)
Panel1: TPanel;
Button1: TButton;
ListBox1: TListBox;
Splitter1: TSplitter;
RichEdit1: TRichEdit;
Button2: TButton;
OpenDialog1: TOpenDialog;
FontDialog1: TFontDialog;
ScrollBar1: TScrollBar;
Button3: TButton;
Button4: TButton;
ColorDialog1: TColorDialog;
Button5: TButton;
Button6: TButton;
PopupMenu1: TPopupMenu;
N1: TMenuItem;
N2: TMenuItem;
N3: TMenuItem;
N4: TMenuItem;
N5: TMenuItem;
N6: TMenuItem;
Timer1: TTimer;
N7: TMenuItem;
Label1: TLabel;
Timer2: TTimer;
Button7: TButton;
Label2: TLabel;
StatusBar1: TStatusBar;
Gauge1: TGauge;
Button8: TButton;
N8: TMenuItem;
ListBox2: TListBox;
N9: TMenuItem;
FindDialog1: TFindDialog;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure ListBox1Click(Sender: TObject);
procedure Button3KeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure Button4Click(Sender: TObject);
procedure Button5Click(Sender: TObject);
procedure Button6Click(Sender: TObject);
procedure N1Click(Sender: TObject);
procedure N6Click(Sender: TObject);
procedure ScrollBar1Change(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure N7Click(Sender: TObject);
procedure PopupMenu1Popup(Sender: TObject);
procedure Timer2Timer(Sender: TObject);
procedure Button7Click(Sender: TObject);
procedure RichEdit1Change(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure Panel1Click(Sender: TObject);
procedure Button8Click(Sender: TObject);
procedure N8Click(Sender: TObject);
procedure N9Click(Sender: TObject);
procedure FindDialog1Find(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
IsScroll:Boolean;
IsShow:Boolean;
IsPanelShow:Boolean;
cc:Integer;
IsFullScreen:Boolean;
xp:Integer;//滚动条现位置
tou,xmin,xmax:Integer;
sl:Integer;
//txt:TStrings;
pdata:PChar;
fhandle:THandle;
maphandle:THandle;
path:String;
implementation
Uses Unit2;
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
var
aa:Integer;
ss,ss2:String;
//fs:TFileStream;
temp:TStrings;
fsize:Integer;
txt:TStrings;
begin
//ListBox2.Visible:=False;
if fhandle<>0 then
begin
CloseHandle(maphandle);
CloseHandle(fhandle);
UnmapViewOfFile(PData);
Form2.Memo1.Lines.SaveToFile(path+'log.txt');
end;
ListBox1.Clear;
RichEdit1.Clear;
temp:=TStringList.Create;
OpenDialog1.Execute;
//文件映射开始
fhandle:=FileOpen(OpenDialog1.FileName,fmOpenRead);
fsize:=GetFileSize(fhandle,nil);
maphandle:=CreateFileMapping(fhandle,nil,PAGE_READONLY,0,fsize,nil);
pdata:=MapViewOfFile(maphandle,FILE_MAP_READ,0,0,fsize);
txt:=TStringlist.Create;
txt.SetText(pdata);
//关闭映射
//CloseHandle(fhandle);
//CloseHandle(maphandle);
//UnmapViewOfFile(PData);
//fs:=TFileStream.Create(OpenDialog1.FileName,fmOpenRead);
//ListBox2.Items.LoadFromStream(fs);
//StatusBar1.Panels.Items[2].Text:='读取完毕';
//fs.Free;
//fs.Destroy;
//ListBox2.Items.LoadFromFile(OpenDialog1.FileName);
Form1.Caption:=OpenDialog1.FileName;
//RichEdit1.SetTextBuf(ListBox2.Items.GetText);
//cc:=ListBox2.GetTextLen;
cc:=txt.Count;
StatusBar1.Panels.Items[0].Text:='文章总长'+InttoStr(cc)+'行';
//temp.Add(txt.Strings[0]);
for aa:=0 to txt.Count-3 do
begin
Application.ProcessMessages;
ss:=txt.Strings[aa];
//ss2:=LeftStr(ss,100);
ss2:=ss;
if (Pos('第',ss2)> 0) and (Pos('章',ss2)> 0) then
//ListBox1.Items.Add(ss);
temp.Add(ss);
end;
ListBox1.Items:=temp;
temp.Free;
Label2.Caption:=txt.Strings[10];
//temp.Destroy;
end;
procedure TForm1.FormCreate(Sender: TObject);
//var
//path:String;
begin
IsScroll:=False;
IsShow:=True;
IsPanelShow:=True;
IsFullScreen:=False;
sl:=-200;
Form1.Height:=Screen.DesktopHeight-50;
//txt:=TStringlist.Create;
path:=ExtractFilePath(Application.ExeName);
//Form2.Memo1.Lines.LoadFromFile(Unit1.path+'log.txt');
//Form2.Show;
ListBox2.Items.LoadFromFile(path+'py.txt');
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
IsScroll:=Not(IsScroll);
Timer1.Enabled:=Not Timer1.Enabled;
if IsScroll then Button2.Caption:='停止' else Button2.Caption:='滚动';
//while IsScroll do
//begin
//Application.ProcessMessages;
//Sleep(ScrollBar1.Position*100);
//RichEdit1.Perform(EM_SCROLL,1,0);
//end;
end;
procedure TForm1.ListBox1Click(Sender: TObject);
var
kkk,aa,bfff:Integer;
bbs,jj:String;
sss,buff,txt2:TStrings;
begin
RichEdit1.Clear;
bbs:=ListBox1.Items.Strings[ListBox1.ItemIndex];
Label2.Caption:=bbs;
//aa:=txt.IndexOf(bbs);
txt2:=TStringList.Create;
txt2.SetText(pdata);
tou:=txt2.IndexOf(bbs);
if ListBox1.ItemIndex=ListBox1.Count-1 then
begin
jj:=ListBox1.Items.Strings[ListBox1.Count-1];
kkk:=txt2.Count -1;
end
else
begin
jj:=ListBox1.Items.Strings[(ListBox1.ItemIndex)+1];
kkk:=txt2.IndexOf(jj);
end;
//Label2.Caption:=jj;
//Edit2.Text:=InttoStr(kkk);
sss:=TStringList.Create;
for aa:=tou to kkk do
begin
Application.ProcessMessages;
sss.Add(txt2.Strings[aa]);
end;
buff:=TStringList.Create;
for bfff:=0 to 8 do
buff.Add('-----------------------');
RichEdit1.Lines.AddStrings(buff);
RichEdit1.Lines.AddStrings(sss);
RichEdit1.Lines.AddStrings(buff);
RichEdit1.SelStart:=0;
RichEdit1.Perform(EM_SCROLLCARET,0,0);
Button3.SetFocus;
StatusBar1.Panels.Items[1].Text:='已阅读'+InttoStr(tou)+'行';
if ListBox1.ItemIndex=ListBox1.Count-1 then
Gauge1.Progress:=100
else
Gauge1.Progress:=((100*tou) div cc);
sss.Free;
buff.Free;
//sss.Destroy;
//RichEdit1.SetSelTextBuf(list.GetText);
//RichEdit1.SetSelTextBuf(PAnsiChar(qq));
end;
procedure TForm1.Button3KeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
Button3.SetFocus;
IF Key=VK_SPACE then
Button2Click(self);
end;
procedure TForm1.Button4Click(Sender: TObject);
begin
if IsScroll then Button2Click(self);
FontDialog1.Font:=RichEdit1.Font;
FontDialog1.Execute;
RichEdit1.Font:=FontDialog1.Font;
end;
procedure TForm1.Button5Click(Sender: TObject);
begin
if IsScroll then Button2Click(self);
ColorDialog1.Color:=RichEdit1.Color;
ColorDialog1.Execute;
RichEdit1.Color:=ColorDialog1.Color;
end;
procedure TForm1.Button6Click(Sender: TObject);
begin
IsShow:=Not(IsShow);
Listbox1.Visible:=IsShow;
end;
procedure TForm1.N1Click(Sender: TObject);
begin
IsPanelShow:=Not(IsPanelShow);
Panel1.Visible:=IsPanelShow;
Button7.Visible:=Panel1.Visible;
end;
procedure TForm1.N6Click(Sender: TObject);
begin
IsFullScreen:=Not(IsFullScreen);
If IsFullScreen then
begin
Listbox1.Width:=2;
IsPanelShow:=False;
end
else
begin
Listbox1.Width:=200;
IsPanelShow:=True;
end;
Panel1.Visible:=IsPanelShow;
Button7.Visible:=Panel1.Visible;
end;
procedure TForm1.ScrollBar1Change(Sender: TObject);
begin
if Timer1.Enabled then
begin
Timer1.Enabled:=False;
Timer1.Interval:=ScrollBar1.Position;
Timer1.Enabled:=True;
end
else
Exit;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
xp:=GetScrollPos(RichEdit1.Handle,SB_VERT);
GetScrollRange(RichEdit1.Handle,SB_VERT,xmin,xmax);
//GetScrollInfo(RichEdit1.Handle,SB_VERT,sinf);
//Edit1.Text:=InttoStr(xmin)+' '+InttoStr(xmax)+' '+InttoStr(xp)+' '+InttoStr(xmax-xp);
if xp=sl then
begin
xp:=0;
RichEdit1.SelStart:=0;
RIchEdit1.SelLength:=10;
RichEdit1.Perform(EM_SCROLLCARET,0,0);
if ListBox1.ItemIndex =ListBox1.Count-1 then
begin
Button2Click(self);
end
else
begin
ListBox1.ItemIndex:=ListBox1.ItemIndex+1;
ListBox1Click(self);
end;
end;
if IsScroll then
begin
//SetScrollPos(RichEdit1.Handle ,SB_VERT,xp+1,FALSE);
SendMessage(RichEdit1.Handle,WM_VSCROLL, MAKELONG(SB_THUMBPOSITION, xp+1), 0);
end;
sl:=xp;
end;
procedure TForm1.N7Click(Sender: TObject);
begin
RichEdit1.CopyToClipboard;
end;
procedure TForm1.PopupMenu1Popup(Sender: TObject);
begin
if IsScroll then Button2Click(self);
end;
procedure TForm1.Timer2Timer(Sender: TObject);
begin
Label1.Caption:=DateToStr(Date)+' '+TimeToStr(Now)+'速度'+InttoStr(ScrollBar1.Position);
StatusBar1.Panels.Items[2].Text:=InttoStr(xp);
end;
procedure TForm1.Button7Click(Sender: TObject);
begin
IsPanelShow:=Not(IsPanelShow);
Panel1.Visible:=IsPanelShow;
Button7.Visible:=Panel1.Visible;
end;
procedure TForm1.RichEdit1Change(Sender: TObject);
begin
//aa:=ListBox2.GetTextLen;
//aa:=RichEdit1.Perform(EM_GETFIRSTVISIBLELINE,0,0);
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
//var ss:string;
begin
Form2.Memo1.Lines.Insert(0,RightStr(RichEdit1.Lines.Text,500));
Form2.Memo1.Lines.Insert(0,' ');
Form2.Memo1.Lines.Insert(0,Label2.Caption);
Form2.Memo1.Lines.Insert(0,' ');
Form2.Memo1.Lines.Insert(0,Form1.Caption);
Form2.Memo1.Lines.Insert(0,' ');
Form2.Memo1.Lines.Insert(0,Label1.Caption);
Form2.Memo1.Lines.Insert(0,'******************************************');
//Form2.Memo1.Lines.SaveToFile(path+'log.txt');
CloseHandle(maphandle);
CloseHandle(fhandle);
UnmapViewOfFile(PData);
Form2.Memo1.Lines.SaveToFile(path+'log.txt');
end;
procedure TForm1.Panel1Click(Sender: TObject);
begin
Button7Click(self);
end;
procedure TForm1.Button8Click(Sender: TObject);
begin
Form2.Show;
end;
procedure TForm1.N8Click(Sender: TObject);
var
sltxt,py,its:String;
cc,aa,bb,star,mid:Integer;
begin
cc:=ListBox2.Items.Count;
sltxt:=RichEdit1.SelText;
for aa:=0 to cc-1 do
begin
Application.ProcessMessages;
its:=ListBox2.Items.Strings[aa];
bb:=Pos(sltxt,its);
star:=Pos('#',its);
if bb>0 then
begin
if ((bb-star) mod 2)=1 then
begin
py:=py+' '+its[bb]+its[bb+1]+LeftStr(its,star-1);
end;
end;
end;
Application.MessageBox(PAnsiChar(py),PAnsiChar(sltxt),MB_OK);
//MessageBox(py,'发音',MB_OK );
py:=' ';
end;
procedure TForm1.N9Click(Sender: TObject);
begin
FindDialog1.Execute;
end;
procedure TForm1.FindDialog1Find(Sender: TObject);
var sta,tt:Integer;
begin
tt:=RichEdit1.SelStart;
sta:=RichEdit1.FindText(FindDialog1.FindText,tt+RichEdit1.SelLength,RichEdit1.GetTextLen,[stMatchCase]);
if sta<>-1 then
begin
RichEdit1.SelStart:=sta;
RichEdit1.SelLength:=Length(FindDialog1.FindText);
RichEdit1.Perform(EM_SCROLLCARET,0,0);
end;
end;
end.
----------------以下资料忘记出处---------------------------------
var
iFileHandle : Integer;
iFileLength : Integer;
iBytesRead, i : Integer;
Buffer : ^char;
strPath : String;
begin
// 取得文件路径
strPath := ExtractFilePath(Application.ExeName) + 'EventStep1.dat';
// 读取文件内容
iFileHandle := FileOpen(strPath,fmOpenRead);//fmopenread指的是文件以只读方式打开,还有其他更多的方式,如fmCreate等
if iFileHandle <> -1 then // 判断文件返回值,看打开是否正确
begin
iFileLength := FileSeek(iFileHandle,0,2);//得到文件的长度
FileSeek(iFileHandle,0,0); // 游标指向起始
GetMem(Buffer,(iFileLength+1));//buffer分配内存
iBytesRead := FileRead(iFileHandle, Buffer, iFileLength); //读数据,写时可用FileWrite
end;
FileClose(iFileHandle);// 关闭文件
end;
-----------------------
