回 帖 发 新 帖 刷新版面

主题:[原创]编写超级记事本必需的十六个功能源代码(二)

五、港台大五码与国标简、繁体三者相互转换

  在网上看到有人一直在为这三者的相互转换大伤脑筋,还有许多网站也在为网友们提供这个服务。
其实,这是一件很简单的事,下面我就为大家介绍转换代码,如果你能应用到你自编的记事本中去,岂
不美哉!
  请新建一个工程,添加一个文本框(Multiline属性设为True),四个命令按纽,然后复制粘贴下面
的代码。

Option Explicit

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

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

'以下四个函数的输入参数均为:欲转换编码的文本
Function GbComplexToGbSketch(TextST As String) As String '国标繁体转国标简体
Dim TextLength As Long'文本长度
Dim ST As String
TextLength = lstrlen(TextST): ST = Space(TextLength)
LCMapString &H804, &H2000000, TextST, TextLength, ST, TextLength
GbComplexToGbSketch = ST
End Function

Function GbSketchToGbComplex(TextST As String) As String '国标简体转国标繁体
Dim TextLength As Long'文本长度
Dim ST As String
TextLength = lstrlen(TextST): ST = Space(TextLength)
LCMapString &H804, &H4000000, TextST, TextLength, ST, TextLength
GbSketchToGbComplex = ST
End Function

Function GbToBig5(TextST As String) As String '国标繁体转港台繁体
Dim ST As String
ST = StrConv(TextST, vbFromUnicode)
ST = StrConv(ST, vbUnicode, &H804)
ST = StrConv(ST, vbFromUnicode, &H404)
GbToBig5 = StrConv(ST, vbUnicode)
End Function

Function Big5ToGb(TextST As String) As String '港台繁体转国标繁体
Dim ST As String
ST = StrConv(TextST, vbFromUnicode)
ST = StrConv(ST, vbUnicode, &H404)
ST = StrConv(ST, vbFromUnicode, &H804)
Big5ToGb = StrConv(ST, vbUnicode)
End Function


六、插入特殊字符

  如果你写文章时,要输入一些特殊字符,如“≌”、“≠”、“╬”等等,是不是要费些周折?你
一定会想,如果只要在一个特殊字符表中点击选中的字符,该字符就出现在文本框的光标处,那该多方
便!没问题!
  请在工程中增加一个新窗体Form2(假设文本框所在的主窗体为Form1),并为Form2添加如下菜
单:
 -----------------------------------------------
 标题     名称     Index  说明
 -----------------------------------------------
 特殊字符   SpecialChar     一级菜单
 ....序数数字 character   1     以下均为二级菜单
 ....中文标点 character   2     
 ....数理符号 character  3  
 ....全角字符 character  4
 ....制表符号  character   5
 ....希 腊 文 character   6
 ....俄罗斯文 character   7
 ....日本假名 character   8
 ....汉语注音 character  9
 -----------------------------------------------

  在 Form1 增加一个“特殊字符”菜单项(标题与名称相同),并在 Form1 的代码窗口
输入代码:

Private Sub 特殊字符_Click()
Form2.Show
End Sub

  在 Form2 的代码窗口输入如下代码:

Option Explicit

Dim ChrNumber As Integer '某类型特殊字符的数量
Dim DAT() As Integer '字符的 Ascii 码

