DELPHI盒子
!实时搜索: 盒子论坛 | 注册用户 | 修改信息 | 退出
检举帖 | 全文检索 | 关闭广告 | 捐赠
技术论坛
 用户名
 密  码
自动登陆(30天有效)
忘了密码
≡技术区≡
DELPHI技术
移动应用开发
Web应用开发
数据库专区
报表专区
网络通讯
开源项目
论坛精华贴
≡发布区≡
发布代码
发布控件
文档资料
经典工具
≡事务区≡
网站意见
盒子之家
招聘应聘
信息交换
论坛信息
最新加入: bentti
今日帖子: 29
在线用户: 8
导航: 论坛 -> DELPHI技术 斑竹:liumazi,sephil  
作者:
男 he_19_79 (he) ▲▲▲▲△ -
注册会员
2020/1/21 16:55:42
标题:
Delphi 简体繁体转换程序,以前问过大家,没解决. 这几天过年没事时做了一个简单的. 浏览:315
加入我的收藏
楼主: 转换PAS比较容易,读一行转一行. DFM稍微复杂一些. 下面的代码就是转DFM的.
----------------------------------------------
-
作者:
男 he_19_79 (he) ▲▲▲▲△ -
注册会员
2020/1/21 16:56:24
1楼: {








}
unit unitConvertDFM;

interface

uses
   Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
   Vcl.Controls, Vcl.Forms, Vcl.Dialogs, cxGraphics, cxLookAndFeels, cxLookAndFeelPainters, Vcl.Menus, Vcl.StdCtrls, cxButtons, Vcl.FileCtrl, cxControls,
   cxContainer, cxEdit, cxTextEdit, Vcl.ComCtrls;

type
   TfrmConvertDFM = class(TForm)
      dlbDirectoryListBox_DFM: TDirectoryListBox;
      stbConvert: TStatusBar;
      btnConvert_BIG5: TButton;
      btnConvert_GB: TButton;
      procedure btnConvert_GBClick(Sender: TObject);
      procedure btnConvert_BIG5Click(Sender: TObject);
   private
    { Private declarations }
   public
    { Public declarations }

      function DFM_FileList(aDirectoryPath: string): TStringList;

      function DFM_FileType(const aFileName: String): Integer;

      function DFM_BinaryToText(const aFileName_Binary, aFileName_Text: String): Integer;
      function DFM_TextToBinary(const aFileName_Binary, aFileName_Text: String): Integer;

      function DFM_Convert(const aFileName: String; iConvert_Type: Integer): Integer;

      function GBToBig5(aGB: string): string;
      function Big5ToGB(aBig: string): string;
   end;

var
   frmConvertDFM: TfrmConvertDFM;

implementation

{$R *.dfm}

{


}
function TfrmConvertDFM.GBToBig5(aGB: string): string;
var
   iLength: Integer;
begin
   iLength := aGB.Length;

   SetLength(Result, iLength);

   LCMapString(GetUserDefaultLCID, LCMAP_TRADITIONAL_CHINESE, PChar(aGB), iLength, PChar(Result), iLength);
end;

{


}
function TfrmConvertDFM.Big5ToGB(aBig: string): string;
var
   iLength: Integer;
begin
   iLength := aBig.Length;

   SetLength(Result, iLength);

   LCMapString(GetUserDefaultLCID, LCMAP_SIMPLIFIED_CHINESE, PChar(aBig), iLength, PChar(Result), iLength);
end;

{


}
procedure TfrmConvertDFM.btnConvert_BIG5Click(Sender: TObject);
var
   sTemp: String;
   iTemp, iCount: Integer;
   slDFM_File: TStringList;
begin
   slDFM_File := DFM_FileList(dlbDirectoryListBox_DFM.Directory);

   try
      iCount := slDFM_File.Count;

      for iTemp := 0 to iCount - 1 do
      begin
         sTemp := slDFM_File.Strings[iTemp];

         stbConvert.Panels[0].Text := IntToStr(iTemp + 1) + '/' + IntToStr(iCount);
         stbConvert.Panels[1].Text := sTemp;
         stbConvert.Panels[2].Text := '';

         Application.ProcessMessages;

         DFM_Convert(sTemp, 1);
      end;

      MessageDlg('轉換完成!', mtInformation, [mbOK], 0);
   except
      on E: Exception do
         ShowMessage(E.Message);
   end;
end;

{


}
procedure TfrmConvertDFM.btnConvert_GBClick(Sender: TObject);
var
   sTemp: String;
   iTemp, iCount: Integer;
   slDFM_File: TStringList;
