返回
{***************************************************************}
{***               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.