300分！！！急急急 请问各位高手如何实现汉字繁体向简体的转换字符集是 GB2312 ？？最好给出源码,在下实在是感激不尽！！！！分，一次给不多我保证会再加的！！！

Question

好像有控件来实现的,就是big->big5吧!

Answer 1

unit main;interfaceuses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Buttons, ExtCtrls;type
  TForm1 = class(TForm)
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
    GroupBox1: TGroupBox;
    OpenDialog1: TOpenDialog;
    Source: TGroupBox;
    SofMemo: TMemo;
    SofFile: TEdit;
    BitBtn3: TBitBtn;
    SisMemo: TRadioButton;
    SisFile: TRadioButton;
    SisClip: TRadioButton;
DisMemo: TRadioButton;
    DofMemo: TMemo;
    BitBtn4: TBitBtn;
    DisFile: TRadioButton;
    DofFile: TEdit;
DisClip: TRadioButton;
SaveDialog1: TSaveDialog;
    BitBtn5: TBitBtn;
procedure FormCreate(Sender: TObject);
procedure BitBtn1Click(Sender: TObject);
procedure BitBtn2Click(Sender: TObject);
procedure BitBtn3Click(Sender: TObject);
procedure BitBtn4Click(Sender: TObject);
procedure SisClipClick(Sender: TObject);
procedure SisFileClick(Sender: TObject);
procedure SofMemoKeyUp(Sender: TObject; var Key: Word;
  Shift: TShiftState);
