返回
{***************************************************************}
{*** FVision Unit Version1.0 ***}
{*** 蓝蚂蚁工作室 ***}
{***************************************************************}
{*** 英汉词典单元 ***}
{***************************************************************}
{$O+,F+,X+,I-}
Unit FDict;
Interface
Uses
Dos,Graph,FGraph,FTool,FEvent,FMouse,
FView,FEdit,FDialog,FControl,FWrite;
Const
DictName:string = '\XYF\FVD\DICT.OVR';
Type
PWordDict=^TWordDict;
TWordDict=object(TView)
Fp:File;
FileName:PathStr;
Result:Word;
FindDict:Boolean;
BPos,EPos,NPos,OldPos:LongInt;
StrNow:array[0..5] of string;
FirstWord:string;
Constructor Init;
Destructor Done;virtual;
Procedure SearchWord(var St:string;var P:LongInt);
Function Search(S:string):Boolean;
Procedure ReadWord;
Function PrevWord:Boolean;
Function NextWord:Boolean;
Function SeekWord(P:Real):Boolean;
end;
PDict=^TDict;
TDict=Object(TWindow)
Dict:PWordDict;
Inp:PInput;
Viewer:PViewer;
VScroll:PScrollBar;
InpStr:string;
Constructor Init;
Procedure SetView;
Procedure HandleEvent(var Event:TEvent);virtual;
end;
Implementation
Constructor TWordDict.Init;
var
DictHead:Longint;
begin
Inherited Init;
Option:=Option or opCantSelect;
Assign(Fp,DictName);
Reset(Fp,1);
FindDict:=IOResult=0;
{ BlockRead(Fp,DictHead,4,Result);
if DictHead<>$00123456 then
FindDict:=False;
}
BPos:=70340;
EPos:=FileSize(Fp);
NPos:=BPos;
OldPos:=NPos;
end;
Destructor TWordDict.Done;
begin
Close(Fp);
Inherited Done;
end;
Procedure TWordDict.SearchWord;
var
Ch:Char;
i:Integer;
Fir:Boolean;
begin
St:='';
Seek(Fp,P);
BlockRead(Fp,Ch,1,Result);
i:=0;
while Ch<>#0 do
begin
Inc(i);
Seek(Fp,P-i);
BlockRead(Fp,Ch,1,Result);
end;
Seek(Fp,P-i+1);
P:=FilePos(Fp);
BlockRead(Fp,Ch,1,Result);
while (not Eof(Fp))and(Ch<>':') do
begin
St:=St+Ch;
BlockRead(Fp,Ch,1,Result);
end;
Fir:=False;
FirstWord:='';
BlockRead(Fp,Ch,1,Result);
while (not Eof(Fp))and(Ch<>',')and(Ch<>';')and(Ch<>#0) do
begin
BlockRead(Fp,Ch,1,Result);
if Fir and (Ch<>',')and(Ch<>';')and(Ch<>#0)and(Ch<>'.')and(Ch<>' ') then
FirstWord:=FirstWord+Ch
else if (Ch=' ')or(Ch='.') then
begin
Fir:=True;
FirstWord:='';
end;
end;
end;
Function TWordDict.Search;
var
TPos,TLPos,THPos,OPos:Longint;
St:string;
begin
Search:=False;
TLPos:=BPos;
THPos:=EPos;
OPos:=TLPos;
while True do
begin
TPos:=(TLPos+THPos) div 2;
SearchWord(St,TPos);
if UpCases(St)=UpCases(S) then
begin
Search:=True;
NPos:=TPos;
Exit;
end else
if UpCases(St)>UpCases(S) then
THPos:=TPos
else
TLPos:=TPos;
if OPos=TPos then
begin
Dec(THPos,2);
SearchWord(St,THPos);
if UpCases(St)=UpCases(S) then
begin
Search:=True;
NPos:=THPos;
Exit;
end else
begin
NPos:=TPos;
ReadWord;
TLPos:=FilePos(Fp);
SearchWord(St,TLPos);
if UpCases(St)=UpCases(S) then
begin
Search:=True;
NPos:=TLPos;
Exit;
end;
end;
NPos:=TPos;
ReadWord;
NPos:=FilePos(Fp);
Exit;
end;
OPos:=TPos;
end;
end;
Procedure TWordDict.ReadWord;
var
Ch:Char;
i,Hang:Byte;
begin
StrNow[0]:='';
for i:=1 to 5 do
StrNow[i]:=' ';
Seek(Fp,NPos);
BlockRead(Fp,Ch,1,Result);
while (not Eof(Fp))and(Ch<>':') do
begin
StrNow[0]:=StrNow[0]+Ch;
BlockRead(Fp,Ch,1,Result);
end;
Hang:=1;
while (not Eof(Fp))and(Ch<>#0) do
begin
BlockRead(Fp,Ch,1,Result);
while (Ch<>';')and(Ch<>#0) do
begin
StrNow[Hang]:=StrNow[Hang]+Ch;
BlockRead(Fp,Ch,1,Result);
end;
Inc(Hang);
end;
end;
Function TWordDict.PrevWord;
var
Ch:Char;
i:Integer;
begin
PrevWord:=False;
if NPos<=BPos then Exit;
i:=2;
Seek(Fp,NPos-i);
BlockRead(Fp,Ch,1,Result);
while Ch<>#0 do
begin
Inc(i);
Seek(Fp,NPos-i);
BlockRead(Fp,Ch,1,Result);
end;
Seek(Fp,NPos-i+1);
NPos:=FilePos(Fp);
ReadWord;
PrevWord:=True;
end;
Function TWordDict.NextWord;
begin
NextWord:=False;
if NPos>=EPos then Exit;
NPos:=FilePos(Fp);
ReadWord;
NextWord:=True;
end;
Function TWordDict.SeekWord;
var
Ch:Char;
begin
NPos:=BPos+Round(P*(EPos-BPos));
Seek(Fp,NPos);
if NPos<EPos then
begin
BlockRead(Fp,Ch,1,Result);
while (not Eof(Fp))and(Ch<>#0) do
BlockRead(Fp,Ch,1,Result);
end;
NPos:=FilePos(Fp);
ReadWord;
SeekWord:=True;
end;
{------------------Object TDict-------------------}
Constructor TDict.Init;
var
R:TRect;
B:PShape;
i:Integer;
begin
AssignRect(R,0,0,280,165);
Inherited Init(R,'English-Chinese Dictionary',True);
Option:=Option or opAligen8 or opResize;
GrowDlt.X:=8;
GrowDlt.Y:=16;
InpStr:='a';
AssignRect(R,7,32,8+30*8,34+16);
B:=New(PShape,Init(gcBroad+gcHideMouse,R,0,0,0,0,''));
B^.GrowMode:=gfGrowHiX;
Inp:=New(PInput,Init(8,33,InpStr,30,0));
Dict:=New(PWordDict,Init);
Dict^.ReadWord;
AssignRect(R,8,55,30,5);
Viewer:=New(PViewer,Init(R,edHScroll+edBroad));
for i:=0 to 5 do
Viewer^.Insert(Dict^.StrNow[i]);
AssignRect(R,252,55,15,80);
VScroll:=New(PScrollBar,Init(sbVer,R,0));
Insert(B);
Insert(Inp);
Insert(Viewer);
Insert(Dict);
Insert(VScroll);
Next;
Next;
Next;
Center;
end;
Procedure TDict.SetView;
var
i:Integer;
begin
Viewer^.FreeLine;
for i:=0 to 5 do
Viewer^.Insert(Dict^.StrNow[i]);
Viewer^.Draw;
VScroll^.NewPos((Dict^.NPos-Dict^.BPos)/(Dict^.EPos-Dict^.BPos));
end;
Procedure TDict.HandleEvent;
begin
Inherited HandleEvent(Event);
case Event.What of
evCommand:case Event.Command of
cmUp,cmPgUp :if Dict^.PrevWord then SetView;
cmDown,cmPgDn:if Dict^.NextWord then SetView;
cmInterVer:if Dict^.SeekWord(Event.InfoReal) then SetView;
cmOk :begin
Dict^.Search(string(TInput(Event.InfoPtr^).GetStr^));
Dict^.ReadWord;
SetView;
Message(Event.InfoPtr,cmSelect,nil);
end;
else Exit;
end;
else Exit;
end;
ClearEvent(Event);
end;
end.