⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 modulepublic.bas

📁 个人记事本
💻 BAS
字号:
Attribute VB_Name = "ModulePublic"
Public Version As String    '存储版本号

Public DBCount As Integer   '存储打开的 note 文件数
Public FName As String      '当前打开的 note 文件名

Public frmData As Form
Public n As Integer         'For Search combo static Count
Public Search() As String   'For Search combo static

Public Recent() As String       '历史记录数组
Public RecentCount As Integer   '历史记录条数

'///////////////////////////////////////////////////////////////////////
'///    for 关联 note(*.not) 文件
Option Compare Text '声明字符串比较 "AAA" 等于 "aaa" 则不区分大小写。

Private Declare Function RegCreateKey& Lib "advapi32.DLL" Alias "RegCreateKeyA" (ByVal hKey&, ByVal lpszSubKey$, lphKey&)
Private Declare Function RegSetValue& Lib "advapi32.DLL" Alias "RegSetValueA" (ByVal hKey&, ByVal lpszSubKey$, ByVal fdwType&, ByVal lpszValue$, ByVal dwLength&)

Private Const ERROR_SUCCESS = 0&
Private Const ERROR_BADDB = 1&
Private Const ERROR_BADKEY = 2&
Private Const ERROR_CANTOPEN = 3&
Private Const ERROR_CANTREAD = 4&
Private Const ERROR_CANTWRITE = 5&
Private Const ERROR_OUTOFMEMORY = 6&
Private Const ERROR_INVALID_PARAMETER = 7&
Private Const ERROR_ACCESS_DENIED = 8&
Private Const HKEY_CLASSES_ROOT = &H80000000
Private Const MAX_PATH = 256&
Private Const REG_SZ = 1


Sub Main()
    Version = App.Major & "." & App.Minor & "." & App.Revision
    If Not QueryValue(HKEY_CURRENT_USER, "Software\Note", "first") Then
        '初始注册表项
        CreateNewKey HKEY_CURRENT_USER, "Software\Note"
        SetKeyValue HKEY_CURRENT_USER, "Software\Note", "first", True, REG_SZ
        SetKeyValue HKEY_CURRENT_USER, "Software\Note", "CheckPassWord", 0, REG_SZ
        SetKeyValue HKEY_CURRENT_USER, "Software\Note", "CheckOpenDB", 1, REG_SZ
        SetKeyValue HKEY_CURRENT_USER, "Software\Note", "TacitlyDatabase", App.Path & "\database\Poems.not", REG_SZ
        SetKeyValue HKEY_CURRENT_USER, "Software\Note", "TacitlySaveFolder", App.Path & "\database", REG_SZ
        SetKeyValue HKEY_CURRENT_USER, "Software\Note", "Password", "", REG_SZ
        
        Related_noteFile    '建立 note 文件 与 Note.exe 的关联
    End If
    
    Dim vl As Integer
    vl = QueryValue(HKEY_CURRENT_USER, "Software\Note", "CheckPassWord")
    If vl = 0 Then      '无密码
        Initialize
    Else
        frmPassword.Show
    End If
End Sub