procedure FormDestroy(Sender: TObject);
  private
{ Private declarations }
FGBTable : HGlobal;
FBIGTable: HGlobal;
PGBTable     : PChar;
PBIGTable    : PChar;
FormWidth,
FormHeight: Integer;
function GbToBig(Sur:PChar):PChar;
function BigToGb(Sur:PChar):PChar;
procedure WriteDes;
procedure WMWinPosChanging(var Me: TMessage); message WM_WINDOWPOSCHANGING;
procedure MyWMGetMinMax(var Me:TMessage);message WM_GETMINMAXINFO;
  public
{ Public declarations }
  end;  TChineseType = record
  HiChar: char;
  LoChar: char;
  end;
  TBIGChineseType = array [#$A1..#$FF, #$40..#$FE] of TChineseType;
  PBIGChineseType = ^TBIGChineseType;  //对应于Big字库
  TGBChineseType = array [#$A7..#$FF, #$A1..#$FE] of TChineseType;
  PGBChineseType = ^TGBChineseType; //对应于GB字库
var
  Form1: TForm1;implementation
{$R GBTOBIG.RES}
{$R BIGTOGB.RES}
{$R *.DFM}
procedure TForm1.MyWMGetMinMax(var Me:TMessage);
begin
PMinMaxInfo(Me.LParam).ptMinTrackSize.x:=FormWidth;
PMinMaxInfo(Me.LParam).ptMinTrackSize.y:=FormHeight;
PMinMaxInfo(Me.LParam).ptMaxTrackSize.x:=FormWidth;
PMinMaxInfo(Me.LParam).ptMaxTrackSize.y:=FormHeight;
end;procedure TForm1.WMWinPosChanging(var Me: TMessage); // I am so stupid that
begin                                            // I don't like dialog,
// But I like Form in middle of windows
   PWindowPos(Me.lParam).x:=(Screen.Width-FormWidth) div 2; //and the form must not resize,
   PWindowPos(Me.lParam).y:=(Screen.Height-FormHeight) div 2;  // So ...
   PWindowPos(Me.lParam).cx:=FormWidth;
   PWindowPos(Me.lParam).cy:=FormHeight;
end;procedure TForm1.FormCreate(Sender: TObject);
Var
hRes  : HRSRC;
begin
FormWidth:=GroupBox1.Left+GroupBox1.Width+30;
FormHeight:=BitBtn5.Top+BitBtn5.Height+40; Width:=FormWidth;
Height:=FormHeight; hRes := FindResource(0, 'GBTOBIG', RT_RCDATA);
FGBTable := LoadResource(0, hRes);
PGBTable := LockResource(FGBTable);
if PGBTable=nil then begin
ShowMessage('Load GBTOBIG Resource Error!');
Exit;
end; hRes := FindResource(0, 'BIGTOGB', RT_RCDATA);
FBIGTable := LoadResource(0, hRes);
PBIGTable := LockResource(FBIGTable);
if PBIGTable=nil then begin
ShowMessage('Load BIGTOGB Resource Error!');
Exit;
end;
end;function TForm1.GbToBig(Sur:PChar):PChar;
Var
Der:array [0..255] of Char;
i:Integer;
begin
i:=0;
repeat
if (Sur[i]<#$A1) or (i=StrLen(Sur)-1) or (Sur[i+1]<#$A1) then begin  // is 英文字符
  Der[i]:=Sur[i];
  Inc(i);
End Else Begin  //is 中文字符
if Sur[i]<#$B0 then // #$A1=<Sur[i]<#$B0  -->  GB2312的符号区
Der[i]:= PGBChineseType(PGBTable)^[Chr(Ord(Sur[i])+6),Sur[i+1]].HiChar
else                                 //For  A1+6 = A7
Der[i]:= PGBChineseType(PGBTable)^[Sur[i],Sur[i+1]].HiChar;
Der[i+1]:= PGBChineseType(PGBTable)^[Sur[i],Sur[i+1]].LoChar;
Inc(i);
Inc(i);
End;
until (i>=StrLen(Sur));
Der[StrLen(Sur)]:=#0;
Result:=Der;
end;function TForm1.BigToGb(Sur:PChar):PChar;
Var
Der:array [0..255] of Char;
i:Integer;
begin
i:=0;
repeat
if (Sur[i]<#$A1) or (i=StrLen(Sur)-1) or (Sur[i+1]<#$40) then begin  // is 英文字符
  Der[i]:=Sur[i];
  Inc(i);
End Else Begin  //is 中文字符
Der[i]:= PBIGChineseType(PBIGTable)^[Sur[i],Sur[i+1]].HiChar;
Der[i+1]:= PBIGChineseType(PBIGTable)^[Sur[i],Sur[i+1]].LoChar;
Inc(i);
Inc(i);
End;
until (i>=StrLen(Sur));
Der[StrLen(Sur)]:=#0;
Result:=Der;
end;procedure TForm1.BitBtn1Click(Sender: TObject);
Var
Sur:array [0..255] of Char;
i:Integer;
Begin
DofMemo.Lines.Clear;
for i:=0 to SofMemo.Lines.Count-1 do begin
if SofMemo.Lines[i]='' then
DofMemo.Lines.Append('')
else begin
StrPCopy(Sur,SofMemo.Lines[i]);
DofMemo.Lines.Append(StrPas(GbToBig(Sur)));
End;
End;
WriteDes;
end;procedure TForm1.BitBtn2Click(Sender: TObject);
Var
Sur:array [0..255] of Char;
i:Integer;
Begin
DofMemo.Lines.Clear;
for i:=0 to SofMemo.Lines.Count-1 do begin
if SofMemo.Lines[i]='' then
DofMemo.Lines.Append('')
else begin
StrPCopy(Sur,SofMemo.Lines[i]);
DofMemo.Lines.Append(StrPas(BigToGb(Sur)));
End;
End;
WriteDes;
end;procedure TForm1.BitBtn3Click(Sender: TObject);
begin
if OpenDialog1.Execute then begin
SofFile.Text:=OpenDialog1.FileName;
SisFile.Checked:=True;
End;
end;procedure TForm1.BitBtn4Click(Sender: TObject);
begin
if SaveDialog1.Execute then begin
DisFile.Checked:=True;
DofFile.Text:=SaveDialog1.FileName;
end;
end;procedure TForm1.SisClipClick(Sender: TObject);
begin
if SisClip.Checked then begin
SofMemo.Lines.Clear;
SofMemo.PasteFromClipboard;
end;
end;procedure TForm1.SisFileClick(Sender: TObject);
begin
if not FileExists(SofFile.Text) then
if not OpenDialog1.Execute then
SisMemo.Checked:=True
Else
SofFile.Text:=OpenDialog1.FileName;
if SisFile.Checked then
SofMemo.Lines.LoadFromFile(SofFile.Text);
end;procedure TForm1.WriteDes;
begin
if DisFile.Checked then
DofMemo.Lines.SaveToFile(DofFile.Text);
if DisClip.Checked then begin
DofMemo.SelectAll;
DofMemo.CopyToClipboard;
DofMemo.ClearSelection;
End;
end;procedure TForm1.SofMemoKeyUp(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
SisMemo.Checked:=True;
end;procedure TForm1.FormDestroy(Sender: TObject);
begin
UnLockResource(FGBTable); // In the fact, It is not necessary for
FreeResource(FGBTable);   // Win32-based applications to unlock resources.
// It is not necessary for Win32-based applications
// to free resources loaded by using the LoadResource function.
UnLockResource(FBIGTable); //But my BoundsChecker always report this,
FreeResource(FBIGTable);   //and at the last, I add it.
end;end.