求助！请问一下怎么得到汉字的首字母？

yqsyn 2004-06-17 10:20:10
如题
...全文
209 15 打赏 收藏 转发到动态 举报
写回复
用AI写文章
15 条回复
切换为时间正序
请发表友善的回复…
发表回复
DemonLoveLizzy 2004-09-07
  • 打赏
  • 举报
 回复

$B0A1..$B0C4 : result := 'A';
$B0C5..$B2C0 : result := 'B';
$B2C1..$B4ED : result := 'C';
$B4EE..$B6E9 : result := 'D';
$B6EA..$B7A1 : result := 'E';
$B7A2..$B8C0 : result := 'F';
$B8C1..$B9FD : result := 'G';
$B9FE..$BBF6 : result := 'H';
$BBF7..$BFA5 : result := 'J';
$BFA6..$C0AB : result := 'K';
$C0AC..$C2E7 : result := 'L';
$C2E8..$C4C2 : result := 'M';
$C4C3..$C5B5 : result := 'N';
$C5B6..$C5BD : result := 'O';
$C5BE..$C6D9 : result := 'P';
$C6DA..$C8BA : result := 'Q';
$C8BB..$C8F5 : result := 'R';
$C8F6..$CBF9 : result := 'S';
$CBFA..$CDD9 : result := 'T';
$CDDA..$CEF3 : result := 'W';
$CEF4..$D188 : result := 'X';
$D1B9..$D4D0 : result := 'Y';
$D4D1..$D7F9 : result := 'Z';
DemonLoveLizzy 2004-09-07
  • 打赏
  • 举报
 回复
上有误。转换成16进制自己看看吧。
DemonLoveLizzy 2004-09-07
  • 打赏
  • 举报
 回复
FFFFB0A1
↓
FFFFB0FE A
↓
FFFFB1FE B
↓
FFFFB2FE C
↓
FFFFB3FE D
↓
FFFFB4FE E
↓
FFFFB5FE F

......

依次类推。前边是汉字的16进制格式。
wx05 2004-09-07
  • 打赏
  • 举报
 回复
Dim Str As String, TempStr As String
Dim i As Integer
Str = Text1.Text
TempStr = ""
length = Len(Str)
For i = 1 To length
Select Case Asc(Str)
Case &HB0A1 To &HB0C4: ch = "a"
Case &HB0C5 To &HB2C0: ch = "b"
Case &HB2C1 To &HB4ED: ch = "c"
Case &HB4EE To &HB6E9: ch = "d"
Case &HB6EA To &HB7A1: ch = "e"
Case &HB7A2 To &HB8C0: ch = "f"
Case &HB8C1 To &HB9FD: ch = "g"
Case &HB9FE To &HBBF6: ch = "h"
Case &HBBF7 To &HBFA5: ch = "j"
Case &HBFA6 To &HC0AB: ch = "k"
Case &HC0AC To &HC2E7: ch = "l"
Case &HC2E8 To &HC4C2: ch = "m"
Case &HC4C3 To &HC5B5: ch = "n"
Case &HC5B6 To &HC5BD: ch = "o"
Case &HC5BE To &HC6D9: ch = "p"
Case &HC6DA To &HC8BA: ch = "q"
Case &HC8BB To &HC8F5: ch = "r"
Case &HC8F6 To &HCBF9: ch = "s"
Case &HCBFA To &HCDD9: ch = "t"
Case &HCDDA To &HCEF3: ch = "w"
Case &HCEF4 To &HD188: ch = "x"
Case &HD1B9 To &HD4D0: ch = "y"
Case &HD4D1 To &HD7F9: ch = "z"
Case Else
ch = Left(Str, 1)
End Select
TempStr = TempStr + ch
Str = Mid(Str, 2, Len(Str))
Next
Text2.Text = TempStr
cdsh123 2004-09-06
  • 打赏
  • 举报
 回复
我见过，并且写过代码，不过现在出差没有办法给你

浪子家园 2004-09-02
  • 打赏
  • 举报
 回复
我记得在哪里看到过用区位码法来找每个汉字的首字母，直接定位，而不用比较
rmj0515 2004-09-02
  • 打赏
  • 举报
 回复
没语言
LGYAN 2004-09-01
  • 打赏
  • 举报
 回复
