VB高手求教提取字符首字母问题!!!

全国VB高手您们好:遇到一个棘手问题(在提取字符首字母时,不能提取占两个字节的字母,提示错误为:无效的过程调用或参数:(如Ａ沉沉听,占8个字节,Ａ占两个字节,小妹想提取拼音为ACCT),  
  但(A沉沉听占8个字节,A占1个字节,小妹能提取出拼音ACCT),请教该如何处理,谢谢各位!!!!  
  以下是程序(AAA.DAT里有Ａ沉沉听,占8个字节,BBB.DAT里有A沉沉听,占8个字节)  
  Option   Explicit  
  Private   Type   RECORD  
  SS(1   To   8)   As   Byte  
  End   Type  
  Dim   aa   As   New   Class1  
  Private   Sub   Command1_Click()  
  Text2.Text   =   aa.MSPYReverse(Text1.Text)  
  End   Sub  
  Private   Sub   Command2_Click()  
  Dim   A   As   RECORD  
  Open   App.Path   &   "\BBB.dat"   For   Binary   Access   Read   As   #1  
  Get   #1,   ,   A  
  Text1.Text   =   StrConv(A.SS,   vbUnicode)  
  Close   #1  
  Text2.Text   =   aa.MSPYReverse(Text1.Text)  
  End   Sub  
   
  Private   Sub   Form_Load()  
  Dim   A   As   RECORD  
  Open   App.Path   &   "\AAA.dat"   For   Binary   Access   Read   As   #1  
  Get   #1,   ,   A  
  Text1.Text   =   StrConv(A.SS,   vbUnicode)  
  Close   #1  
  End   Sub  
   
   
  '以下是提取拼音类模块:  
  Private   Const   IME_ESC_MAX_KEY   =   &H1005  
  Private   Const   IME_ESC_IME_NAME   =   &H1006  
  Private   Const   GCL_REVERSECONVERSION   =   &H2  
   
  Private   Type   CANDIDATELIST  
  dwSize   As   Long  
  dwStyle   As   Long  
  dwCount   As   Long  
  dwSelection   As   Long  
  dwPageStart   As   Long  
  dwPageSize   As   Long  
  dwOffset(1)   As   Long  
  End   Type  
   
  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   ImmGetConversionList   Lib   "imm32.dll"   Alias   "ImmGetConversionListA"   (ByVal   hkl   As   Long,   ByVal   himc   As   Long,   ByVal   lpsz   As   String,   lpCandidateList   As   CANDIDATELIST,   ByVal   dwBufLen   As   Long,   ByVal   uFlag   As   Long)   As   Long  
  Private   Declare   Function   IsDBCSLeadByte   Lib   "kernel32"   (ByVal   bTestChar   As   Byte)   As   Long  
   
  Private   Const   NUM_OF_BUFFERS   =   40  
  Private   Const   MSPY   =   "微软拼音输入法"  
  Dim   imeHandle(1   To   NUM_OF_BUFFERS)   As   Long  
  Dim   imeName(1   To   NUM_OF_BUFFERS)   As   String  
   
  Dim   mlMSPYIndex   As   Long  
  Dim   imeCount   As   Long  
   
  Private   Sub   Init()  
  Dim   i   As   Long  
  Dim   sName   As   String  
   
  mlMSPYIndex   =   0  
  imeCount   =   GetKeyboardLayoutList(NUM_OF_BUFFERS,   imeHandle(1))  
  If   imeCount   Then  
  For   i   =   1   To   imeCount  
  sName   =   String(255,   "   ")  
  If   ImmEscape(imeHandle(i),   0,   IME_ESC_IME_NAME,   ByVal   sName)   Then  
  If   sName   <>   ""   Then   sName   =   Left(sName,   InStr(sName,   vbNullChar)   -   1)  
  imeName(i)   =   sName  
  If   sName   =   MSPY   Then  
  mlMSPYIndex   =   i  
  End   If  
  End   If  
  Next   i  
  End   If  
   
  End   Sub  
   
  Public   Property   Get   MSPYInstalled()   As   Boolean  
  MSPYInstalled   =   IIf(mlMSPYIndex,   True,   False)  
  End   Property  
   
  Public   Property   Get   MSPYIndex()   As   Long  
  MSPYIndex   =   mlMSPYIndex  
  End   Property  
   
  Public   Property   Get   Count()   As   Long  
  Count   =   imeCount  
  End   Property  
   
  Public   Function   GetHandle(ByVal   lIndex   As   Long)   As   Long  
  If   lIndex   >=   1   And   lIndex   <=   imeCount   Then  
  GetHandle   =   imeHandle(lIndex)  
  End   If  
  End   Function  
   
  Public   Function   GetName(ByVal   lIndex   As   Long)   As   String  
  If   lIndex   >=   1   And   lIndex   <=   imeCount   Then  
  GetName   =   imeName(lIndex)  
  End   If  
  End   Function  
   
  Public   Function   MSPYReverse(ByVal   sString   As   String)   As   String  
  Dim   lStrLen   As   Long  
  Dim   i   As   Long  
  Dim   sChar   As   String  
  Dim   bChar()   As   Byte  
   
  If   MSPYInstalled   Then  
  lStrLen   =   Len(sString)  
  MSPYReverse   =   ""  
  If   lStrLen   Then  
  For   i   =   1   To   lStrLen  
  sChar   =   Mid(sString,   i,   1)  
  bChar   =   StrConv(sChar,   vbFromUnicode)  
  If   IsDBCSLeadByte(bChar(0))   Then  
  Dim   lMaxKey   As   Long  
  Dim   lGCL   As   Long  
   
  lMaxKey   =   ImmEscape(imeHandle(mlMSPYIndex),   0,   IME_ESC_MAX_KEY,   Null)  
  If   lMaxKey   Then  
  Dim   tCandi   As   CANDIDATELIST  
  lGCL   =   ImmGetConversionList(imeHandle(mlMSPYIndex),   0,   sChar,   0,   0,   GCL_REVERSECONVERSION)  
  If   lGCL   >   0   Then  
  Dim   bBuffer()   As   Byte  
  Dim   MaxKey   As   Long  
  Dim   sBuffer   As   String  
  sBuffer   =   String(255,   vbNullChar)  
  MaxKey   =   lMaxKey  
  lGCL   =   ImmGetConversionList(imeHandle(mlMSPYIndex),   0,   sChar,   ByVal   sBuffer,   lGCL,   GCL_REVERSECONVERSION)  
  If   lGCL   >   0   Then  
  Dim   bPY()   As   Byte  
  Dim   j   As   Long  
   
  bBuffer   =   StrConv(sBuffer,   vbFromUnicode)  
   
  ReDim   bPY(MaxKey   *   2   -   1)  
  For   j   =   bBuffer(24)   To   bBuffer(24)   +   MaxKey   *   2   -   1  
  bPY(j   -   bBuffer(24))   =   bBuffer(j)  
  Next   j  
  sChar   =   StrConv(bPY,   vbUnicode)  
   
  If   InStr(sChar,   vbNullChar)   Then  
  sChar   =   Trim(Left(sChar,   InStr(sChar,   vbNullChar)   -   1))  
  End   If  
  sChar   =   GetPYChar(Left(sChar,   1))  
   
  End   If  
  End   If  
  End   If  
  End   If  
   
   
  MSPYReverse   =   MSPYReverse   &   sChar  
  Next   i  
  End   If  
  Else  
   
  MSPYReverse   =   GetPYStr(sString)  
  End   If  
  End   Function  
   
  Private   Sub   Class_Initialize()  
  Init  
  End   Sub  
   
  Private   Function   GetPYChar(a1   As   String)   As   String  
  Dim   t1   As   String  
  If   Asc(a1)   <   0   Then  
  t1   =   Left(a1,   1)  
  If   Asc(t1)   <   Asc("啊")   Then  
  GetPYChar   =   "   "  
  Exit   Function  
  End   If  
  If   Asc(t1)   >=   Asc("啊")   And   Asc(t1)   <   Asc("芭")   Then  
  GetPYChar   =   "A"  
  Exit   Function  
  End   If  
  If   Asc(t1)   >=   Asc("芭")   And   Asc(t1)   <   Asc("擦")   Then  
  GetPYChar   =   "B"  
  Exit   Function  
  End   If  
  If   Asc(t1)   >=   Asc("擦")   And   Asc(t1)   <   Asc("搭")   Then  
  GetPYChar   =   "C"  
  Exit   Function  
  End   If  
  If   Asc(t1)   >=   Asc("搭")   And   Asc(t1)   <   Asc("蛾")   Then  
  GetPYChar   =   "D"  
  Exit   Function  
  End   If  
  If   Asc(t1)   >=   Asc("蛾")   And   Asc(t1)   <   Asc("发")   Then  
  GetPYChar   =   "E"  
  Exit   Function  
  End   If  
  If   Asc(t1)   >=   Asc("发")   And   Asc(t1)   <   Asc("噶")   Then  
  GetPYChar   =   "F"  
  Exit   Function  
  End   If  
  If   Asc(t1)   >=   Asc("噶")   And   Asc(t1)   <   Asc("哈")   Then  
  GetPYChar   =   "G"  
  Exit   Function  
  End   If  
  If   Asc(t1)   >=   Asc("哈")   And   Asc(t1)   <   Asc("击")   Then  
  GetPYChar   =   "H"  
  Exit   Function  
  End   If  
  If   Asc(t1)   >=   Asc("击")   And   Asc(t1)   <   Asc("喀")   Then  
  GetPYChar   =   "J"  
  Exit   Function  
  End   If  
  If   Asc(t1)   >=   Asc("喀")   And   Asc(t1)   <   Asc("垃")   Then  
  GetPYChar   =   "K"  
  Exit   Function  
  End   If  
  If   Asc(t1)   >=   Asc("垃")   And   Asc(t1)   <   Asc("妈")   Then  
  GetPYChar   =   "L"  
  Exit   Function  
  End   If  
  If   Asc(t1)   >=   Asc("妈")   And   Asc(t1)   <   Asc("拿")   Then  
  GetPYChar   =   "M"  
  Exit   Function  
  End   If  
  If   Asc(t1)   >=   Asc("拿")   And   Asc(t1)   <   Asc("哦")   Then  
  GetPYChar   =   "N"  
  Exit   Function  
  End   If  
  If   Asc(t1)   >=   Asc("哦")   And   Asc(t1)   <   Asc("啪")   Then  
  GetPYChar   =   "O"  
  Exit   Function  
  End   If  
  If   Asc(t1)   >=   Asc("啪")   And   Asc(t1)   <   Asc("期")   Then  
  GetPYChar   =   "P"  
  Exit   Function  
  End   If  
  If   Asc(t1)   >=   Asc("期")   And   Asc(t1)   <   Asc("然")   Then  
  GetPYChar   =   "Q"  
  Exit   Function  
  End   If  
  If   Asc(t1)   >=   Asc("然")   And   Asc(t1)   <   Asc("撒")   Then  
  GetPYChar   =   "R"  
  Exit   Function  
  End   If  
  If   Asc(t1)   >=   Asc("撒")   And   Asc(t1)   <   Asc("塌")   Then  
  GetPYChar   =   "S"  
  Exit   Function  
  End   If  
  If   Asc(t1)   >=   Asc("塌")   And   Asc(t1)   <   Asc("挖")   Then  
  GetPYChar   =   "T"  
  Exit   Function  
  End   If  
  If   Asc(t1)   >=   Asc("挖")   And   Asc(t1)   <   Asc("昔")   Then  
  GetPYChar   =   "W"  
  Exit   Function  
  End   If  
  If   Asc(t1)   >=   Asc("昔")   And   Asc(t1)   <   Asc("压")   Then  
  GetPYChar   =   "X"  
  Exit   Function  
  End   If  
  If   Asc(t1)   >=   Asc("压")   And   Asc(t1)   <   Asc("匝")   Then  
  GetPYChar   =   "Y"  
  Exit   Function  
  End   If  
  If   Asc(t1)   >=   Asc("匝")   Then  
  GetPYChar   =   "Z"  
  Exit   Function  
  End   If  
  Else  
  If   UCase(a1)   <=   "Z"   And   UCase(a1)   >=   "A"   Then  
  GetPYChar   =   UCase(Left(a1,   1))  
  Else  
  GetPYChar   =   "   "  
  End   If  
  End   If  
  End   Function  
   
  Private   Function   GetPYStr(ByVal   S   As   String)   As   String  
  Dim   l   As   Long  
  Dim   sOut   As   String  
   
  If   S   <>   ""   Then  
  For   l   =   1   To   Len(S)  
  sOut   =   sOut   &   GetPYChar(Mid(S,   1,   1))  
  Next   l  
  GetPYStr   =   sOut  
  End   If  
  End   Function  
   
  问题点数：80、回复次数：4Top

1 楼zyl910（编程的乐趣在于编程控制硬件，与用图形学实现绚丽效果）回复于 2002-11-10 07:54:11 得分 70

Dim   TempBytes()   as   Byte  
  Dim   t   as   String  
   
  t=Left("Ａ沉沉听",1)  
  if   asc(t)<0   Or   asc(t)>255   then   '判断是否是双字节字符  
          TempBytes=StrConv(Left("Ａ沉沉听",1),   vbFromUniCode)  
          if   TempBytes(0)-160=3   then   '全角英文字符的区码为3  
                  首字母=UCase(Chr(TempBytes(1)-160+32))  
          Else  
                  '按照你以前的方法处理其他字符  
          end   if  
  end   ifTop

2 楼GLAY（藏镜人）回复于 2002-11-10 07:55:15 得分 10

Mid   函数  
  返回   Variant   (String)，其中包含字符串中指定数量的字符。  
   
  语法  
   
  Mid(string,   start[,   length])  
   
  Mid   函数的语法具有下面的命名参数：  
   
  部分 说明  
  string 必要参数。字符串表达式，从中返回字符。如果   string   包含   Null，将返回   Null。  
  start 必要参数。为   Long。string   中被取出部分的字符位置。如果   start   超过   string   的字符数，Mid   返回零长度字符串   ("")。  
  length 可选参数；为   Variant   (Long)。要返回的字符数。如果省略或   length   超过文本的字符数（包括   start   处的字符），将返回字符串中从   start   到尾端的所有字符。  
  说明  
   
  欲知   string   的字符数，可用   Len   函数。  
   
  注意       MidB   函数作用于字符串中包含的字节数据。因此其参数指定的是字节数，而不是字符数。  
   
  本示例使用   Mid   语句来得到某个字符串中的几个字符。  
   
  Dim   MyString,   FirstWord,   LastWord,   MidWords  
  MyString   =   "Mid   Function   Demo" 建立一个字符串。  
  FirstWord   =   Mid(MyString,   1,   3) '   返回   "Mid"。  
  LastWord   =   Mid(MyString,   14,   4) '   返回   "Demo"。  
  MidWords   =   Mid(MyString,   5) '   返回   "Funcion   Demo"。Top

3 楼yjgj7512（龙虎）回复于 2002-11-10 09:59:59 得分 0

谢谢zyl910:有一个问题:只能提取到A,而不是需要的ACCT,还请您帮助!!!谢谢您!!!  
  另:  
  Else  
                  '按照你以前的方法处理其他字符  
          end   if  
  我不知道该如何写???  
   
  Top

4 楼yjgj7512（龙虎）回复于 2002-11-10 13:25:00 得分 0

小妹用了个苯方法:Dim   A   As   RECORD  
  Dim   TempBytes()   As   Byte  
  Dim   t,   H,   K   As   String  
   
  Open   App.Path   &   "\CCC.dat"   For   Binary   Access   Read   As   #1  
  Get   #1,   ,   A  
  Text1.Text   =   StrConv(A.SS,   vbUnicode)  
  t   =   Mid(Text1.Text,   1,   1)  
  K   =   Mid(Text1.Text,   2,   3)  
  If   Asc(t)   <   0   Or   Asc(t)   >   255   Then   '判断是否是双字节字符  
          TempBytes   =   StrConv(Mid(Text1.Text,   1,   1),   vbFromUnicode)  
                     
        Text2.Text   =   UCase(Chr(TempBytes(1)   -   160   +   32))   +   aa.MSPYReverse(K)  
  End   If  
  Close   #1  
  Top

相关问题

• 字符
• 字母
• 函数
• asc
• 提取
• schar
• 字符串
• bpy
• mspyreverse
• strconv

• 帖主：yjgj7512
• zyl910
• GLAY

• Visual Basic类图书
• Visual Basic类源码下载