Public Sub Initialize()
    n = 0   '初始 Search combo static
        
    '读取 Recent.ini 文件,初始 Recent() 数组
    Dim strTem As String
    Open App.Path & "\System\Recent.ini" For Input As #1
    Do While Not EOF(1)
        Line Input #1, strTmp
        RecentCount = RecentCount + 1
        ReDim Preserve Recent(RecentCount)
        Recent(RecentCount) = strTmp
    Loop
    Close #1
        
    FName = CStr(Command())
    If FName <> "" Then '点击关联文件使用该软件
        If left(FName, 1) = """" Then
            '有时Command()返回值带引号"",将其去掉
            FName = Mid(FName, 2, Len(FName) - 2)
        End If
        Dim frmD As New frmnote '建立一个窗口 note 的实例
        frmD.Show
        DBCount = DBCount + 1
    Else 'Command() 为空,直接打开该软件
        If QueryValue(HKEY_CURRENT_USER, "Software\Note", "CheckOpenDB") = 1 Then
            Dim frmD2 As New frmnote         '建立一个窗口 note 的实例
            FName = QueryValue(HKEY_CURRENT_USER, "Software\Note", "TacitlyDatabase")
            FName = left(FName, Len(FName) - 1)
            If Not Dir(FName) = "" Then
                frmD2.Show
                DBCount = DBCount + 1
            Else
                MsgBox FName & "不存在", vbInformation + vbOKOnly, "错误信息"
                frmMain.Show
                frmSetParameter.Show
            End If
        Else
            frmMain.Show
        End If
    End If
End Sub

Public Sub Related_noteFile()
'VB编程乐园 提供
'作者:VBEden
'http://www.vbeden.com
'-------------------------------------
'子程序:和你的程序设为关联(*.EDN)文件
'------------------------------------
On Error GoTo RelatedFail
    '声明变量
    Dim sKeyName As String, sKeyValue As String, sKeyValueIcon As String
    Dim Ret As Integer, lphKey As Long

    sKeyName = "NoteFiles"
    sKeyValue = "笔记本"
    Ret = RegCreateKey&(HKEY_CLASSES_ROOT, sKeyName, lphKey)
    Ret = RegSetValue&(lphKey&, "", REG_SZ, sKeyValue, 0&)

    sKeyName = ".not"
    sKeyValue = "NoteFiles"
    Ret = RegCreateKey&(HKEY_CLASSES_ROOT, sKeyName, lphKey)
    Ret = RegSetValue&(lphKey&, "", REG_SZ, sKeyValue, 0&)

    sKeyName = "NoteFiles"
    sKeyValue = """" & App.Path & IIf(Len(App.Path) > 3, "\" & "Note.exe", "Note.exe") & """" & " %1"
    
    '设置图标(Icon)默认第一个Icon
    'sKeyValueIcon = App.Path & IIf(Len(App.Path) > 3, "\" & "Note.exe", "Note.exe")
    '设置图标(Icon)默认第二个Icon
    'sKeyValueIcon = App.Path & IIf(Len(App.Path) > 3, "\" & "Note.exe", "Note.exe") & ",1"
    sKeyValueIcon = App.Path & IIf(Len(App.Path) > 3, "\" & "System\note.ico", "System\note.ico")

    Ret = RegCreateKey&(HKEY_CLASSES_ROOT, sKeyName, lphKey)
    Ret = RegSetValue&(lphKey&, "DefaultIcon", REG_SZ, sKeyValueIcon, MAX_PATH)
    Ret = RegSetValue&(lphKey&, "Shell\Open\Command", REG_SZ, sKeyValue, MAX_PATH)

    'MsgBox "设置关联文件(*.EDN)成功!,你请试试打开EDN文件", vbInformation
Exit Sub
RelatedFail:
    MsgBox err.Description, vbCritical: End
End Sub


'////////////////////////////////////////////////////
'////       fir skin
Public Sub Skin(f As Form, cN As cNeoCaption)
'    cN.ActiveCaptionColor = &HFFFFFF
 '   cN.InActiveCaptionColor = &HC0C0C0
  '  cN.ActiveMenuColor = &H0&
   ' cN.ActiveMenuColorOver = &H0
    'cN.InActiveMenuColor = &H0&
'    cN.MenuBackgroundColor = RGB(207, 203, 207)
'    cN.CaptionFont.Name = "宋体"
 '   cN.CaptionFont.Size = 9
  '  cN.MenuFont.Name = "宋体"
   ' cN.MenuFont.Size = 9
    cN.Attach f, f.PicCaption.Picture, f.PicBorder.Picture, 19, 20, 90, 140, 240, 400
    'f.BackColor = RGB(207, 203, 207)
End Sub

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -