122 lines
3.7 KiB
OpenEdge ABL
122 lines
3.7 KiB
OpenEdge ABL
VERSION 1.0 CLASS
|
|
BEGIN
|
|
MultiUse = -1 'True
|
|
END
|
|
Attribute VB_Name = "API_UserInteraction"
|
|
Attribute VB_GlobalNameSpace = False
|
|
Attribute VB_Creatable = False
|
|
Attribute VB_PredeclaredId = False
|
|
Attribute VB_Exposed = False
|
|
'================ Êëàññ èíêàïñóëÿöèè âçàèìîäåéñòâèÿ ñ ïîëüçîâàòåëåì =========================
|
|
' Shared module version: 20220611
|
|
' Depends on:
|
|
' Required reference:
|
|
Option Explicit
|
|
|
|
Public Function ShowMessage(nMsg&, ParamArray params() As Variant)
|
|
Call UIShowMessage(nMsg, params)
|
|
End Function
|
|
|
|
Public Function AskQuestion(nQuestion&, ParamArray params() As Variant) As Boolean
|
|
AskQuestion = UIAskQuestion(nQuestion, params)
|
|
End Function
|
|
|
|
Public Function FollowHyperlink(oDocument As Object, sAddress$)
|
|
Call oDocument.FollowHyperlink(sAddress)
|
|
End Function
|
|
|
|
Public Function PromptInput(sPrompt$, Optional sTitle$ = vbNullString, Optional sInitial As Variant) As String
|
|
PromptInput = VBA.InputBox(sPrompt, sTitle, sInitial)
|
|
End Function
|
|
|
|
Public Function PromptFileFilter(sInitialPath$, sDescription$, sFilter$, _
|
|
Optional sTitle$ = "Âûáåðèòå ôàéë", _
|
|
Optional bNewApplication As Boolean = False) As String
|
|
Dim cFilters As New Collection
|
|
Dim cDescriptions As New Collection
|
|
|
|
Call cFilters.Add("*.*")
|
|
Call cDescriptions.Add("Âñå ôàéëû")
|
|
Call cFilters.Add(sFilter)
|
|
Call cDescriptions.Add(sDescription)
|
|
|
|
PromptFileFilter = PromptFile(sInitialPath, sTitle, cDescriptions, cFilters, bNewApplication)
|
|
End Function
|
|
|
|
Public Function PromptFile(sInitialPath$, _
|
|
Optional sTitle$ = "Âûáåðèòå ôàéë", _
|
|
Optional cDescriptions As Collection = Nothing, _
|
|
Optional cFilters As Collection = Nothing, _
|
|
Optional bNewApplication As Boolean = False) As String
|
|
PromptFile = vbNullString
|
|
Dim oApplication As Object
|
|
If Not bNewApplication Then
|
|
Set oApplication = Application
|
|
Else
|
|
Set oApplication = CreateObject("Excel.Application")
|
|
oApplication.Visible = True
|
|
End If
|
|
|
|
Dim filterCount&: filterCount = 0
|
|
If Not cDescriptions Is Nothing And Not cFilters Is Nothing Then _
|
|
If cDescriptions.Count = cFilters.Count Then _
|
|
filterCount = cFilters.Count
|
|
|
|
On Error Resume Next
|
|
|
|
With oApplication.FileDialog(msoFileDialogFilePicker)
|
|
.InitialFileName = sInitialPath
|
|
.AllowMultiSelect = False
|
|
.ButtonName = "Âûáðàòü"
|
|
.Title = sTitle
|
|
|
|
Call .Filters.Clear
|
|
If filterCount > 0 Then
|
|
|
|
Dim nItem&
|
|
For nItem = 1 To filterCount Step 1
|
|
Call .Filters.Add(cDescriptions.Item(nItem), cFilters.Item(nItem), 1)
|
|
Next nItem
|
|
Else
|
|
Call .Filters.Add("Âñå ôàéëû", "*.*")
|
|
End If
|
|
|
|
Call .Show
|
|
If .SelectedItems.Count > 0 Then _
|
|
PromptFile = .SelectedItems(1)
|
|
End With
|
|
|
|
If bNewApplication Then _
|
|
Call oApplication.Quit
|
|
End Function
|
|
|
|
Public Function PromptFolder(sInitialPath$, _
|
|
Optional sTitle$ = "Âûáåðèòå êàòàëîã", _
|
|
Optional bNewApplication As Boolean = False) As String
|
|
PromptFolder = vbNullString
|
|
Dim oApplication As Object
|
|
If Not bNewApplication Then
|
|
Set oApplication = Application
|
|
Else
|
|
Set oApplication = CreateObject("Excel.Application")
|
|
oApplication.Visible = True
|
|
End If
|
|
|
|
On Error Resume Next
|
|
With oApplication.FileDialog(msoFileDialogFolderPicker)
|
|
.InitialFileName = sInitialPath
|
|
.AllowMultiSelect = False
|
|
.ButtonName = "Âûáðàòü"
|
|
.Title = sTitle
|
|
|
|
Call .Show
|
|
|
|
If .SelectedItems.Count > 0 Then _
|
|
PromptFolder = .SelectedItems(1)
|
|
End With
|
|
|
|
If bNewApplication Then _
|
|
Call oApplication.Quit
|
|
End Function
|
|
|