unit1.pas

一个由Delphi写的实时简繁体转换程序演示

// GB and BIG5 code translation
// designed by http://delphi.ktop.com.tw
// you can modified this program , but DO NOT remove delphi.ktop.com.tw mark,Thanks.
// when you have the new program,please upload to delphi.ktop.com.tw
// by K.T.Lee 2002/3/14
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Buttons, StdCtrls, Db, ADODB, CheckLst, ComCtrls, DBCtrls, ExtCtrls,clipbrd,shellapi;

type
  TForm1 = class(TForm)
    ADOConnection1: TADOConnection;
    OpenDialog1: TOpenDialog;
    ADOTable1: TADOTable;
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    TabSheet3: TTabSheet;
    Label1: TLabel;
    Edit1: TEdit;
    SpeedButton1: TSpeedButton;
    Button1: TButton;
    CheckListBox1: TCheckListBox;
    Label2: TLabel;
    ListBox1: TListBox;
    SpeedButton2: TSpeedButton;
    SpeedButton3: TSpeedButton;
    Button2: TButton;
    Button3: TButton;
    Panel1: TPanel;
    Label4: TLabel;
    Label3: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Memo1: TMemo;
    Memo2: TMemo;
    Label7: TLabel;
    Edit2: TEdit;
    SpeedButton4: TSpeedButton;
    Button4: TButton;
    CheckListBox2: TCheckListBox;
    SpeedButton5: TSpeedButton;
    SpeedButton6: TSpeedButton;
    Button5: TButton;
    Button6: TButton;
    Label8: TLabel;
    ListBox2: TListBox;
    OpenDialog2: TOpenDialog;
    SpeedButton7: TSpeedButton;
    CheckBox1: TCheckBox;
    Label9: TLabel;
    TabSheet4: TTabSheet;
    Button7: TButton;
    RichEdit1: TRichEdit;
    Label10: TLabel;
    procedure SpeedButton1Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure SpeedButton2Click(Sender: TObject);
    procedure SpeedButton3Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Memo1Change(Sender: TObject);
    procedure Memo2Change(Sender: TObject);
    procedure SpeedButton4Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure SpeedButton5Click(Sender: TObject);
    procedure SpeedButton6Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure SpeedButton7Click(Sender: TObject);
    procedure Button7Click(Sender: TObject);
    procedure Label4Click(Sender: TObject);
    procedure Label10Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  map:array[1..13468] of array[1..2] of integer;
  map2:array[1..13468] of array[1..2] of integer;
  inchange:boolean;
implementation

{$R *.DFM}
uses unit2;
procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
   if opendialog1.Execute then
      edit1.text:=opendialog1.filename;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
   ListBox1.Clear;
  CheckListBox1.Clear;
  ADOConnection1.connected:=false;
  ADOConnection1.ConnectionString:='Provider=Microsoft.Jet.OLEDB.4.0;Data Source='+edit1.text+';Persist Security Info=False';
  try
  ADOConnection1.connected:=true;
  ADOConnection1.GetTableNames(checklistbox1.Items ,false);
  except
    showmessage('Open Error');
  end;
end;

procedure TForm1.SpeedButton2Click(Sender: TObject);
var i:integer;
begin
   for i:=0 to checklistbox1.items.count-1 do
   checklistbox1.Checked[i]:=true;
end;

procedure TForm1.SpeedButton3Click(Sender: TObject);
var i:integer;
begin
   for i:=0 to checklistbox1.items.count-1 do
   checklistbox1.Checked[i]:=False;
end;
function findbig5(n:integer):string;
var a,b,i,m,j:integer;
    f:boolean;
    c1,c2:char;