'一个得到拼音的模块
'先建立一个模块,然后在过程中直接调用该函数就可以得到拼音了
'使用方法
dim s as string
s= GetChineseSpell("你好")
'结果 s="nh"

Option Explicit
Public Const CB_SHOWDROPDOWN = &H14F
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, _
lParam As Any) As Long

Private Const IME_ESC_MAX_KEY = &H1005
Private Const IME_ESC_IME_NAME = &H1006
Private Const GCL_REVERSECONVERSION = &H2
Private Declare Function GetKeyboardLayoutList Lib "user32" (ByVal nBuff As Long, lpList As Long) As Long
Private Declare Function ImmEscape Lib "imm32.dll" Alias "ImmEscapeA" (ByVal hkl As Long, ByVal himc As Long, ByVal un As Long, lpv As Any) As Long
Private Declare Function ImmGetConversionList Lib "imm32.dll" Alias "ImmGetConversionListA" (ByVal hkl As Long, ByVal himc As Long, ByVal lpsz As String, lpCandidateList As Any, ByVal dwBufLen As Long, ByVal uFlag As Long) As Long
Private Declare Function IsDBCSLeadByte Lib "kernel32" (ByVal bTestChar As Byte) As Long
Public Function GetChineseSpell(Chinese As String, Optional Delimiter As String = " ", Optional IMEName As String = "微软拼音输入法", Optional BufferSize As Long = 255) As String
If VBA.Len(VBA.Trim(Chinese)) > 0 Then
Dim i As Long
Dim s As String
Dim temp As String
s = VBA.Space(BufferSize)
Dim IMEInstalled As Boolean
Dim j As Long
Dim a() As Long
ReDim a(BufferSize) As Long
j = GetKeyboardLayoutList(BufferSize, a(LBound(a)))


For i = LBound(a) To LBound(a) + j - 1
If ImmEscape(a(i), 0, IME_ESC_IME_NAME, ByVal s) Then
If VBA.Trim(IMEName) = VBA.Replace(VBA.Trim(s), VBA.Chr(0), "") Then
IMEInstalled = True
Exit For
End If
End If
Next i
If IMEInstalled Then
'Stop
Chinese = VBA.Trim(Chinese)
Dim sChar As String
Dim Buffer0() As Byte
'Dim Buffer() As Byte
Dim bBuffer0() As Byte
Dim bBuffer() As Byte
Dim k As Long
Dim l As Long
Dim m As Long
For j = 0 To VBA.Len(Chinese) - 1
sChar = VBA.Mid(Chinese, j + 1, 1)
Buffer0 = VBA.StrConv(sChar, vbFromUnicode)
If IsDBCSLeadByte(Buffer0(0)) Then
k = ImmEscape(a(i), 0, IME_ESC_MAX_KEY, Null)
If k Then
l = ImmGetConversionList(a(i), 0, sChar, 0, 0, GCL_REVERSECONVERSION)
If l Then
s = VBA.Space(BufferSize)
If ImmGetConversionList(a(i), 0, sChar, ByVal s, l, GCL_REVERSECONVERSION) Then

bBuffer0 = VBA.StrConv(s, vbFromUnicode)
ReDim bBuffer(k * 2 - 1)
For m = bBuffer0(24) To bBuffer0(24) + k * 2 - 1
bBuffer(m - bBuffer0(24)) = bBuffer0(m)
Next m
sChar = VBA.Trim(VBA.StrConv(bBuffer, vbUnicode))
If VBA.InStr(sChar, vbNullChar) Then
sChar = VBA.Trim(VBA.left(sChar, VBA.InStr(sChar, vbNullChar) - 1))
End If
sChar = VBA.left(sChar, VBA.Len(sChar) - 1) & VBA.IIf(j < VBA.Len(Chinese) - 1, Delimiter, "")

End If

End If
End If
End If
GetChineseSpell = GetChineseSpell & sChar
Next j
Else

End If

End If
If GetChineseSpell <> "" Then
temp = Mid(GetChineseSpell, 1, 1)
For i = 1 To Len(GetChineseSpell)
If Mid(GetChineseSpell, i, 1) = " " Then
temp = temp + Mid(GetChineseSpell, i + 1, 1)
End If
Next
End If
GetChineseSpell = temp
End Function

