有人在www.codelphi.com上这样回答我这个问题
unit main;
interface
uses
; 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
Char)
Char;
; function BigToGb(Sur
Char)
Char;
; 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
Char)
Char;
Var
Der:array [0..255] of Char;
i:Integer;
begin
i:=0;
repeat
if (Sur
<#$A1) or (i=StrLen(Sur)-1) or (Sur[i+1]<#$A1) then begin // is 英文字符
Der:=Sur;
Inc(i);
End Else Begin //is 中文字符
if Sur<#$B0 then // #$A1=<Sur<#$B0 --> GB2312的符号区
Der:= PGBChineseType(PGBTable)^[Chr(Ord(Sur)+6),Sur[i+1]].HiChar
else //For A1+6 = A7
Der:= PGBChineseType(PGBTable)^[Sur,Sur[i+1]].HiChar;
Der[i+1]:= PGBChineseType(PGBTable)^[Sur,Sur[i+1]].LoChar;
Inc(i);
Inc(i);
End;
until (i>=StrLen(Sur));
Der[StrLen(Sur)]:=#0;
Result:=Der;
end;
function TForm1.BigToGb(SurChar)Char;
Var
Der:array [0..255] of Char;
i:Integer;
begin
i:=0;
repeat
if (Sur<#$A1) or (i=StrLen(Sur)-1) or (Sur[i+1]<#$40) then begin // is 英文字符
Der:=Sur;
Inc(i);
End Else Begin //is 中文字符
Der:= PBIGChineseType(PBIGTable)^[Sur,Sur[i+1]].HiChar;
Der[i+1]:= PBIGChineseType(PBIGTable)^[Sur,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='' then
DofMemo.Lines.Append('')
else begin
StrPCopy(Sur,SofMemo.Lines);
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='' then
DofMemo.Lines.Append('')
else begin
StrPCopy(Sur,SofMemo.Lines);
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.