begin
   a:=0; b:=13468;
   i:=(a+b) shr 1;
   f:=false;
   while not f do
   begin
       m:=map[i][1];
       if n=m then
       begin
          f:=true;
          m:=map[i][2];
          for j:=i downto 0 do
          begin
             if map[j][1]=n then m:=map[j][2]
             else break;
          end;
          break;
       end
       else if n>m then
       begin
          a:=i+1;
       end
       else
       begin
          b:=i-1;
       end;
       i:=(a+b) shr 1;
       if a>b then break;
   end;
   if not f then m:=n;
   c1:=chr(m shr 8);
   c2:=chr(m mod 256);
   result:=c1+c2;
end;
function gb2big5(s:string):string;
var s2:string;
    i:integer;
    c1,c2,c3:integer;
begin
    s2:='';
    c1:=0; c2:=0;
    for i:=1 to length(s) do
    begin
       c1:=ord(s[i]);
       if c2<>0 then
       begin
          c3:=(c2 shl 8) + c1;
          s2:=s2+findbig5(c3);
          c1:=0; c2:=0;
       end
       else
       if c1>=128 then
       begin
          c2:=c1;
       end
       else s2:=s2+s[i];
    end;
    result:=s2;
end;
function findgb(n:integer):string;
var a,b,i,m:integer;
    f:boolean;
    c1,c2:char;
begin
   a:=0; b:=13468;
   i:=(a+b) shr 1;
   f:=false;
   while not f do
   begin
       m:=map2[i][1];
       if n=m then
       begin
          f:=true;
          m:=map2[i][2];
          break;
       end
       else if n>m then
       begin
          a:=i+1;
       end
       else
       begin
          b:=i-1;
       end;
       i:=(a+b) shr 1;
       if a>b then break;
   end;
   if not f then m:=n;
   c1:=chr(m shr 8);
   c2:=chr(m mod 256);
   result:=c1+c2;
end;
function big52gb(s:string):string;
var s2:string;
    i:integer;
    c1,c2,c3:integer;
begin
    s2:='';
    c1:=0; c2:=0;
    for i:=1 to length(s) do
    begin
       c1:=ord(s[i]);
       if c2<>0 then
       begin
          c3:=(c2 shl 8) + c1;
          s2:=s2+findgb(c3);
          c1:=0; c2:=0;
       end
       else
       if c1>=128 then
       begin
          c2:=c1;
       end
       else s2:=s2+s[i];
    end;
    result:=s2;
end;
procedure TForm1.Button2Click(Sender: TObject);
var i,j,tot:integer;
    tn:string;
begin
   ListBox1.Clear;
   for i:=0 to checklistbox1.items.count-1 do
     if checklistbox1.Checked[i] then
     begin
        try
        ADOTable1.Close;
        ADOTable1.tablename:=checklistbox1.items[i];
        tn:=checklistbox1.items[i];
        ADOTable1.open;
        tot:=0;
        while not ADOTable1.eof do
        begin
        ADOTable1.edit;
          for j:=0 to ADOTable1.FieldCount-1 do
            if (ADOTable1.Fields[j].datatype=ftMemo)
             or (ADOTable1.Fields[j].datatype=ftString)
             or (ADOTable1.Fields[j].datatype=ftFmtMemo)
             or (ADOTable1.Fields[j].datatype=ftBytes)
             or (ADOTable1.Fields[j].datatype=ftVarBytes)
             or (ADOTable1.Fields[j].datatype=ftWideString)
            then
             ADOTable1.Fields[j].asstring:=gb2big5(ADOTable1.Fields[j].asstring);
        inc(tot);
        ADOTable1.post;
        ADOTable1.next;
        caption:=checklistbox1.items[i]+' Record-Count='+inttostr(tot);
        end;
        ADOTable1.Close;
        listbox1.items.add(caption);
        except
           showmessage(checklistbox1.items[i]+' Error!');
        end;
     end;
     caption:='GB <-> BIG5';
end;

procedure TForm1.Button3Click(Sender: TObject);
var i,j,tot:integer;
    tn:string;
