ispell.pas

拼写检查

unit ISpell;

interface

 uses Classes, Windows,
   {$IFDEF VER130} { Borland Delphi 5.x }
      consts,
   {$ELSE}
      RTLConsts,
   {$ENDIF}
      SysUtils, Graphics;

 const MaxListSize = Maxint div 16;

type
 TDuplicates = (dupIgnore, dupAccept, dupError);

 PTableItem = ^TTableItem;
 TTableItem = record
   FString: WideString;
   FObject: WideString;
 end;

 PTableItemList = ^TTableItemList;
 TTableItemList = array[0..MaxListSize] of TTableItem;

 TTableList = class
   private
    FList: PTableItemList;
    FCount: Integer;
    FCapacity: Integer;
    FSorted: Boolean;
    FDuplicates: TDuplicates;
    procedure ExchangeItems(Index1, Index2: Integer);
    procedure Grow;
    procedure QuickSort(L, R: Integer);
    procedure InsertItem(Index: Integer; const S: WideString);
    procedure SetSorted(Value: Boolean);
   protected
    procedure Error(const Msg: string; Data: Integer);
    procedure Changed; virtual;
    procedure Changing; virtual;
    function GetCapacity: Integer;
    function GetCount: Integer;
    procedure Put(Index: Integer; const S: WideString);
    procedure PutObject(Index: Integer; AObject: WideString);
    procedure SetCapacity(NewCapacity: Integer);
    procedure SetUpdateState(Updating: Boolean);
   public
    function Get(Index: Integer): WideString;
    function GetObject(Index: Integer): WideString;
    destructor Destroy; override;
    function Add(const S: WideString): Integer;
    function AddObject(const S,AObject: WideString): Integer;
    procedure Clear;
    procedure Delete(Index: Integer);
    procedure Exchange(Index1, Index2: Integer);
    function Find(const S: WideString; var Index: Integer): Boolean; virtual;
    function IndexOf(const S: WideString): Integer;
    procedure Insert(Index: Integer; const S: WideString);
    procedure Sort; virtual;
    property Duplicates: TDuplicates read FDuplicates write FDuplicates;
    property Sorted: Boolean read FSorted write SetSorted;
    property Count: Integer read FCount;
 end; {TTableList}


 TConvTable = class
    Charset: String;
    InTbl,OutTbl: TTableList;
    constructor Create;
    destructor Destroy; override;
    function Load (Name: String): Boolean;
    procedure Clear;
 end; { TConvTable }
 function Replace (var S: String; const A,B: String): Boolean;
 function ToUTF8(const S: WideString): String;
 function FromUTF8(const S: String): WideString;
 procedure StrSwapByteOrder(Str: PWideChar);

 function GetCvt (S: WideString; const Table: TConvTable): WideString;
 function PutCvt (S: WideString; const Table: TConvTable): WideString;
 function GetCvtU (S: WideString; const Table: TConvTable): WideString;
 function PutCvtU (S: WideString; const Table: TConvTable): WideString;
 function UtoXC (const S: WideString; const Table: TConvTable): WideString;
 procedure ParseSetup (S: WideString; var Left,Right: WideString);
 function XtoU (const S: WideString): WideString;
 function UtoX (const S: WideString): WideString;
 function UntoX (const S: WideString; MaxOrd: Integer): WideString;

 function myReadLn (var F: TextFile; var S: String; Max: Integer=8192): Boolean;
 function myEof (var F: TextFile): Boolean;
 procedure myClose (var F: TextFile);
 procedure myReset (var F: TextFile);

 function ExpandTabs(const S: WideString): WideString;

 function GetTFontCharset(Charset : String): TFontCharset;
 function GetICodePage(Charset: String): Integer;

 type TLineSeparator = (NoLS,LF,CR,CRLF,LS);

 var CurLineSeparator: TLineSeparator;

 const
   UTF16BE = 'UTF-16 (BE)';
   UTF16LE = 'UTF-16 (LE)';
   UTF8    = 'UTF-8';

implementation

const BufStep=80;

type DeviceFunc=function (var F: TTextRec): Integer;

procedure ReadBuf (var F: TextFile);
begin
    with TTextRec(F) do
    begin
        DeviceFunc(InOutFunc)(TTextRec(F));
        if BufEnd=0 then
            UserData[2]:=$FF;//  Mode:=Mode or $F00;  //eof
    end;
end; {ReadBuf}