begin
   slDFM_File := DFM_FileList(dlbDirectoryListBox_DFM.Directory);

   try
      iCount := slDFM_File.Count;

      for iTemp := 0 to iCount - 1 do
      begin
         sTemp := slDFM_File.Strings[iTemp];

         stbConvert.Panels[0].Text := IntToStr(iTemp + 1) + '/' + IntToStr(iCount);
         stbConvert.Panels[1].Text := sTemp;
         stbConvert.Panels[2].Text := '';

         Application.ProcessMessages;

         DFM_Convert(sTemp, 2);
      end;

      MessageDlg('转换完成!', mtInformation, [mbOK], 0);
   except
      on E: Exception do
         ShowMessage(E.Message);
   end;
end;

{


}
function TfrmConvertDFM.DFM_Convert(const aFileName: String; iConvert_Type: Integer): Integer;
var
   sTemp, sLine, sLine_New: String;
   iTemp, iFileType_DFM, iLine: Integer;
   tfFile1, tfFile2: TextFile;
begin
   Result := 2;

   Application.ProcessMessages;

   iFileType_DFM := DFM_FileType(aFileName);

   sTemp := aFileName.Substring(0, Length(aFileName) - 4) + FormatDateTime('yyyymmddhhnnss', Now) + '.DFM1';

   MoveFile(PChar(aFileName), PChar(sTemp)); // 备份源文件

   if iFileType_DFM = 1 then
   begin
      // 如果DFM是二进制, 要转为文本格式

      if DFM_BinaryToText(sTemp, sTemp.Substring(0, sTemp.Length - 5) + '.DFM2') = 2 then
         Exit;

      sTemp := sTemp.Substring(0, sTemp.Length - 5) + '.DFM2';
   end;

   AssignFile(tfFile1, sTemp);
   AssignFile(tfFile2, aFileName);

   try
      Reset(tfFile1);

      ReWrite(tfFile2);

      iLine := 0;

      while not eof(tfFile1) do
      begin
         Readln(tfFile1, sLine);

         sLine_New := '';

         if (sLine.Trim.Length > 5) and (sLine.TrimLeft[1] in ['a' .. 'z', 'A' .. 'Z']) and (sLine.IndexOf('Font.Name = ') < 0) and (sLine.IndexOf(' = ') >= 0)
          and (sLine.IndexOf('#') >= 0) then
         begin
          iTemp := sLine.IndexOf(' = ') + (' = ').Length;

          sLine_New := sLine.Substring(0, iTemp);

          sLine := sLine.Substring(iTemp);

          while (sLine.Length > 5) and (sLine.IndexOf('#') >= 0) do
          begin
          sTemp := sLine.Substring(0, 1);

          if sTemp = '''' then
          begin
          // ? 可能有错误,没有测试. 说可能的原因是因为转换的行中的字符本身可能有单引号,导致匹配位置不正确.

          iTemp := sLine.IndexOf('''', 1);

          sTemp := sLine.Substring(0, iTemp + 1);

          sLine_New := sLine_New + sTemp;

          sLine := sLine.Substring(iTemp + 1);
          end
          else if sTemp = '#' then
          begin
          sLine_New := sLine_New + '#';

          sTemp := sLine.Substring(1, 5);

          if (sTemp >= '19968') and (sTemp <= '40869') and (sTemp[1] in ['0' .. '9']) and (sTemp[2] in ['0' .. '9']) and (sTemp[3] in ['0' .. '9']) and
          (sTemp[4] in ['0' .. '9']) and (sTemp[5] in ['0' .. '9']) then
          begin
          iTemp := sTemp.ToInteger;

          if iConvert_Type = 1 then
          sTemp := ORD(GBToBig5(CHR(iTemp))[1]).ToString
          else if iConvert_Type = 2 then
          sTemp := ORD(Big5ToGB(CHR(iTemp))[1]).ToString;

          sLine_New := sLine_New + sTemp;

          sLine := sLine.Substring(6);
          end
          else
          begin
          sLine := sLine.Substring(1);
          end;
          end
          else
          begin
          sLine_New := sLine_New + sTemp;

          sLine := sLine.Substring(1);
          end;
          end;
         end;

         sLine_New := sLine_New + sLine; // 此处的sLine原字符串通过截取后的字符串.

         Writeln(tfFile2, sLine_New);

         iLine := iLine + 1;

         if iLine mod 10 = 0 then
         begin
          stbConvert.Panels[2].Text := IntToStr(iLine) + '/..';

          Application.ProcessMessages;
         end;
      end;
   finally
      CloseFile(tfFile1);
      CloseFile(tfFile2);
   end;

   try
      if iFileType_DFM = 1 then
      begin
         // 源文件是二进制时, 把文本的DFM转为二进制的DFM

         sTemp := aFileName.Substring(0, Length(aFileName) - 4) + FormatDateTime('yyyymmddhhnnss', Now) + '.DFM3';

         MoveFile(PChar(aFileName), PChar(sTemp));

         if DFM_TextToBinary(aFileName, sTemp) = 2 then
         begin

          Exit;
         end;
      end;

      Result := 1;
   finally

   end;
end;

{


}
function TfrmConvertDFM.DFM_FileList(aDirectoryPath: string): TStringList;
var
   FileSearchRec: TSearchRec;
