让TStrings支持Unicode!

Question

如果让TStrings支持Unicode呢？

Answer 1

试试TNT组件
TntUnicode：
http://www.tonixsoft.com/index.php?mmenu_id=3&smenu_id=0010
另外看看这个试试这个：
{*******************************************************}
{                                                       }
{       Author: 王运龙                                  }
{                                                       }
{  [email protected]                                      }
{                                                       }
{*******************************************************}
unit wnCCVMain;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls;type
  TForm1 = class(TForm)
    btnConvert: TButton;
    rbtnInputHex: TRadioButton;
    rbtnInputChara: TRadioButton;
    memInput: TMemo;
    panResult: TPanel;
    rbtnUToA: TRadioButton;
    rbtnAToU: TRadioButton;
    Bevel1: TBevel;
    gbxUnicode: TGroupBox;
    memUnicode: TMemo;
    gbxAscii: TGroupBox;
    memAscii: TMemo;
    procedure btnConvertClick(Sender: TObject);
    procedure rbtnInputCharaClick(Sender: TObject);
    procedure rbtnInputHexClick(Sender: TObject);
  private
    { Private declarations }    function GetHex(const aStr: string): string;
    function GetChars(aHexStr: string): string;
    //将UnicodeHex AscII字串转换为ANSI Ascii
    function UnicodeHexToStr(const asUnicodeHex: string): string;
    function ChinaToUnicode(const aWideStr: WideString): string;
    function UnicodeHex(const aWideStr: WideString): string;
    function FormatHexDisp(const asHex: string): string;
  public
    { Public declarations }
  end;var
  Form1: TForm1;implementation{$R *.dfm}function TForm1.UnicodeHexToStr(const asUnicodeHex: string): string;
var
  i: Integer;
  sTemp: string;
begin
  //“中国网管程序：操作说明”的Unicode编码16进制为：
  //4E2D 56FD 7F51 7BA1 7A0B 5E8F FF1A 64CD 4F5C 8BF4 660E
  for i := 1 to Length(asUnicodeHex) do
  begin
    if i mod 4 = 0 then
    begin
      sTemp := Copy(asUnicodeHex, i - 3, 4);
      sTemp := WideChar(StrToIntDef('$' + sTemp, 0));
      Result := Result + sTemp;
    end;
  end;
end;
function TForm1.ChinaToUnicode(const aWideStr: WideString): string;
var
  sUnicodeHex: string;
  i : integer;
begin
  for i := 1 to Length(aWideStr) do
  begin
    sUnicodeHex := Format('%.4x', [Word(aWideStr[i])]);
    sUnicodeHex := Chr(StrToInt('$' + Copy(sUnicodeHex, 3, 2))) +
        Chr(StrToInt('$' + copy(sUnicodeHex, 1, 2)));
    Result := Result + sUnicodeHex;
  end;
end;function TForm1.UnicodeHex(const aWideStr: WideString): string;
var
  i: Integer;
begin
  for i := 1 to length(aWideStr) do
  begin
    Result := Result + Format('%.4x', [Word(aWideStr[i])]);
  end;
end;function TForm1.FormatHexDisp(const asHex: string): string;
var
  i, iLen: Integer;
begin
  Result := asHex;
  iLen := Length(Result);
  if Odd(iLen) then
  begin
    Result := '0' + Result;
    Inc(iLen);
  end;  for i := iLen downto 1 do
  begin
    if Odd(i) then Continue;
    
    Insert(' ', Result, i - 1);
  end;
  Result := Trim(Result);
end;procedure TForm1.btnConvertClick(Sender: TObject);
var
  s: string;
begin
  s := memInput.Text;
  if rbtnInputChara.Checked then
  begin
    memUnicode.Text := FormatHexDisp(UnicodeHex(s));
    memAscii.Text := FormatHexDisp(GetHex(s));
  end else
  begin
    s := StringReplace(s, ' ', '', [rfReplaceAll, rfIgnoreCase]);
    if rbtnUToA.Checked then
    begin
      memUnicode.Text := UnicodeHexToStr(s);
      memAscii.Text := FormatHexDisp(GetHex(memUnicode.Text));
    end else
    begin
      memUnicode.Text := GetChars(s);
      memAscii.Text := UnicodeHex(memUnicode.Text);
    end;
  end;
end;procedure TForm1.rbtnInputCharaClick(Sender: TObject);
begin
  memUnicode.Clear;
  memAscii.Clear;
  gbxUnicode.Caption := 'Unicode编码';
  gbxAscii.Caption := 'Ascii编码';
  rbtnUToA.Enabled := False;
  rbtnAToU.Enabled := False;
end;procedure TForm1.rbtnInputHexClick(Sender: TObject);
begin
  memUnicode.Clear;
  memAscii.Clear;  gbxUnicode.Caption := '转换后的文本';
  gbxAscii.Caption := 'Hex编码';
  rbtnUToA.Enabled := True;
  rbtnAToU.Enabled := True;
end;function TForm1.GetHex(const aStr: string): string;
var
  i: Integer;
begin
  for i := 1 to Length(aStr) do
  begin
    Result := Result + Format('%.2x', [Ord(aStr[i])]);
  end;
end;function TForm1.GetChars(aHexStr: string): string;
var
  i: Integer;
begin
  aHexStr := StringReplace(aHexStr, ' ', '', [rfReplaceAll, rfIgnoreCase]);
  for i := 1 to Length(aHexStr) do
  begin
    if Odd(i) then
    begin
      Result := Result + Char(StrToIntDef('$' + Copy(aHexStr, i, 2), 0));
    end;
  end;
end;end.

Answer 2

function Encode1(var s:String):String; 
var 
i,j,len:Integer; 
cur:Integer; 
t:String; 
begin 
Result:=‘’; 
len:=Length(s); 
//j 用于移位计数 
i:=1;j:=0; 
while i<=len do 
begin 
if i//数据变换 
cur:=(ord(s[i]) shr j) or ((ord(s[i＋1]) shl (7－j)) and ＄ff) 
else 
cur:=(ord(s[i]) shr j) and ＄7f; 
FmtStr(t,‘％2.2X’,[cur]); 
Result:=Result＋t; 
inc(i); 
//移位计数达到7位的特别处理 
j:=(j＋1) mod 7;if j=0 then inc(i); 
end; 
end;

Answer 3

wanghome(王鸿) 
你这个函数实现哪些功能？