huangjianyou 2004-09-01
  • 打赏
  • 举报
 回复
^_^
superxiaomm 2004-09-01
  • 打赏
  • 举报
 回复
强！！！
yelang771 2004-08-30
  • 打赏
  • 举报
 回复
..up
northwolves 2004-08-30
  • 打赏
  • 举报
 回复
Function pinyin(ByVal x As String) As String
Dim i As Integer
Const hanzi = "啊芭擦搭蛾发噶哈击喀垃妈拿哦啪期然撒塌挖昔压匝座ABCDEFGHJKLMNOPQRSTWXYZZ"
If x = "座" Then pinyin = "Z"
For i = 1 To 23
If Asc(x) >= Asc(Mid(hanzi, i, 1)) And Asc(x) < Asc(Mid(hanzi, i + 1, 1)) Then pinyin = Mid(hanzi, 24 + i, 1)
Next
End Function

Function py(ByVal x As String) As String
Dim i As Integer
For i = 1 To Len(x)
If Mid(x, i, 1) <> " " And Asc(Mid(x, i, 1)) < 0 Then py = py & pinyin(Mid(x, i, 1))
Next
py = UCase(py)
End Function

Private Sub Command1_Click()
MsgBox py("中国软件")
End Sub
renjunjun 2004-08-30
  • 打赏
  • 举报
 回复
Public Function GetPY(A1 As String) As String
If Asc(A1) < 0 Then
'四个特殊字
If A1 = "噢" Then
GetPY = "O"
Exit Function
End If
If A1 = "杞" Then
GetPY = "Q"
Exit Function
End If
If A1 = "嘌" Then
GetPY = "P"
Exit Function
End If
If A1 = "呤" Then
GetPY = "L"
Exit Function
End If
'正常汉字
If Asc(A1) < Asc("啊") Then
GetPY = "0"
Exit Function
End If
If Asc(A1) >= Asc("啊") And Asc(A1) < Asc("芭") Then
GetPY = "A"
Exit Function
End If
If Asc(A1) >= Asc("芭") And Asc(A1) < Asc("擦") Then
GetPY = "B"
Exit Function
End If
If Asc(A1) >= Asc("擦") And Asc(A1) < Asc("搭") Then
GetPY = "C"
Exit Function
End If
If Asc(A1) >= Asc("搭") And Asc(A1) < Asc("蛾") Then
GetPY = "D"
Exit Function
End If
If Asc(A1) >= Asc("蛾") And Asc(A1) < Asc("发") Then
GetPY = "E"
Exit Function
End If
If Asc(A1) >= Asc("发") And Asc(A1) < Asc("噶") Then
GetPY = "F"
Exit Function
End If
If Asc(A1) >= Asc("噶") And Asc(A1) < Asc("哈") Then
GetPY = "G"
Exit Function
End If
If Asc(A1) >= Asc("哈") And Asc(A1) < Asc("击") Then
GetPY = "H"
Exit Function
End If
If Asc(A1) >= Asc("击") And Asc(A1) < Asc("喀") Then
GetPY = "J"
Exit Function
End If
If Asc(A1) >= Asc("喀") And Asc(A1) < Asc("垃") Then
GetPY = "K"
Exit Function
End If
If Asc(A1) >= Asc("垃") And Asc(A1) < Asc("妈") Then
GetPY = "L"
Exit Function
End If
If Asc(A1) >= Asc("妈") And Asc(A1) < Asc("拿") Then
GetPY = "M"
Exit Function
End If
If Asc(A1) >= Asc("拿") And Asc(A1) < Asc("哦") Then
GetPY = "N"
Exit Function
End If
If Asc(A1) >= Asc("哦") And Asc(A1) < Asc("啪") Then
GetPY = "O"
Exit Function
End If
If Asc(A1) >= Asc("啪") And Asc(A1) < Asc("期") Then
GetPY = "P"
Exit Function
End If
If Asc(A1) >= Asc("期") And Asc(A1) < Asc("然") Then
GetPY = "Q"
Exit Function
End If
If Asc(A1) >= Asc("然") And Asc(A1) < Asc("撒") Then
GetPY = "R"
Exit Function
End If
If Asc(A1) >= Asc("撒") And Asc(A1) < Asc("塌") Then
GetPY = "S"
Exit Function
End If
If Asc(A1) >= Asc("塌") And Asc(A1) < Asc("挖") Then
GetPY = "T"
Exit Function
End If
If Asc(A1) >= Asc("挖") And Asc(A1) < Asc("昔") Then
GetPY = "W"
Exit Function
End If
If Asc(A1) >= Asc("昔") And Asc(A1) < Asc("压") Then
GetPY = "X"
Exit Function
End If
If Asc(A1) >= Asc("压") And Asc(A1) < Asc("匝") Then
GetPY = "Y"
Exit Function
End If
If Asc(A1) >= Asc("匝") Then
GetPY = "Z"
Exit Function
End If
Else
'英文和数字
If UCase(A1) <= "Z" And UCase(A1) >= "A" Then
GetPY = UCase(A1)
ElseIf A1 <= "9" And A1 >= "0" Then
GetPY = A1
Else
GetPY = "0"
End If
End If
End Function
DragonFly_1976 2004-08-30
  • 打赏
  • 举报
 回复