Private Sub SpecialChar_Click(Index As Integer)
Dim L As Long '窗体高度系数
Dim i Integer
Dim X1 As Integer, Y1 As Integer '字符打印坐标
Select Case Index
  Case 1
    Caption = "序数数字":  ChrNumber = 91: L = 15: ReDim DAT(ChrNumber)
    For i = 0 To ChrNumber: DAT(i) = -23903 + i: Next
  Case 2
    Caption = "中文标点": ChrNumber = 79: L = 13: ReDim DAT(ChrNumber)
    For i = 0 To 29: DAT(i) = -24158 + i: Next
    For i = 30 To 51: DAT(i) = -22846 + i: Next
    For i = 52 To 79: DAT(i) = -22228 + i: Next
  Case 3
    Caption = "数理符号": ChrNumber = 121: L = 19: ReDim DAT(ChrNumber)
    For i = 0 To 62: DAT(i) = -24128 + i: Next
    For i = 63 To 81: DAT(i) = -22527 + i: Next
    For i = 82 To 94: DAT(i) = -22230 + i: Next
    For i = 95 To 121: DAT(i) = -22303 + i: Next
  Case 4
    Caption = "全角字符": ChrNumber = 92: L = 15: ReDim DAT(ChrNumber)
    For i = 0 To ChrNumber: DAT(i) = -23647 + i: Next
  Case 5
    Caption = "制表符号": ChrNumber = 161: L = 23: ReDim DAT(ChrNumber)
    For i = 0 To 66: DAT(i) = -22445 + i: Next
    For i = 67 To 80: DAT(i) = -22202 + i: Next
    For i = 81 To 161: DAT(i) = -22189 + i: Next
  Case 6
    Caption = "希 腊 文": ChrNumber = 47: L = 9: ReDim DAT(ChrNumber)
    For i = 0 To 23: DAT(i) = -22879 + i: Next
    For i = 24 To 47: DAT(i) = -22871 + i: Next
  Case 7
    Caption = "俄罗斯文": ChrNumber = 65: L = 11: ReDim DAT(ChrNumber)
    For i = 0 To 32: DAT(i) = -22623 + i: Next
    For i = 33 To 65: DAT(i) = -22608 + i: Next
  Case 8
    Caption = "日本假名": ChrNumber = 168: L = 25: ReDim DAT(ChrNumber)
    For i = 0 To 82: DAT(i) = -23391 + i: Next
    For i = 83 To 168: DAT(i) = -23218 + i: Next
  Case 9
    Caption = "汉语注音": ChrNumber = 72: L = 11: ReDim DAT(ChrNumber)
    For i = 0 To ChrNumber: DAT(i) = -22367 + i: Next
End Select
Me.Height = 600 + 180 * L
Cls
X1 = 90: Y1 = 90
For i = 0 To ChrNumber
  Me.CurrentX = X1: Me.CurrentY = Y1: Print Chr(DAT(i))
  X1 = X1 + 360: If X1 > 5130 Then X1 = 90: Y1 = Y1 + 360
Next
Form1.Text1.SetFocus '焦点转移到Form1上的主文本框
End Sub

Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim ChrPlace As integer '选中的字符在 DAT 数组中的位置
ChrPlace = X \ 360 + (Y \ 360) * 15
If ChrPlace <= ChrNumber Then
  Form1.Text1.SetFocus '焦点转移到Form1上的主文本框
  SendKeys Chr(DAT(ChrPlace))
  Clipboard.Clear
  Clipboard.SetText Chr(DAT(ChrPlace)) '将该字符添加到系统剪贴板,以便粘贴到别的文本框
End If
End Sub

简要分析:
  SpecialChar_Click 事件过程设置 Form2 的大小, 并把汉字库中的特殊字符按规定的格式打印到
窗体。
  首先要计算窗体大小:窗体高度系数 L 之值是怎么得来的呢?以“序数数字”为例: 当在窗体上
打印字符时,每行规定打印 15 个,那么 91 个字符需要 7 行, 每行字符之间还要空一行(看上去才
不显拥挤),加上首尾各一个空行,共有 8 个空行,这样总数就是 15行了。另外,在 VB6 中,5号常
规中文字符的高度是 180缇,所需窗体高度是 180×L,另加的 600 是窗体标题栏和菜单栏的高度,这
样, “序数表”所需的窗体总高度就计算出来了。至于窗体宽度,这 9 种字符表均为 5500 缇,这是
因为 5 号常规中文字符的宽度也是 180 缇,而 5 号英文字符宽 90 缇,1 个中文特殊字符加上前后
的英文空格就是 360缇宽,15 个字符就是 5400 缇,再加上 100 缇的宽度余量,就算出了窗体的总宽
度。
  Form_MouseUp 事件过程将用户用鼠标选中的字符输出到文本框。
  X \ 360 和 Y \ 360 整除运算求出当前光标位于第几行第几列的字符区域。 以字符宽度为例:一