begin
   ListBox1.Clear;
   for i:=0 to checklistbox1.items.count-1 do
     if checklistbox1.Checked[i] then
     begin
        try
        ADOTable1.Close;
        ADOTable1.tablename:=checklistbox1.items[i];
        tn:=checklistbox1.items[i];
        ADOTable1.open;
        tot:=0;
        while not ADOTable1.eof do
        begin
        ADOTable1.edit;
          for j:=0 to ADOTable1.FieldCount-1 do
            if (ADOTable1.Fields[j].datatype=ftMemo)
             or (ADOTable1.Fields[j].datatype=ftString)
             or (ADOTable1.Fields[j].datatype=ftFmtMemo)
             or (ADOTable1.Fields[j].datatype=ftBytes)
             or (ADOTable1.Fields[j].datatype=ftVarBytes)
             or (ADOTable1.Fields[j].datatype=ftWideString)
            then
             ADOTable1.Fields[j].asstring:=big52gb(ADOTable1.Fields[j].asstring);
        inc(tot);
        ADOTable1.post;
        ADOTable1.next;
        caption:=checklistbox1.items[i]+' Record-Count='+inttostr(tot);
        end;
        ADOTable1.Close;
        listbox1.items.add(caption);
        except
           showmessage(checklistbox1.items[i]+' Error!');
        end;
     end;
     caption:='GB <-> BIG5';
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  setmap;
end;

procedure TForm1.Memo1Change(Sender: TObject);
var i:integer;
begin
  if inchange then exit;
  memo2.Visible:=false;
  inchange:=true;
  memo2.Clear;
  for i:=0 to memo1.Lines.count-1 do
     memo2.Lines.Add(gb2big5(memo1.lines[i]));
  inchange:=False;
  memo2.Visible:=true;
end;

procedure TForm1.Memo2Change(Sender: TObject);
var i:integer;
begin
  if inchange then exit;
  memo1.Visible:=false;
  inchange:=true;
  memo1.Clear;
  for i:=0 to memo2.Lines.count-1 do
     memo1.Lines.Add(big52gb(memo2.lines[i]));
  inchange:=False;
  memo1.Visible:=true;
end;

procedure TForm1.SpeedButton4Click(Sender: TObject);
var i:integer;
begin
   if opendialog2.Execute then
   begin
      for i:=0 to opendialog2.Files.count-1 do
      begin
      edit2.text:=opendialog2.files[i];
      Button4Click(sender);
      end;
   end;
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
  CheckListBox2.items.add(edit2.text);
  CheckListBox2.checked[CheckListBox2.Items.count-1]:=true;
end;

procedure TForm1.SpeedButton5Click(Sender: TObject);
var i:integer;
begin
   for i:=0 to checklistbox2.items.count-1 do
   checklistbox2.Checked[i]:=true;
end;

procedure TForm1.SpeedButton6Click(Sender: TObject);
var i:integer;
begin
   ListBox2.Clear;
   for i:=0 to checklistbox2.items.count-1 do
   checklistbox2.Checked[i]:=False;
end;

procedure TForm1.Button5Click(Sender: TObject);
var i,j,tot:integer;
    tn,tn2:string;
    ts,ts2:tstringlist;
begin
   ts:=tstringlist.create;
   ts2:=tstringlist.create;
   ListBox2.Clear;
   for i:=0 to checklistbox2.items.count-1 do
     if checklistbox2.Checked[i] then
     begin
        try
        ts.LoadFromFile(checklistbox2.items[i]);
        ts2.Clear;
        tn:=checklistbox2.items[i];
        tn2:=copy(tn,1,length(tn)-length(extractfileext(tn)))+'_'+extractfileext(tn);
        tot:=0;
        for j:=0 to ts.count-1 do
        begin
           ts2.Add(gb2big5(ts[j]));
           inc(tot);
           caption:=tn+' Line-Count='+inttostr(tot);
        end;
        if CheckBox1.Checked then
        begin
           ts2.SaveToFile(tn2);
           caption:=tn2+' Line-Count='+inttostr(tot);
           listbox2.items.add(caption);
        end
        else
        begin
           ts2.SaveToFile(tn);
           caption:=tn+' Line-Count='+inttostr(tot);
           listbox2.items.add(caption);
        end;
        except
           showmessage(tn+' Error!');
        end;
     end;
     caption:='GB <-> BIG5';
     ts.free;
     ts2.free;
