gbkcoding.pas

输入汉字取得拼音和五笔。 主要是汉字数据库有些用。

unit GBKCoding;

interface
uses SysUtils;

type
  //TextFile = file of Char;
  TCaseType = (ctNone, ctFirstUpper, ctAllUpper, ctAllLower);
  TGBKCoding = class
    private
      FCodingFile: string;
      FTextFile: TextFile;
      FOpened: boolean;
      FCaseType: TCaseType;
      FIgnoreNullity: boolean;
    public
      constructor create(FCodingFile: string);
      Destructor Destroy; override;
      procedure OpenCodingFile;
      function getPYByChar(str: string): string;
      function getPYByString(str: string): string;
      property CaseType: TCaseType read FCaseType write FCaseType default ctFirstUpper;
      property IgnoreNullity: boolean read FIgnoreNullity write FIgnoreNullity default false;
  end;
implementation

{ TGBKCoding }
const con_CodingStart = 7;
constructor TGBKCoding.create(FCodingFile: string);
begin
  inherited Create;
  FCaseType := ctFirstUpper;
  FIgnoreNullity := false;
  self.FCodingFile := FCodingFile;
  OpenCodingFile;
end;

destructor TGBKCoding.Destroy;
begin
  if FOpened then CloseFile(FTextFile);
  inherited;
end;

function TGBKCoding.getPYByChar(str: string): string;
var
  strLine: string;
  i, iStart, iEnd : integer;
begin
  Result := '';
  if trim(str) = '' then exit;
  if not FOpened then exit;
  Reset(FTextFile);
  for I := 1 to con_CodingStart do    // Iterate
    System.Readln(FTextFile);
  while not Eof(FTextFile) do
  begin
    System.Readln(FTextFile, strLine);
    if AnsiCompareText(Copy(str, 1, 2), Copy(strLine, 1, 2)) = 0 then
    begin
      iStart:= 0; iEnd:= 0;
      for i := 3 to Length(strLine) do    // Iterate
      begin
        if trim(StrLine[i]) <> '' then
        begin
          if iStart = 0 then
            iStart := i
        end
        else if iStart > 0 then
        begin
          result := Copy(strLine, iStart, i - iStart);
          if Result<> '' then
          begin
            case CaseType of    //
              ctFirstUpper: Result[1] := UpperCase(Copy(Result, 1, 1))[1];
              ctAllUpper: Result := UpperCase(Result);
              ctAllLower: Result := LowerCase(Result);
            end;    // case
          end;
          exit;
        end;
      end;    // for
    end;
  end;
end;

function TGBKCoding.getPYByString(str: string): string;
var
  strLine: string;
  i, iLength : integer;
begin
  Result := '';
  if not FOpened then exit;
  iLength := Length(Trim(str));
  if iLength = 0 then exit;
  i:= 1;
  while i <= iLength  do
  begin
    if (Ord(str[i]) > 128) and (i < iLength)  then
    begin
      Result := Result + getPYByChar(Copy(str, i, 2));
      inc(i, 2);
    end
    else if (Ord(str[i]) <= 128) and not FIgnoreNullity then
    begin
      Result := Result + str[i];
      inc(i);
    end
    else
      inc(i);
  end;    // while
end;

procedure TGBKCoding.OpenCodingFile;
begin
  FOpened := false;
  if not FileExists(self.FCodingFile) then
    Exception.Create('GBK编码文件' + self.FCodingFile + '不存在');
  if FOpened then
    CloseFile(FTextFile);
  AssignFile(FTextFile, self.FCodingFile);
  Reset(FTextFile);
  FOpened := true;
end;

end.