86 lines
2.1 KiB
OpenEdge ABL
86 lines
2.1 KiB
OpenEdge ABL
VERSION 1.0 CLASS
|
|
BEGIN
|
|
MultiUse = -1 'True
|
|
END
|
|
Attribute VB_Name = "API_Ribbon"
|
|
Attribute VB_GlobalNameSpace = False
|
|
Attribute VB_Creatable = False
|
|
Attribute VB_PredeclaredId = False
|
|
Attribute VB_Exposed = False
|
|
'==== Îáîëî÷êà äëÿ õðàíåíèÿ è çàãðóçêè èäåíòèôèêàòîðà ëåíòû (Ribbon) =========================
|
|
' Shared module version: 20210217
|
|
' Required reference: Microsoft Scripting Runtime
|
|
Option Explicit
|
|
|
|
Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (dest As Any, src As Any, ByVal nLen As Long)
|
|
|
|
Private ribbon_ As IRibbonUI
|
|
Private backup_ As String
|
|
|
|
Private Sub Class_Terminate()
|
|
If Not ribbon_ Is Nothing Then _
|
|
Call KillBackup
|
|
End Sub
|
|
|
|
Public Function Init(target As IRibbonUI, sBackup$)
|
|
Set ribbon_ = target
|
|
backup_ = sBackup
|
|
Call SaveBackup
|
|
End Function
|
|
|
|
Public Property Get Value() As IRibbonUI
|
|
Set Value = ribbon_
|
|
End Property
|
|
|
|
Public Function LoadFrom(sFilePath$) As IRibbonUI
|
|
Set ribbon_ = Nothing
|
|
backup_ = sFilePath
|
|
|
|
Call LoadBackup
|
|
|
|
Set LoadFrom = ribbon_
|
|
End Function
|
|
|
|
' =======
|
|
Private Function SaveBackup()
|
|
Dim ribbonPtr As LongPtr: ribbonPtr = ObjPtr(ribbon_)
|
|
Dim fso As New Scripting.FileSystemObject
|
|
Dim textOut As Scripting.TextStream: Set textOut = fso.CreateTextFile(backup_, Overwrite:=True)
|
|
If Not textOut Is Nothing Then
|
|
Call textOut.WriteLine(ribbonPtr)
|
|
Call textOut.Close
|
|
End If
|
|
End Function
|
|
|
|
Private Function LoadBackup()
|
|
Dim fso As New Scripting.FileSystemObject
|
|
If Not fso.FileExists(backup_) Then _
|
|
Exit Function
|
|
|
|
Dim textIn As Scripting.TextStream: Set textIn = fso.OpenTextFile(backup_)
|
|
If textIn Is Nothing Then _
|
|
Exit Function
|
|
|
|
Dim ptrSize&
|
|
#If Win64 Then
|
|
ptrSize = 8
|
|
#Else
|
|
ptrSize = 4
|
|
#End If
|
|
|
|
Dim aLine$: aLine = textIn.ReadLine
|
|
If IsNumeric(aLine) Then
|
|
Dim nPtr As LongPtr: nPtr = CLngPtr(aLine)
|
|
Dim objRibbon As Object
|
|
Call CopyMemory(objRibbon, nPtr, ptrSize)
|
|
Set ribbon_ = objRibbon
|
|
Call CopyMemory(objRibbon, 0&, ptrSize)
|
|
End If
|
|
End Function
|
|
|
|
Private Function KillBackup()
|
|
Dim fso As New Scripting.FileSystemObject
|
|
If fso.FileExists(backup_) Then _
|
|
Call fso.DeleteFile(backup_)
|
|
End Function
|