{TTableList}
destructor TTableList.Destroy;
begin
  inherited Destroy;
  if FCount <> 0 then Finalize(FList^[0], FCount);
  FCount := 0;
  SetCapacity(0);
end;

function TTableList.Add(const S: WideString): Integer;
begin
  if not Sorted then
    Result := FCount
  else
    if Find(S, Result) then
      case Duplicates of
        dupIgnore: Exit;
        dupError: Error(SDuplicateString, 0);
      end;
  InsertItem(Result, S);
end;

function TTableList.AddObject(const S,AObject: WideString): Integer;
begin
  if not Sorted then
    Result := FCount
  else
    if Find(S, Result) then
      case Duplicates of
        dupIgnore: Exit;
        dupError: Error(SDuplicateString, 0);
      end;
  InsertItem(Result, S);
  PutObject(Result, AObject);
end; {TTableList.AddObject}

procedure TTableList.Changed;
begin
//  if (FUpdateCount = 0) and Assigned(FOnChange) then FOnChange(Self);
end;

procedure TTableList.Changing;
begin
//  if (FUpdateCount = 0) and Assigned(FOnChanging) then FOnChanging(Self);
end;

procedure TTableList.Clear;
begin
  if FCount <> 0 then
  begin
    Changing;
    Finalize(FList^[0], FCount);
    FCount := 0;
    SetCapacity(0);
    Changed;
  end;
end;

procedure TTableList.Delete(Index: Integer);
begin
  if (Index < 0) or (Index >= FCount) then Error(SListIndexError, Index);
  Changing;
  Finalize(FList^[Index]);
  Dec(FCount);
  if Index < FCount then
    System.Move(FList^[Index + 1], FList^[Index],
      (FCount - Index) * SizeOf(TStringItem));
  Changed;
end;

procedure TTableList.Exchange(Index1, Index2: Integer);
begin
  if (Index1 < 0) or (Index1 >= FCount) then
    Error(SListIndexError, Index1);
  if (Index2 < 0) or (Index2 >= FCount) then Error(SListIndexError, Index2);

  Changing;
  ExchangeItems(Index1, Index2);
  Changed;
end;

procedure TTableList.ExchangeItems(Index1, Index2: Integer);
var
  Temp: Integer;
  Item1, Item2: PStringItem;
begin
  Item1 := @FList^[Index1];
  Item2 := @FList^[Index2];
  Temp := Integer(Item1^.FString);
  Integer(Item1^.FString) := Integer(Item2^.FString);
  Integer(Item2^.FString) := Temp;
  Temp := Integer(Item1^.FObject);
  Integer(Item1^.FObject) := Integer(Item2^.FObject);
  Integer(Item2^.FObject) := Temp;
end;

function WCompareText(const A,B: WideString): Integer;
begin
    if (A>B) then result:=1
    else if (A<B) then result:=-1
    else result:=0;
end; {WCompareText}

function TTableList.Find(const S: WideString; var Index: Integer): Boolean;
var
  L, H, I, C: Integer;
begin
  Result := False;
  L := 0;
  H := FCount - 1;
  while L <= H do
  begin
    I := (L + H) shr 1;
    C := WCompareText(FList^[I].FString, S);
    if C < 0 then L := I + 1 else
    begin
      H := I - 1;
      if C = 0 then
      begin
        Result := True;
        if Duplicates <> dupAccept then L := I;
      end;
    end;
  end;
  Index := L;
end;

function TTableList.Get(Index: Integer): WideString;
begin
  if (Index < 0) or (Index >= FCount) then Error(SListIndexError, Index);
  Result := FList^[Index].FString;
end;

function TTableList.GetCapacity: Integer;
begin
  Result := FCapacity;
end;

function TTableList.GetCount: Integer;
begin
  Result := FCount;
end;

function TTableList.GetObject(Index: Integer): WideString;
begin
  if (Index < 0) or (Index >= FCount) then Error(SListIndexError, Index);
  Result := FList^[Index].FObject;
end;

procedure TTableList.Grow;
var
  Delta: Integer;
begin
  if FCapacity > 64 then Delta := FCapacity div 4 else
    if FCapacity > 8 then Delta := 16 else
      Delta := 4;
  SetCapacity(FCapacity + Delta);
end;

function TTableList.IndexOf(const S: WideString): Integer;
begin
  if not Sorted then
  begin
    for Result := 0 to GetCount - 1 do
        if WCompareText(Get(Result), S) = 0 then Exit;
    Result := -1;
  end
  else
    if not Find(S, Result) then Result := -1;
