'#Language "WWB-COM" ' Large PNG image exporter ' (c) Harport Consulting 2022 ' Supplied as-is with no warranty Option Explicit Const T_AppName = "Large PNG Exporter" Const I__CancelErr = 10031 ' cancel error code Const N_DefaultPixels = 10000 Const N_MaxPixels = 27000 Const T_btnOK = "OK" Const T_btnCancel = "Cancel" Sub Main If ActiveDocument Is Nothing Then End On Error GoTo HandleFatal Begin Dialog UserDialog 340,126,T_AppName,.dlfExport ' %GRID:10,7,1,1 Text 20,7,320,14,"lblTopics",.lblTopics TextBox 210,56,100,14,.txtMaxHeight Text 20,28,180,14,"Image width (pixels)",.lblMaxWidth TextBox 210,28,100,14,.txtMaxWidth Text 20,56,180,14,"Image height (pixels)",.lblMaxHeight OKButton 50,91,110,21 CancelButton 180,91,110,21 End Dialog Dim dlgExport As UserDialog Dialog dlgExport End HandleFatal: If Err.Number = I__CancelErr Then Err.Clear Else MsgBox("Error " & CStr(Err.Number) & vbCrLf & Err.Description, vbCritical + vbOkOnly) End End If End Sub Function dlfExport(s_Item As String, i_Action As Integer, ByVal k_SuppValue?) As Boolean Dim m_Topic As Topic Dim i_Topics As Integer Dim s_1 As String Dim i_MaxWidth As Long Dim i_MaxHeight As Long dlfExport = True ' keep open or continue to receive actions by default Select Case i_Action Case 1 ' Dialog box initialization i_Topics = 0 With ActiveDocument For Each m_Topic In .Range(mmRangeAllTopics, False) .GraphicExport.AddTopic(m_Topic) i_Topics = i_Topics + 1 Next End With DlgText("lblTopics", CStr(i_Topics) & " Topics") DlgText("txtMaxWidth", CStr(N_DefaultPixels)) DlgText("txtMaxHeight", CStr(N_DefaultPixels)) dlfExport = False Case 2 ' Value changing or button pressed Select Case s_Item Case T_btnOK i_MaxWidth = 0 s_1 = Trim(DlgText("txtMaxWidth")) If IsNumeric(s_1) Then i_MaxWidth = CLng(s_1) s_1 = Trim(DlgText("txtMaxHeight")) i_MaxHeight = 0 If IsNumeric(s_1) Then i_MaxHeight = CLng(s_1) If (i_MaxWidth > 0) And (i_MaxWidth <= N_MaxPixels) Then If (i_MaxHeight > 0) And (i_MaxHeight <= N_MaxPixels) Then DlgEnable(T_btnOK, False) DlgEnable(T_btnCancel, False) GraphicExport(i_MaxWidth, i_MaxHeight) dlfExport = False ' close End If End If Case T_btnCancel dlfExport = False ' close End Select Case 3 ' TextBox or ComboBox text changed Case 4 ' Focus changed Case 5 dlfExport = False ' no more idle events Case 6 ' Function key End Select End Function Sub GraphicExport(ByVal i_MaxWidth As Long, ByVal i_MaxHeight As Long) Dim s_Status As String Dim s_File As String With ActiveDocument s_Status = "Map must be saved to disk" If .FullName <> .Name Then s_Status = "Map must be saved first" If Not .IsModified Then s_File = Trim(.FullName) s_File = Left(s_File, Len(s_File) - Len(".mmap")) & " v" & CStr(.Properties.Version) & ".png" .GraphicExport.ExportSized(s_File, mmGraphicTypePng, i_MaxWidth, i_MaxHeight) s_Status = "Exported at " & CStr(i_MaxWidth) & "W / " & CStr(i_MaxHeight) & "H" & vbCrLf & vbCrLf & s_File End If End If MsgBox(s_Status, vbInformation, T_AppName) End With End Sub