module1.bas

次程序基本实现微软的记事本功能

Attribute VB_Name = "Module1"
Option Explicit
Const WM_USER = &H400
Const EM_SETTARGETDEVICE = (WM_USER + 72)
Type POINTAPI
    x As Long
    y As Long
End Type
Type RECT
    left As Long
    right As Long
    top As Long
    bottom As Long
End Type
Public Type PageSetupDlg
        lStructSize As Long
        hwndOwner As Long
        hDevMode As Long
        hDevNames As Long
        flags As Long
        ptPaperSize As POINTAPI
        rtMinMargin As RECT
        rtMargin As RECT
        hInstance As Long
        lCustData As Long
        lpfnPageSetupHook As Long
        lpfnPagePaintHook As Long
        lpPageSetupTemplateName As String
        hPageSetupTemplate As Long
End Type
Public psdlg As PageSetupDlg
Declare Function PageSetupDlg Lib "comdlg32.dll" Alias "PageSetupDlgA" (pPagesetupdlg As PageSetupDlg) As Long
Public Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long

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

Dim bWrap As Boolean '// 换行标记'// 自定义一个换行的过程
Public Sub WrapTextLine(ByRef RichText As RichTextBox, ByVal bWrapSwitch As Boolean)
On Error Resume Next
    If Not bWrapSwitch Then '// 设置 RichTextBox 自动换行
         SendMessage RichText.hwnd, EM_SETTARGETDEVICE, GetDC(RichText.hwnd), RichText.Width / 15
         RichText.RightMargin = IIf(RichText.RightMargin = 0, 1, 0)
    Else
         '// 设置 RichTextBox 不自动换行
         SendMessage RichText.hwnd, EM_SETTARGETDEVICE, 0, 1
        End If
  End Sub
  Function GetFileTitle(OldStr As String) As String
    On Error Resume Next
    Dim n As Integer, m As Integer '声明字符串变量
    Dim i As String, r As String
    Dim p As Integer
    i = "\" '要查找的指定字符
    For n = 1 To Len(OldStr) '用Len函数计算已知字符串的字节数
    m = InStrRev(OldStr, i, -1) '"\"所在的位置(其中的-1是默认的)
    Next n '找下去！

    '截取最后一个"\"后面的字符串
    r = right(OldStr, Len(OldStr) - m) '获取Title
    p = InStrRev(r, ".", -1) '"."所在位置
    GetFileTitle = left(r, p - 1) '去掉后缀
End Function