function HZtoPY(HZStr: WideString): String;
Var
  s, c: AnsiString;
  i: Integer;
begin
  Result := '';
  for i := 1 To Length(HZStr) do
  begin
    s := HZStr[I];
    if ByteType(s, 1) = mbSingleByte Then
      c := S
    else
      case word(s[1]) shl 8 + word(s[2]) of
        $B0A1 .. $B0C4: C := 'A';    $B0C5 .. $B2C0: C := 'B';
        $B2C1 .. $B4ED: C := 'C';    $B4EE .. $B6E9: C := 'D';
        $B6EA .. $B7A1: C := 'E';    $B7A2 .. $B8C0: C := 'F';
        $B8C1 .. $B9FD: C := 'G';    $B9FE .. $BBF6: C := 'H';
        $BBF7 .. $BFA5: C := 'J';    $BFA6 .. $C0AB: C := 'K';
        $C0AC .. $C2E7: C := 'L';    $C2E8 .. $C4C2: C := 'M';
        $C4C3 .. $C5B5: C := 'N';    $C5B6 .. $C5BD: C := 'O';
        $C5BE .. $C6D9: C := 'P';    $C6DA .. $C8BA: C := 'Q';
        $C8BB .. $C8F5: C := 'R';    $C8F6 .. $CBF9: C := 'S';
        $CBFA .. $CDD9: C := 'T';    $CDDA .. $CEF3: C := 'W';
        $CEF4 .. $D1B8: C := 'X';    $D1B9 .. $D4D0: C := 'Y';
        $D4D1 .. $D7F9: C := 'Z';
      else
        c := s;
      end;
    Result := Result + C;
  end;
end;