unit MakePY02;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Clipbrd, Dialogs, DB, ADODB, StdCtrls, ComCtrls, Grids, DBGridEh;

type
  TPYForm = class(TForm)
    PYBase: TADOConnection;
    Data00: TADOQuery;
    Memo1: TRichEdit;
    Button1: TButton;
    Edit1: TEdit;
    Button2: TButton;
    SB: TStatusBar;
    Edit2: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    Button3: TButton;
    Button4: TButton;
    Button5: TButton;
    Button6: TButton;
    Data00S: TDataSource;
    DBGridEh1: TDBGridEh;
    Button7: TButton;
    Button8: TButton;
    Button9: TButton;
    Memo2: TMemo;
    Button10: TButton;
    Button11: TButton;
    procedure ProdMSPYCode(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure TurnOnMSPYCode(Sender: TObject);
    procedure CloseForm(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Button7Click(Sender: TObject);
    procedure Button8Click(Sender: TObject);
    procedure ReadMSPYFromFile(Sender: TObject);
    procedure ProdGBPYCode(Sender: TObject);
    procedure TurnOnGBPYCode(Sender: TObject);
    procedure ReadGBPYFromFile(Sender: TObject);
  private
    { Private declarations }
    MSPYCode: string;
    GBPYCode: string;
    function GetMSPYStr(HZStr: WideString): string;
    function GetGBPYStr(HZStr: WideString): string;
  public
    { Public declarations }
  end;

Const
  HZ0001: string
  =
    'ABCDEFGHIJKLMNOPQRSTUVWXYZ' +
    'ABCDEFGHIJKLMNOPQRSTUVWXYZ' +
    '1234567890~!@#$%^&*()-+=\|/?<><>"""''[]{}:;,..';
  HZ0002: WideString
  =
    'ＡＢＣＤＥＦＧＨＩＪＫＬＭＮＯＰＱＲＳＴＵＶＷＸＹＺ' +
    'ａｂｃｄｅｆｇｈｉｊｋｌｍｎｏｐｑｒｓｔｕｖｗｘｙｚ' +
    '１２３４５６７８９０～！＠＃＄％＾＆＊（）－＋＝＼｜'+
    '／？＜＞《》“”＂＇［］｛｝：；，．。';
var
  PYForm: TPYForm;

implementation

uses Xeduser;

{$R *.dfm}

procedure TPYForm.FormCreate(Sender: TObject);
begin
  MSPYCode := '';
  GBPYCode := '';
  Data00.Open;
end;

procedure TPYForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Data00.Close;
end;

procedure TPYForm.ReadMSPYFromFile(Sender: TObject);
var
  TS: TStringList;
begin
  TS := TStringList.Create;
  TS.LoadFromFile('MSPYCode.TXT');
  MSPYCode := TS.Text;
  TS.Free;
  Memo1.Text := MSPYCode;
  Memo1.SetFocus;
  SB.Panels[1].Text := Format('拼音字庫長度：%d', [Length(MSPYCode)]);
  SB.Update;
end;

function TPYForm.GetMSPYStr(HZStr: WideString): string;
var
  n, i: integer;
  C: Char;
  PYStr: string;
begin
  Memo2.Clear;
  PYStr := '';
  for i := 1 to Length(HZStr) do begin
    C := string(HZStr[i])[1]; //取 ASCII 碼判斷是否漢字
    if C < #128 then begin
      PYStr := PYStr + UpperCase(HZStr[i]);
    end else begin
      N := Integer(HZStr[i]);
      N := N - 19967; //UniCode 漢字開始于19967
      try
        PYStr := PYStr + MSPYCode[N];
      except
        Memo2.Lines.Add(IntToStr(N) + WideChar(N + 19967));
        PYStr := PYStr + '?'; //非漢字的那些符號
      end;
    end;
  end;
  result := PYStr;
end;

procedure TPYForm.ReadGBPYFromFile(Sender: TObject);
var
  TS: TStringList;
begin
  TS := TStringList.Create;
  TS.LoadFromFile('GBPYCode.TXT');
  GBPYCode := TS.Text;
  TS.Free;
  Memo1.Text := GBPYCode;
  Memo1.SetFocus;
  SB.Panels[1].Text := Format('拼音字庫長度：%d', [Length(MSPYCode)]);
  SB.Update;
end;

function TPYForm.GetGBPYStr(HZStr: WideString): string;
var
  n, i: integer;
  C: Char;
  PYStr: string;
  D: string;
  P, Q, W: integer;
  PCStr: Char;
begin
  if GBPYCode = '' then ReadGBPYFromFile(nil);
  PYStr := '';
  for i := 1 to Length(HZStr) do begin
    C := string(HZStr[i])[1]; //取 ASCII 碼判斷是否漢字
    if C < #128 then begin
      PCStr := UpperCase(HZStr[i])[1];
    end else begin
      D := string(HZStr[I]);
      P := Pos(D, hz0002);
      if P > 0 then begin
         PCStr := HZ0001[P];
      end else begin
        Q := Ord(D[1]) - 176;
        W := Ord(D[2]) - 160;
        if (Q < 0) or (W <= 0) then PYStr := PYStr + '?' else
        try
          N := Q * 94 + W;
          PCStr := GBPYCode[N];
        except
          PCStr := '?'; //非漢字的那些符號
        end;
      end;
    end;
    PYStr:= PYStr + PCStr;
  end;
  result := PYStr;
end;

procedure TPYForm.ProdMSPYCode(Sender: TObject);
var
  FF: TFileStream;
  FN: string;
  BB: PWideChar;
  SS: WideString;
  RR, R2: integer;
  MM, NN: integer;
  LL: integer;
//  P1, P2: integer;
begin
  FN := 'WinPY.MB';
  FF := TFileStream.Create(FN, fmOpenRead);
  RR := $3B0A;
  R2 := $7E300;
  FF.Seek(RR, 0);
  MM := 0;
  GetMem(BB, 100);
  SetLength(SS, 20902);
  LL := 1;
  MSPYCode := '';
  repeat
    NN := FF.Read(BB^, 24);
    if BB^ = #0 then Break; //判斷拼音結束碼
    //SS := SS + BB + #32#32; //得到漢字全拼音
    MSPYCode := MSPYCode + BB[0]; //得到拼音首字母
    MM := MM + 1; //漢字計數
    if MM mod 500 = 0 then begin
      SB.Panels[1].Text := Format('進度：%d/20000', [MM]);
      SB.Update;
      Application.ProcessMessages;
    end;
  until {(MM > 21000) or}(BB^ = #0);
  FF.Free;
  SB.Panels[1].Text := Format('進度：%d/20902', [MM]);
  SB.Update;
  FreeMem(BB, 100);
//  Memo1.Text := SS;
  MSPYCode := UpperCase(MSPYCode);
  Clipboard.AsText := MSPYCode; //將拼音字母放到剪貼板
  Memo1.Text := MSPYCode;
end;

procedure TPYForm.ProdGBPYCode(Sender: TObject);
var
  S: WideString;
  P: WideString;
  i, j: Byte;
begin
  ReadMSPYFromFile(nil);
  S := '';
  for i := 176 to 247 do begin
    for j := 161 to 254 do begin
      S := S + WideString(Char(I) + Char(J));
    end;
  end;
  Memo1.SetFocus;
  P := GetMSPYStr(S);
  GBPYCode := P;
  Memo1.PlainText := True;
  Memo1.Text := P;
  Memo1.Lines.SaveToFile(ExePath + 'GBPYCode.TXT');
  SB.Panels[1].Text := Format('拼音字庫長度：%d', [Length(P)]);
  SB.Update;
end;

procedure TPYForm.TurnOnMSPYCode(Sender: TObject);
var
  S: WideString; //注意為方便最好使用 WideString.
//  S: String;   //注意為方便最好不用 string.
  C: Char;
  i: integer;
  N: integer;
begin
  if MSPYCode = '' then ReadMSPYFromFile(nil);
//  TellME('漢字拼音字母長度：' + IntToStr(Length(MSPYCode)));
  Edit2.Text := '';
  S := Edit1.Text;
  Edit2.Text := GetMSPYStr(S);
end;

procedure TPYForm.TurnOnGBPYCode(Sender: TObject);
var
  S: string;
begin
  if GBPYCode = '' then ProdGBPYCode(nil);
  Edit2.Text := '';
  S := Edit1.Text;
  Edit2.Text := GetGBPYStr(S);
end;

procedure TPYForm.CloseForm(Sender: TObject);
begin
  Close;
end;

procedure TPYForm.Button5Click(Sender: TObject);
var
  MB: TBlobField;
  MS: TADOBlobStream;
  RR: integer;
  TS: TStringStream;
begin
  TS := TStringStream.Create(MSPYCode);
  Data00.Open;
  if not Data00.Locate('編碼名稱', '全拼', []) then begin
    Data00.Append;
    Data00['編碼名稱'] := '全拼';
  end else begin
    Data00.Edit;
  end;
  MB := Data00.FieldByName('編碼內容') as TBlobField;
  MS := TADOBlobStream.Create(MB, bmWrite);
  TS.Position := 0;
  MS.LoadFromStream(TS);
  MS.Free;
  Data00.Post;
  TS.Free;
  Data00.Close;
end;

procedure TPYForm.Button6Click(Sender: TObject);
var
  MB: TBlobField;
  MS: TADOBlobStream;
  RR: integer;
  PP: string;
  MM: TMemoryStream;
begin
  MM := TMemoryStream.Create;
  Data00.Open;
  if not Data00.Locate('編碼名稱', '全拼', []) then Exit;
  MB := Data00.FieldByName('編碼內容') as TBlobField;
  MS := TADOBlobStream.Create(MB, bmRead);
  MS.SaveToStream(MM);
  MS.Free;
  MM.SaveToFile(ExePath + 'MSPYCode.TXT');
  MM.Free;
  Data00.Close;
end;

procedure TPYForm.Button7Click(Sender: TObject);
begin
  Data00.Open;
  if not Data00.Locate('編碼名稱', '全拼', []) then begin
    Data00.Append;
    Data00['編碼名稱'] := '全拼';
  end else begin
    Data00.Edit;
  end;
  Data00['編碼文本'] := MSPYCode;
  Data00.Post;
  Data00.Close;
end;

procedure TPYForm.Button8Click(Sender: TObject);
begin
  Data00.Open;
  if not Data00.Locate('編碼名稱', '全拼', []) then Exit;
  MSPYCode := '';
  MSPYCode := Data00['編碼文本'];
  Data00.Close;
  Memo1.Text := MSPYCode;
  Memo1.PlainText := True;
  Memo1.Lines.SaveToFile(ExePath + 'MSPYCode.TXT');
  Memo1.SetFocus;
  SB.Panels[1].Text := Format('拼音字庫長度：%d', [Length(MSPYCode)]);
  SB.Update;
  Memo1.Text := '[開始]'#13#10 + MSPYCode + '[結束]';
end;

end.