个特殊字符所占用的宽度是 360,假如 X\360=0~359,那么说明鼠标位于该行第 1 个字符的区域;
假如 X\360=360~719, 则说明鼠标位于该行第 2个字符的区域……由此类推。同理,一个特殊字符
所占用高度也是 360,假如 Y\360=0~359,说明鼠标位于第 1 行字符的区域;假如 Y\360=360~
719,说明鼠标位于第 2 行字符的区域,由此类推。
  变量 ChrPlace 计算出鼠标选定的特殊字符在 DAT 数组中的位置。
  如果条件都满足,就把焦点转移到 Form1 的文本框,再发送与 ChrPlace 对应的字符,所选定的
特殊字符就出现在文本框的光标处了。


七、背景音乐

  你想不想在自编的程序中使用背景音乐,听一听“两只蝴蝶”是如何缠缠绵绵翩翩飞的?如果想听,
请使用 API 函数 mciSendString 来播放,简单而方便。
  mciSendString 函数可以播放 MP3、WAV、MID 音乐文件及 CD 碟片,它有 4个参数,在播放音乐
时只需第一个参数就可以了,该参数是一个字符串,其内容主要包括 5项,各项之间以空格分隔:
 1.操作命令。例如打开文件 Open,关闭文件 Close,等等
 2.全路径音乐文件名。
 3.播放类型。如果是 MP3,就可以省略
 4.别名。这是由用户自己指定的一个名称,以代表第 2、3 项内容,这样在后续的操作中,在操作命
令后面使用别名就可以了,否则你在所有的操作命令后面都得写上第 2、3 项。别名一般在 Open 命令
时设定。
 5.附加命令。如 FROM 0 表示从 0 毫秒处开始播放

  在窗体上添加一个计时器,用菜单编辑器添加两个菜单项,设置属性为:

  计时器:Enabled=False,Interval=10
  菜单项1:名称=MusicPlay,标题=播放
  菜单项2:名称=MusicStop,标题=停止

  代码如下:

Option Explicit

Private Declare Function mciSendString Lib "winmm.dll" Alias _
"mciSendStringA" (ByVal lpstrCommand As String, ByVal _
lpstrReturnString As String, ByVal uReturnLength As Long, _
ByVal hwndCallback As Long) As Long

Private Sub MusicPlay_Click()
On Error GoTo 100
Dim ListName As String, MusicName As String, ST As String, Lx1 As Integer

 '从注册表中读出 Lx1 的值
GetSetting 超级记事本, 背景音乐, 位置, Lx1 

If Lx1 = 0 Then Lx1 = 1
ListName = "(你把播放列表文件放在哪里?在这输入全路径文件名)"
Open ListName For Input As #1 '打开播放列表文件
Seek #1, Lx1 '设置读文件的起始字节
Line Input #1, MusicName '读出一个音乐文件名
Lx1 = Seek(1) '获取下一个文件的起始字节
If Lx1 >= LOF(1) - 2 Then Lx1 = 1 
Close

 '将 Lx1 的新值写入注册表
SaveSetting 超级记事本, 背景音乐, 位置, Lx1

If Not Timer1.Enabled Then Timer1.Enabled = True
If Dir(MusicName) <> "" Then '如果盘上有这个音乐文件
  ST = UCase(Right(MusicName, 3))
  If ST = "MP3" Then '如果是 MP3
    mciSendString "open " & MusicName & " alias music", 0&, 0, 0
  ElseIf ST = "WAV" Then '如果是 WAV
    mciSendString "open " & MusicName & " type waveaudio alias music", 0&, 0, 0

  Else '如果是 MID
    mciSendString "open " & MusicName & " type sequencer alias music", 0&, 0, 0
  End If
  mciSendString "play music FROM 0", 0&, 0, 0
Else: Timer1.Enabled = False
End If
100
Close
End Sub

Private Sub Timer1_Timer()
Dim ST As String
ST = String(14, Chr(0))
mciSendString "status music mode", ST, Len(ST), 0
If Left(ST, 7) = "stopped" Then MusicPlayer_Click
End Sub

Private Sub MusicStop_Click()
Timer1.Enabled = False
mciSendString "close music", 0&, 0, 0
End Sub


说明:

