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 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