VBGood网站全文搜索 Google

搜索VBGood全站网页(全文搜索)

VB爱好者乐园(VBGood)

 找回密码
 立即注册
搜索
查看: 4557|回复: 4

[转帖] 国标码简体、繁体与港台繁体之间相互转换(百度搜索)

[复制链接]
 楼主| 发表于 2008-12-12 20:12:51 | 显示全部楼层 |阅读模式

  1. Option Explicit

  2. Private Declare Function LCMapString Lib "kernel32" Alias _
  3. "LCMapStringA" (ByVal Locale As Long, ByVal dwMapFlags As Long, _
  4. ByVal lpSrcStr As String, ByVal cchSrc As Long, ByVal lpDestStr _
  5. As String, ByVal cchDest As Long) As Long

  6. Private Declare Function lstrlen Lib "kernel32" Alias "lstrlenA" _
  7. (ByVal lpString As String) As Long

  8. Dim ST As String, i As Long

  9. Private Sub Form_Load()
  10. Text1 = "问君能有几多愁,恰似一江春水向东流。"

  11. End Sub

  12. Private Sub Command1_Click() '国标繁体转国标简体
  13. i = lstrlen(Text1): ST = Space(i)
  14. LCMapString &H804, &H2000000, Text1, i, ST, i
  15. Text1 = ST
  16. End Sub

  17. Private Sub Command2_Click() '国标简体转国标繁体
  18. i = lstrlen(Text1): ST = Space(i)
  19. LCMapString &H804, &H4000000, Text1, i, ST, i
  20. Text1 = ST
  21. End Sub

  22. Private Sub Command3_Click() '国标繁体转港台繁体
  23. ST = StrConv(Text1, vbFromUnicode)
  24. ST = StrConv(ST, vbUnicode, &H804)
  25. ST = StrConv(ST, vbFromUnicode, &H404)
  26. Text1 = StrConv(ST, vbUnicode)
  27. End Sub

  28. Private Sub Command4_Click() '港台繁体转国标繁体
  29. ST = StrConv(Text1, vbFromUnicode)
  30. ST = StrConv(ST, vbUnicode, &H404)
  31. ST = StrConv(ST, vbFromUnicode, &H804)
  32. Text1 = StrConv(ST, vbUnicode)
  33. End Sub
复制代码

评分

参与人数 1人气 +1 收起 理由
261001126 + 1 加分才是支持的方式

查看全部评分

发表于 2008-12-12 20:36:27 | 显示全部楼层
还是支持
回复 支持 反对

使用道具 举报

发表于 2008-12-14 10:18:48 | 显示全部楼层
嗯,这个函数有许多实用功能,里面也有个半角全角转换功能的,但,我测试了下,并不正确。我把我的代码贴出去,大家看看是否有错


  1. Private Declare Function LCMapString Lib "kernel32.dll" Alias "LCMapStringW" (ByVal Locale As Long, ByVal dwMapFlags As Long, ByVal lpSrcStr As Long, ByVal cchSrc As Long, ByVal lpDestStr As Long, ByVal cchDest As Long) As Long
  2. Private Const LCMAP_FULLWIDTH As Long = &H800000
  3. Private Const LCMAP_HALFWIDTH As Long = &H400000

  4. ' 全角函数转半角
  5. Public Function ToBanJiao(s As String) As String
  6.     Dim ret As Long, s1 As String, s1b As Long
  7.     s1b = Len(s) + 1
  8.     s1 = Space(s1b)
  9.     ret = LCMapString(&H804, LCMAP_HALFWIDTH, StrPtr(s), s1b, StrPtr(s1), s1b)
  10.     ToBanJiao = s1
  11. End Function
复制代码

经测试
/*-+,。/?;‘、[]{}!?#¥%……--*()
/ * - + , ? / ? ; ' ? [ ] { } ! ?#¥%……--*()

句号,顿号,不能正确返回半角符号?嗯,还没有测试过空格,空格应该也一样吧。
不知道各位有啥好方法处理半角和全角关系呢。
回复 支持 反对

使用道具 举报

发表于 2008-12-14 10:20:01 | 显示全部楼层
刚才测试下空格,全格的空格,倒是能够返回半个的空格呢。那就剩下中文句号和顿号了。
回复 支持 反对

使用道具 举报

发表于 2013-5-24 22:37:02 | 显示全部楼层
很棒!!!
回复 支持 反对

使用道具 举报

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

文字版|手机版|小黑屋|VBGood  

GMT+8, 2022-6-29 21:44

VB爱好者乐园(VBGood)
快速回复 返回顶部 返回列表