不用,加我QQ:,给你一段得到汉字拼音的程序.
17437490
programfish 2004-08-30
  • 打赏
  • 举报
 回复
大概只能建个数据库把所有汉字包含进去了。
手机 pdf 阅读器
请先阅读帮助文档：http://ismyway.com/help [2009.1.1] Ver 3.2.26 ※如果安装提示证书过期或无法安装，请在手机上将时间改为2008.8.8，安装设置完成后再将日期改回即可！※ 增加天语的按键映射 增加三星的背景灯控制功能(该功能未在真机上测试过) 删除图片浏览中的部分功能，由于这部分功能需要较大的内存，导致在大部分手机上无法完成，同时也引起背景图片无法设置成功 触摸屏用户可以不再受滚动条限制，在屏幕上任意地方都可以进行拖动 选择键盘映射为其它时无法再次更改的BUG 用户输入的颜色值无法保存的BUG 修正英文单词分词时会多添加一个空行的BUG 繁体语言措词上的修正 阅读设置中增加一个“文件缓存”选项，默认情况下是开启的，在NOKIA手机上会提高UMD等文件的表现，但由于测试并不充足，如果程序经常在阅读时出错，请关闭该选项（其它手机是否开启该选项并无明显的影响） 修正编辑文件后无法保存的BUG [2008.10.27] Ver 3.2.24 ※如果安装提示证书过期或无法安装，请在手机上将时间改为2008.8.8，安装设置完成后再将日期改回即可！※ 改进的颜色选择方式 允许用户重新选择键盘映射 HTML阅读时的错误 进一步完善编辑功能(仍有少许BUG，请继续反馈，谢谢) 新建文件后自动跳转到编辑中 改进的文件操作方式，速度轻微提升 UMD速度明显提升，并且减少内存占用，特别是在NOKIA手机上，表现提升超过600% 改进的输入框模式，以使得能适应更多的手机如天语等 [2008.10.21] Ver 3.2.23 为了提高运行效率，以下功能在LITE上将被取消(自定义欢迎页问候语；欢迎页背景图) 取消了JAR的支持，提高运行效率 修正打开大ZIP文件时的内存溢出错误 ·修正： 　自动滚屏到末尾时，滚屏功能将停止 [2008.10.4] Ver 3.2.22 暂时删除了播放功能及网络相关的功能，由于以上两项功能一直没有能稳定下来，故暂时删除 增强了ZIP功能，支持带文件夹结构的ZIP/JAR文件 (对于大部分JAR电子书都，可以从文件管理器中找到非.class结尾的文件，并且选择打开为UNICODE/TXT阅读) (对于NOKIA手机及其它部分手机，由于安全策略的限制，在Anyview的文件管理器中无法查看后缀为.jar的文件) 自定义问候语(系统路径下dictum.rc文件，格式参见jar包中的dictum.rc文件，保存时使用UTF-8编码，可写条目为0~9/a~z/A~Z，置空时表示不显示问候语) ·修正： 　0键在各偏好中切换时亮度混乱的问题 　部分手机上无法新建文件夹 [2008.9.11] Ver 3.2.21 修正动画参数无法保存的BUG 动画效果不再对阅读翻页有作用 [2008.8.29] Ver 3.2.21 可将正在阅读的内容通过短信与好友分享 增加一种新的滚屏方式：波浪，同时，阅读时3键不再使用默认的像素滚屏，而会使用最后一次使用的滚屏方式 任何可用的外置字库都可以作为内置字库存在，在jar包中存在dot.font会被当为内置字库加载 加快大文件的打开速度，特别是对于NOKIA手机，S60上，打开20M文件，97%左右的位置不超过15秒 允许用户打开动画效果 ·M600/P990/P1/W950 　修正键盘映射时“内存不足”的BUG ·E680/A780 　选中后台播放后无法启动的BUG [2008.7.30] Ver 3.2.20 调整部分索爱手机上背景灯控制的逻辑 修正看图片时按0键出错的BUG 旋转屏幕引起的字外出 打开LRC最后出错 阅读到尾部弹出“上一个/下一个”窗口中的文件名过长不刷新的问题 偏好切换时亮度混乱的问题 在NOKIA上，当系统路径设置为根目录是无法启动的BUG E398上可以开关键盘灯 UIQ系统在退出时可以保持亮度 索爱上按“返回”键后导致阅读出现白屏的BUG 阅读时切换屏幕方向导致字体超出屏幕的BUG 欢迎屏幕上的日期使用中文显示 如果使用触屏手机，跳转改为进度条模式，以方便触屏操作 系统路径下如果存在bg.png文件，则会作为欢迎界面的背景图片显示(右下角) 减少跳转及翻页中出现乱码的机率 提高阅读时绘图效率，滚屏效率同样提高 播放时，暂停会导致声音爆至最大的BUG 内置“忘记月亮”制作的两款主题《典雅红》《黑橙》，并且更换主题不再要求退出 文件管理器中支持“剪切”功能 文件管理器中新增转换UMD为TXT的功能(解开操作，解开2无效！) 增加了编辑功能(尽管没有限制文件大小，但请别编辑过大的文件，另外，为了提高速度，不进行全文排版，有时候表现可能会有些不习惯)，以后会进一步完善 启动时，会自动识别NOKIA、SONYER
在vc中实现获取汉字拼音的首字母
转自：https://blog.csdn.net/iteye_3941/article/details/81577085 最近打算做一个基于字符串首字符（汉字取拼音的首字母）进行查询的电话簿WEB项目，由于Web本身并不支持汉字的编码编程，因此需要求助于平台开发工具。 Google上搜到一种实现方法，是用C++实现的。以下是源码： void GetFirstLetter(CString strNa...
（批处理）批量处理文件名任何后缀的中文文件名字后面加全拼首首字母的批处理
仅以问题中的说明及猜测为据；以下代码复制粘贴到记事本，另存为xx.bat，编码选ANSI，跟要处理的多个文件放一起双击运行。网友求助：比如:格兰蒂亚[GLDY]
vba 全拼_[求助]如何把中文名字转换为拼音（全拼、首字母）
你的位置:问答吧-> excel-> 问题详情[求助]如何把中文名字转换为拼音(全拼、首字母)现需要把中文名字的拼音做企业邮箱的名字，姓用全拼，名用首字母，比如刘翔为liux，应该怎么转换？请高手指点。作者: enpha发布时间: 2008-09-01这个帖子好像论坛以前有人答复过，你搜下。拼音对应的话，应该是...
在VC++中实现获取汉字拼音的首字母,转
最近打算做一个基于字符串首字符（汉字取拼音的首字母）进行查询的电话簿WEB项目，由于Web本身并不支持汉字的编码编程，因此需要求助于平台开发工具。Google上搜到一种实现方法，是用C++实现的。以下是源码：void GetFirstLetter(CString strName, CString& strFirstLetter){    TBYTE ucHigh, ucLow;    in
资源

1,066

社区成员

6,496

社区内容

发帖
与我相关
我的任务
社区描述
VB 资源
社区管理员
  • 资源
加入社区
  • 近7日
  • 近30日
  • 至今

加载中

查看更多榜单
社区公告
暂无公告

试试用AI创作助手写篇文章吧

+ 用AI写文章