end;

procedure TForm1.Button6Click(Sender: TObject);
var i,j,tot:integer;
    tn,tn2:string;
    ts,ts2:tstringlist;
begin
   ts:=tstringlist.create;
   ts2:=tstringlist.create;
   ListBox2.Clear;
   for i:=0 to checklistbox2.items.count-1 do
     if checklistbox2.Checked[i] then
     begin
        try
        ts.LoadFromFile(checklistbox2.items[i]);
        ts2.Clear;
        tn:=checklistbox2.items[i];
        tn2:=copy(tn,1,length(tn)-length(extractfileext(tn)))+'_'+extractfileext(tn);
        tot:=0;
        for j:=0 to ts.count-1 do
        begin
           ts2.Add(big52gb(ts[j]));
           inc(tot);
           caption:=tn+' Line-Count='+inttostr(tot);
        end;
        if CheckBox1.Checked then
        begin
           ts2.SaveToFile(tn2);
           caption:=tn2+' Line-Count='+inttostr(tot);
           listbox2.items.add(caption);
        end
        else
        begin
           ts2.SaveToFile(tn);
           caption:=tn+' Line-Count='+inttostr(tot);
           listbox2.items.add(caption);
        end;
        except
           showmessage(tn+' Error!');
        end;
     end;
     caption:='GB <-> BIG5';
     ts.free;
     ts2.free;
end;

procedure TForm1.SpeedButton7Click(Sender: TObject);
begin
  CheckListBox2.clear;
end;

procedure TForm1.Button7Click(Sender: TObject);
var i,l0,l,j:integer;
    s:string;
    c1,c2,c3,c4,c5,c6:char;
begin
  richedit1.Clear;
  l0:=-1;
  for i:=1 to 13467 do
  begin
     l:=map[i][1];
     if l<>l0 then
     if map[i][1]=map[i+1][1] then
     begin
        c1:=chr(map[i][1] shr 8);
        c2:=chr(map[i][1] mod 256);
                     RichEdit1.SelAttributes.Charset:=GB2312_CHARSET;
                     RichEdit1.SelAttributes.size:=12;
                     s:=format('%4.4X:%s%s -> ',[map[i][1],c1,c2]);
                     clipboard.SetTextBuf(pchar(s));
                     RichEdit1.PasteFromClipboard;
                     s:='';
                     for j:=i to 13468 do
                     begin
                        if l=map[j][1] then
                        begin
                            c3:=chr(map[j][2] shr 8);
                            c4:=chr(map[j][2] mod 256);
                            s:=s+format('%4.4X:%s%s ',[map[j][2],c3,c4]);
                        end
                        else break;
                     end;
                     s:=s+#13#10;
                     RichEdit1.SelAttributes.Charset:=CHINESEBIG5_CHARSET;
                     clipboard.SetTextBuf(pchar(s));
                     RichEdit1.PasteFromClipboard;
     end;
     l0:=l;
  end;

end;

procedure TForm1.Label4Click(Sender: TObject);
begin
    ShellExecute(Application.MainForm.Handle, nil,
    'http://delphi.ktop.com.tw', nil, nil,
             SW_SHOW);

end;

procedure TForm1.Label10Click(Sender: TObject);
begin
    ShellExecute(Application.MainForm.Handle, nil,
    'http://delphi.ktop.com.tw', nil, nil,
             SW_SHOW);
end;

initialization
  inchange:=false;
end.