end;

procedure TTableList.Insert(Index: Integer; const S: WideString);
begin
  if Sorted then Error(SSortedListError, 0);
  if (Index < 0) or (Index > FCount) then Error(SListIndexError, Index);
  InsertItem(Index, S);
end;

procedure TTableList.InsertItem(Index: Integer; const S: WideString);
begin
  Changing;
  if FCount = FCapacity then Grow;
  if Index < FCount then
    System.Move(FList^[Index], FList^[Index + 1],
      (FCount - Index) * SizeOf(TStringItem));
  with FList^[Index] do
  begin
    Pointer(FString) := nil;
    Pointer(FObject) := nil;
    FObject := '';
    FString := S;
  end;
  Inc(FCount);
  Changed;
end;

procedure TTableList.Put(Index: Integer; const S: WideString);
begin
  if Sorted then Error(SSortedListError, 0);
  if (Index < 0) or (Index >= FCount) then Error(SListIndexError, Index);
  Changing;
  FList^[Index].FString := S;
  Changed;
end;

procedure TTableList.PutObject(Index: Integer; AObject: WideString);
begin
  if (Index < 0) or (Index >= FCount) then Error(SListIndexError, Index);
  Changing;
  FList^[Index].FObject := AObject;
  Changed;
end;

procedure TTableList.QuickSort(L, R: Integer);
var
  I, J: Integer;
  P: WideString;
begin
  repeat
    I := L;
    J := R;
    P := FList^[(L + R) shr 1].FString;
    repeat
      while WCompareText(FList^[I].FString, P) < 0 do Inc(I);
      while WCompareText(FList^[J].FString, P) > 0 do Dec(J);
      if I <= J then
      begin
        ExchangeItems(I, J);
        Inc(I);
        Dec(J);
      end;
    until I > J;
    if L < J then QuickSort(L, J);
    L := I;
  until I >= R;
end;

procedure TTableList.SetCapacity(NewCapacity: Integer);
begin
  ReallocMem(FList, NewCapacity * SizeOf(TStringItem));
  FCapacity := NewCapacity;
end;

procedure TTableList.SetSorted(Value: Boolean);
begin
  if FSorted <> Value then
  begin
    if Value then Sort;
    FSorted := Value;
  end;
end;

procedure TTableList.SetUpdateState(Updating: Boolean);
begin
  if Updating then Changing else Changed;
end;

procedure TTableList.Sort;
begin
  if not Sorted and (FCount > 1) then
  begin
    Changing;
    QuickSort(0, FCount - 1);
    Changed;
  end;
end;

procedure TTableList.Error(const Msg: string; Data: Integer);
  function ReturnAddr: Pointer;
  asm
          MOV     EAX,[EBP+4]
  end;
begin
  raise EStringListError.CreateFmt(Msg, [Data]) at ReturnAddr;
end;

{ TConvTable }
procedure TConvTable.Clear;
begin
    InTbl.Clear;
    OutTbl.Clear;
end; {TConvTable.Clear}

constructor TConvTable.Create;
begin
  inherited;
  Charset:='';
  InTbl:=TTableList.Create;
  InTbl.Sorted:=True;
  InTbl.Duplicates:=dupIgnore;
  OutTbl:=TTableList.Create;
  OutTbl.Sorted:=True;
  OutTbl.Duplicates:=dupIgnore;
end; {TConvTable.Create}

destructor TConvTable.Destroy;
begin
 InTbl.Free;
 OutTbl.Free;
 inherited;
end; {TConvTable.Destroy}

function TConvTable.Load(Name: String): Boolean;
 var F: TextFile;
     A,B,S: WideString;
     SS: String;
begin
  try
    Assign(F,Name);
    myReset(F);
    while not myEof(F) do
    begin
        myReadLn(F,SS);
        if SS='' then continue;
        S:=XtoU(SS);
        ParseSetup(S,A,B);
        InTbl.AddObject(A,B);
        OutTbl.AddObject(B,A);
    end;
    myClose(F);
    result:=True;
  except
    result:=False;
  end;
end; {TConvTable.Load}

function Replace (var S: String; const A,B: String): Boolean;
 var N: Integer;
begin
    result:=False;
    N:=Pos(AnsiUpperCase(A),AnsiUpperCase(S));
    if N=0 then exit;
    Delete(S,N,length(A));