begin
   Result := TStringList.Create;

   if aDirectoryPath.Substring(aDirectoryPath.Length - 1) <> '\' then
      aDirectoryPath := aDirectoryPath.Trim + '\'
   else
      aDirectoryPath := aDirectoryPath.Trim;

   if not DirectoryExists(aDirectoryPath) then
   begin
      Result.Clear;

      Exit;
   end;

   if FindFirst(aDirectoryPath + '*', faAnyfile, FileSearchRec) = 0 then
   begin
      repeat
         Application.ProcessMessages;

         if ((FileSearchRec.Name = '.') or (FileSearchRec.Name = '..')) then
          Continue;

         if DirectoryExists(aDirectoryPath + FileSearchRec.Name) then
         begin
          Result.AddStrings(DFM_FileList(aDirectoryPath + FileSearchRec.Name));
         end
         else
         begin
          if UpperCase(ExtractFileExt(aDirectoryPath + FileSearchRec.Name)) = UpperCase('.DFM') then
          Result.Add(aDirectoryPath + FileSearchRec.Name);
         end;
      until FindNext(FileSearchRec) <> 0;

      System.SysUtils.FindClose(FileSearchRec);
   end;
end;

{


}
function TfrmConvertDFM.DFM_FileType(const aFileName: String): Integer;
var
   msStream: TMemoryStream;
   mBuff: array [0 .. 2] of byte;
begin
   Result := 2;

   msStream := TMemoryStream.Create;

   try
      msStream.LoadFromFile(aFileName);
      msStream.Read(mBuff, 3);

      if (mBuff[0] = $FF) and (mBuff[1] = $0A) and (mBuff[2] = $00) then
         Result := 1;
   finally
      msStream.Free;
   end;
end;

{


}
function TfrmConvertDFM.DFM_BinaryToText(const aFileName_Binary, aFileName_Text: String): Integer;
var
   MemoryStream_Binary: TMemoryStream;
   FileStream_Text: TFileStream;
begin
   Result := 1;

   MemoryStream_Binary := TMemoryStream.Create;
   MemoryStream_Binary.LoadFromFile(aFileName_Binary);

   try
      FileStream_Text := TFileStream.Create(aFileName_Text, fmCreate);

      try
         try
          MemoryStream_Binary.Seek(0, soFromBeginning);

          ObjectResourceToText(MemoryStream_Binary, FileStream_Text);
         except
          on E: Exception do
          begin
          MessageDlg(E.Message, mtError, [mbCancel], 0);

          Result := 2;
          end;
         end;
      finally
         FileStream_Text.Free;
      end;
   finally
      MemoryStream_Binary.Free;
   end;
end;

{


}
function TfrmConvertDFM.DFM_TextToBinary(const aFileName_Binary, aFileName_Text: String): Integer;
var
   MemoryStream_TextFile: TMemoryStream;
   FileStream_Binary: TFileStream;
begin
   Result := 1;

   MemoryStream_TextFile := TMemoryStream.Create;
   MemoryStream_TextFile.LoadFromFile(aFileName_Text);

   try
      FileStream_Binary := TFileStream.Create(aFileName_Binary, fmCreate);

      try
         try
          MemoryStream_TextFile.Seek(0, soFromBeginning);

          ObjectTextToResource(MemoryStream_TextFile, FileStream_Binary);
         except
          on E: Exception do
          begin
          MessageDlg(E.Message, mtError, [mbCancel], 0);

          Result := 2;
          end;
         end;
      finally
         FileStream_Binary.Free;
      end;
   finally
      MemoryStream_TextFile.Free;
   end;
end;

end.
----------------------------------------------
-
作者:
男 he_19_79 (he) ▲▲▲▲△ -
注册会员
2020/1/21 17:04:36
2楼: 没怎么测试,可能有误.
----------------------------------------------
-
作者:
男 vmao (毛小毛) ★☆☆☆☆ -
盒子活跃会员
2020/1/22 21:41:37
3楼: 这个只是转码,转过去效果不好,有些名词台湾的叫法不一样。
我以前是把所有的dfm重命名成pas,这样就只有一种文件了,然后放一个wordapplication对象调用word里面的的繁简体转换功能,转好的dfm再重命名回来,放一个新工程里。速度比较慢,但是效果不错,很多名词都转过来了。比如导弹,转成繁体就是飞弹,鼠标转成繁体就是滑鼠。
----------------------------------------------
-
作者:
男 plusv (plusv) ▲▲▲▲△ -
注册会员
2020/1/23 19:05:29
4楼: 有没有 非 UniCode 的繁简互转 CP 936 / CP 950

https://www.itread01.com/content/1545316157.html
Delphi 2010 测试无法转换
----------------------------------------------
-
信息
登陆以后才能回复
Copyright © 2CCC.Com 盒子论坛 v2.1 版权所有 页面执行46.875毫秒 RSS