1.音乐文件的路径和文件名不能有空格。
2.Timer1_Timer 过程的作用是探测当前的音乐文件是否播放完毕,如果播放完了,就接着播放下一个
音乐文件。当音乐播放完毕时,mciSendString 函数会返回一个字符串,其中前 7个字符是 stopped。
3.播放列表文件是一个.txt文本文件,你可以用记事本来编辑它,注意 2点:
 ①列表中的每个音乐文件名作为一行,不能有空行。
 ②列表中的音乐文件名必须是全路径文件名,不能有空格
4.在一般情况下,要将播放列表文件中所有的音乐文件名都读入相应的字符串数组变量,这样会占用
很多内存资源。本代码中使用了指针技术(变量 Lx1 就是指针),每次只要读入一个音乐文件名就可以
了,这样你就可以把所有可播放的音乐文件名都编辑到列表中去。

回复列表 (共2个回复)

沙发

八、字数统计

   有时候,你需要准确统计某段文章中,英文和汉字的字数以及主要中文标点符号的数量(不统计回
车换行符),并显示统计结果,下面的代码能方便地实现这个愿望。代码中将全角英文字符、次要中文
标点、中文空格、汉字库中的制表符和日、俄、希腊文字母等等,均统计为“其它中标”,半角英文字
符不区分字母、数字或符号,一律统计为“英文字符”。

'输入参数:欲统计字数的文本
Sub WordSummation(ByVal TextST As String)
On Error GoTo Error6
Dim DAT() As Byte '字符串的 Unicode 编码
Dim TNum(9) As Long '记录数目
Dim i As Long, ST As String
Dim ZST(10) As String

If Len(TextST) < 2 Then Exit Sub
TextST = StrConv(TextST, vbFromUnicode): DAT = TextST 

For i = 0 To UBound(DAT)
  If DAT(i) > &H7F Then
    If DAT(i) > &HA0 And DAT(i + 1) > &H3F And DAT(i) < &HAA And DAT(i + 1) < &HFF Then
      If DAT(i) = &HA1 And DAT(i + 1) = &HA3 Then '如果是中文句号
        TNum(1) = TNum(1) + 1 
      ElseIf DAT(i) = &HA3 And DAT(i + 1) = &HAC Then '如果是中文逗号
        TNum(2) = TNum(2) + 1 
      ElseIf DAT(i) = &HA3 And DAT(i + 1) = &HBA Then '如果是中文冒号
        TNum(3) = TNum(3) + 1
      ElseIf DAT(i) = &HA3 And DAT(i + 1) = &HBF Then '如果是中文问号
        TNum(5) = TNum(5) + 1
      ElseIf DAT(i) = &HA3 And DAT(i + 1) = &HA1 Then '如果是中文叹号
        TNum(6) = TNum(6) + 1
      ElseIf DAT(i) = &HA1 And (DAT(i + 1) = &HB0 Or DAT(i + 1) = &HB1) Then '如果是中文引号
        TNum(4) = TNum(4) + 1
      End If
      TNum(7) = TNum(7) + 1 '中文标点总数
    Else
      TNum(0) = TNum(0) + 1 '汉字总数
    End If
    i = i + 1
  Else
    If DAT(i) > 31 Then TNum(8) = TNum(8) + 1 '英文字母总数
  End If
Next

TNum(9) = TNum(0) + TNum(7) + TNum(8) '总字数=汉字总数+中文标点总数+英文字母总数
TNum(7) = TNum(7) - TNum(1) - TNum(2) - TNum(3) - TNum(4) - TNum(5) - TNum(6) '其它中文标点
ZST(0) = "中文汉字": ZST(1) = "中文句号": ZST(2) = "中文逗号"
ZST(3) = "中文冒号": ZST(4) = "中文双引": ZST(5) = "中文问号"
ZST(6) = "中文叹号": ZST(7) = "其它中标": ZST(8) = "英文字符"
ZST(9) = "共计字数": ZST(10) = "字块大小"
For i = 0 To 9: ST = ST & ZST(i) & Left$(Str(TNum(i)) & Space(6), 7) & vbCrLf: Next
ST = ST & ZST(10) & Format(lstrlen(TextST) / 1024, " ###0.0") & "KB"
mBox ST, , "字数统计报告"

Error6:
End Sub

板凳

支持

我来回复

您尚未登录,请登录后再回复。点此登录或注册