Skip to content

Commit 6894441

Browse files
GCuser99GCuser99
committed
version update
modified GUID generation code in response to tB bug fix refactored image processing code to eliminate unnecessary conversion to png format fixed bug in detecting whether a UserForm control has non-default mouse icon
1 parent b1e7e0f commit 6894441

11 files changed

+61
-200
lines changed

‎README.md‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -38,7 +38,7 @@ The resulting imported form and code may have to be tweaked in **twinBASIC** to
3838

3939
<img src="https://github.com/GCuser99/VBA-UserForm-to-twinBASIC/blob/main/images/addin%20window.png" alt="AddinManagerDialog" width=50% height=50%>
4040

41-
**Add-in Manager**: You can change the load behavoir of the Add-in by clicking Add-insAdd-in Manager
41+
**Add-in Manager**: You can change the load behavoir of the Add-in by clicking Add-ins->Add-in Manager
4242

4343
<img src="https://github.com/GCuser99/VBA-UserForm-to-twinBASIC/blob/main/images/VBIDE%20Menu.png" alt="Menu" width=50% height=50%>
4444

‎dist/tBUserFormConverter_win32.dll‎

-7 KB
Binary file not shown.

‎dist/tBUserFormConverter_win64.dll‎

-10.5 KB
Binary file not shown.

‎dist/tBUserformConverterSetup.exe‎

-2.76 KB
Binary file not shown.

‎src/source/About.twin‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -5,7 +5,7 @@ Class About
55

66
Sub New()
77
lblInfo.Caption = "Author: GCUser99" & vbCrLf & _
8-
"Version: v2.1" & vbCrLf & _
8+
"Version: v2.2" & vbCrLf & _
99
"Description: A VBIDE add-in (complied with twinBASIC) that converts VBA UserForms for use in twinBASIC."
1010
lblWebsite.Caption = "https://github.com/GCuser99/VBA-UserForm-to-twinBASIC"
1111
Set Me.Icon = GetImageFromResources("transparent.ico", "IMAGES")

‎src/source/Converter.twin‎

Lines changed: 8 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -48,14 +48,14 @@ Class Converter
4848
End Sub
4949

5050
Private Sub New()
51-
cmdConvert.Enabled = False
52-
ckbOutputCode.Value = vbChecked
53-
cmdDeselectAll.Enabled = False
54-
ckbUseVisualStyles.Value = vbUnchecked
55-
ckb3DAppearance.Value = vbChecked
56-
optUseVBAFonts.Value = True
57-
ckbHideIconBox.Value = vbChecked
58-
Set Me.Icon = GetImageFromResources("twinBASIC.ico", "IMAGES")
51+
cmdConvert.Enabled = False
52+
ckbOutputCode.Value = vbChecked
53+
cmdDeselectAll.Enabled = False
54+
ckbUseVisualStyles.Value = vbUnchecked
55+
ckb3DAppearance.Value = vbChecked
56+
optUseVBAFonts.Value = True
57+
ckbHideIconBox.Value = vbChecked
58+
Set Me.Icon = GetImageFromResources("twinBASIC.ico", "IMAGES")
5959
End Sub
6060

6161
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)

‎src/source/FormProcessing.twin‎

Lines changed: 41 additions & 31 deletions
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,5 @@
11
' ==========================================================================
2-
' tBUserFormConverter v2.1
2+
' tBUserFormConverter v2.2
33
'
44
' A VBIDE add-in (complied with twinBASIC) that converts VBA UserForms for use in twinBASIC.
55
'
@@ -89,19 +89,24 @@ Module FormProcessing
8989
Dim comdlg As New VBComDlg.CommonDialog
9090
Dim res As Boolean
9191
Dim activeVBProjectFileName As String
92+
Dim activeVBProjectFolderName As String
9293

9394
comdlg.DialogTitle = "Select Output Folder:"
9495

9596
'it's possible that user created a useform in a new unsaved document
9697
'in which case activeVBProject.FileName will fail
9798
On Error Resume Next
9899
activeVBProjectFileName = activeVBProject.FileName
99-
If Err.Number > 0 Then activeVBProjectFileName = CurDir()
100+
If Err.Number <> 0 Then
101+
activeVBProjectFolderName = CurDir()
102+
Else
103+
activeVBProjectFolderName = fso.GetParentFolderName(activeVBProjectFileName)
104+
End If
100105
On Error GoTo 0
101106

102107
On Error GoTo EH
103108

104-
comdlg.InitDir = fso.GetParentFolderName(activeVBProjectFileName)
109+
comdlg.InitDir = activeVBProjectFolderName
105110

106111
res = comdlg.ShowFolderBrowser()
107112
If Not res Then
@@ -136,19 +141,17 @@ Module FormProcessing
136141
Set userForm = activeVBProject.VBComponents(dialogName)
137142

138143
'generate GUID to be used for twinBASIC form designer and code module
139-
'does this result in null-terminated string? If so need to strip...
140144
guid = VBA.CreateGUID()
141-
If InStr(guid, vbNullChar) > 0 Then
142-
guid = Left$(guid, InStr(guid, vbNullChar) - 1)
143-
End If
144145

145146
'sort controls in order of descendancy - must process parent controls first!
146147
Set sorted = SortControls(userForm.Designer, dialogName)
147148

148149
'create the tB form dictionary from resources
149150
Set tBForm = JsonConverter.ParseJson(readControlJson("Form"))
151+
150152
'set properties of tB form that have matching UserForm counterparts
151153
processForm userForm, tBForm, ptsToPixels, useVBAFont, use3DAppearance, guid, hideIconBox
154+
152155
'enumerate and process each UserForm control
153156
For Each ctl In sorted
154157
vbaControlTypeName = TypeName(ctl)
@@ -486,8 +489,8 @@ Module FormProcessing
486489
tbControl.Item("Tag") = ctl.Tag
487490
tbControl.Item("MousePointer") = getMousePointerString(ctl.MousePointer)
488491

489-
If ctl.MouseIcon IsNot Nothing Then
490-
tbControl.Item("MouseIcon") = GetMouseIconString(ctl.MouseIcon)
492+
If ctl.MouseIcon <> 0 Then
493+
tbControl.Item("MouseIcon") = GetImageString(ctl.MouseIcon)
491494
End If
492495

493496
If TypeName(ctl.Parent) = "Frame" Then
@@ -543,8 +546,8 @@ Module FormProcessing
543546
tbControl.Item("Tag") = ctl.Tag
544547
tbControl.Item("MousePointer") = getMousePointerString(ctl.MousePointer)
545548

546-
If ctl.MouseIcon IsNot Nothing Then
547-
tbControl.Item("MouseIcon") = GetMouseIconString(ctl.MouseIcon)
549+
If ctl.MouseIcon <> 0 Then
550+
tbControl.Item("MouseIcon") = GetImageString(ctl.MouseIcon)
548551
End If
549552

550553
tbControl.Item("ToolTipText") = ctl.ControlTipText
@@ -588,8 +591,8 @@ Module FormProcessing
588591
tbControl.Item("Tag") = ctl.Tag
589592
tbControl.Item("MousePointer") = getMousePointerString(ctl.MousePointer)
590593

591-
If ctl.MouseIcon IsNot Nothing Then
592-
tbControl.Item("MouseIcon") = GetMouseIconString(ctl.MouseIcon)
594+
If ctl.MouseIcon <> 0 Then
595+
tbControl.Item("MouseIcon") = GetImageString(ctl.MouseIcon)
593596
End If
594597

595598
'tbControl.Item("HelpContextID") = ctl.HelpContextID
@@ -601,6 +604,7 @@ Module FormProcessing
601604
tbControl.Item("TabIndex") = ctl.TabIndex
602605
tbControl.Item("TabStop") = ctl.TabStop
603606
tbControl.Item("Text") = ctl.Text
607+
604608
Select Case ctl.TextAlign
605609
Case fmTextAlignCenter
606610
tbControl.Item("Alignment") = "vbCenter"
@@ -637,8 +641,8 @@ Module FormProcessing
637641
tbControl.Item("Tag") = ctl.Tag
638642
tbControl.Item("MousePointer") = getMousePointerString(ctl.MousePointer)
639643

640-
If ctl.MouseIcon IsNot Nothing Then
641-
tbControl.Item("MouseIcon") = GetMouseIconString(ctl.MouseIcon)
644+
If ctl.MouseIcon <> 0 Then
645+
tbControl.Item("MouseIcon") = GetImageString(ctl.MouseIcon)
642646
End If
643647

644648
'tbControl.Item("HelpContextID") = ctl.HelpContextID
@@ -676,8 +680,8 @@ Module FormProcessing
676680
tbControl.Item("Tag") = ctl.Tag
677681
tbControl.Item("MousePointer") = getMousePointerString(ctl.MousePointer)
678682

679-
If ctl.MouseIcon IsNot Nothing Then
680-
tbControl.Item("MouseIcon") = GetMouseIconString(ctl.MouseIcon)
683+
If ctl.MouseIcon <> 0 Then
684+
tbControl.Item("MouseIcon") = GetImageString(ctl.MouseIcon)
681685
End If
682686

683687
'tbControl.Item("HelpContextID") = ctl.HelpContextID
@@ -690,6 +694,7 @@ Module FormProcessing
690694
tbControl.Item("Value") = IIf(ctl.Value, "vbChecked", "vbUnchecked")
691695
tbControl.Item("TabIndex") = ctl.TabIndex
692696
tbControl.Item("TabStop") = ctl.TabStop
697+
693698
Select Case ctl.TextAlign
694699
Case fmTextAlignCenter
695700
'tbControl.Item("Alignment") = "tbCenter" 'tb CheckBox does not allow tbCenter
@@ -728,8 +733,8 @@ Module FormProcessing
728733
tbControl.Item("Tag") = ctl.Tag
729734
tbControl.Item("MousePointer") = getMousePointerString(ctl.MousePointer)
730735

731-
If ctl.MouseIcon IsNot Nothing Then
732-
tbControl.Item("MouseIcon") = GetMouseIconString(ctl.MouseIcon)
736+
If ctl.MouseIcon <> 0 Then
737+
tbControl.Item("MouseIcon") = GetImageString(ctl.MouseIcon)
733738
End If
734739

735740
'tbControl.Item("HelpContextID") = ctl.HelpContextID
@@ -779,8 +784,8 @@ Module FormProcessing
779784
tbControl.Item("Tag") = ctl.Tag
780785
tbControl.Item("MousePointer") = getMousePointerString(ctl.MousePointer)
781786

782-
If ctl.MouseIcon IsNot Nothing Then
783-
tbControl.Item("MouseIcon") = GetMouseIconString(ctl.MouseIcon)
787+
If ctl.MouseIcon <> 0 Then
788+
tbControl.Item("MouseIcon") = GetImageString(ctl.MouseIcon)
784789
End If
785790

786791
'tbControl.Item("HelpContextID") = ctl.HelpContextID
@@ -791,6 +796,7 @@ Module FormProcessing
791796
tbControl.Item("ForeColor") = ctl.ForeColor
792797
tbControl.Item("TabIndex") = ctl.TabIndex
793798
tbControl.Item("TabStop") = ctl.TabStop
799+
794800
Select Case ctl.MultiSelect
795801
Case fmMultiSelectSingle
796802
tbControl.Item("MultiSelect") = "vbMultiSelectNone"
@@ -799,6 +805,7 @@ Module FormProcessing
799805
Case fmMultiSelectExtended
800806
tbControl.Item("MultiSelect") = "vbMultiSelectExtended"
801807
End Select
808+
802809
Select Case ctl.ListStyle
803810
Case fmListStylePlain
804811
tbControl.Item("Style") = "vbListBoxStandard"
@@ -836,8 +843,8 @@ Module FormProcessing
836843
tbControl.Item("Tag") = ctl.Tag
837844
tbControl.Item("MousePointer") = getMousePointerString(ctl.MousePointer)
838845

839-
If ctl.MouseIcon IsNot Nothing Then
840-
tbControl.Item("MouseIcon") = GetMouseIconString(ctl.MouseIcon)
846+
If ctl.MouseIcon <> 0 Then
847+
tbControl.Item("MouseIcon") = GetImageString(ctl.MouseIcon)
841848
End If
842849

843850
'tbControl.Item("HelpContextID") = ctl.HelpContextID
@@ -850,6 +857,7 @@ Module FormProcessing
850857
tbControl.Item("TabIndex") = ctl.TabIndex
851858
tbControl.Item("Caption") = ctl.Caption
852859
tbControl.Item("Value") = ctl.Value
860+
853861
Select Case ctl.TextAlign
854862
Case fmTextAlignCenter
855863
tbControl.Item("Alignment") = "tbCenter"
@@ -858,8 +866,10 @@ Module FormProcessing
858866
Case fmTextAlignRight
859867
tbControl.Item("Alignment") = "tbRightJustify"
860868
End Select
869+
861870
tbControl.Item("VisualStyles") = useVisualStyles
862871
If use3DAppearance Then tbControl.Item("Appearance") = vbAppear3d Else tbControl.Item("Appearance") = vbAppearFlat
872+
863873
If ctl.Picture.type <> 0 Then
864874
tbControl.Item("Picture") = GetImageString(ctl.Picture)
865875
tbControl.Item("Style") = "vbButtonGraphical"
@@ -890,8 +900,8 @@ Module FormProcessing
890900
tbControl.Item("Tag") = ctl.Tag
891901
tbControl.Item("MousePointer") = getMousePointerString(ctl.MousePointer)
892902

893-
If ctl.MouseIcon IsNot Nothing Then
894-
tbControl.Item("MouseIcon") = GetMouseIconString(ctl.MouseIcon)
903+
If ctl.MouseIcon <> 0 Then
904+
tbControl.Item("MouseIcon") = GetImageString(ctl.MouseIcon)
895905
End If
896906

897907
tbControl.Item("ToolTipText") = ctl.ControlTipText
@@ -929,8 +939,8 @@ Module FormProcessing
929939
tbControl.Item("Tag") = ctl.Tag
930940
tbControl.Item("MousePointer") = getMousePointerString(ctl.MousePointer)
931941

932-
If ctl.MouseIcon IsNot Nothing Then
933-
tbControl.Item("MouseIcon") = GetMouseIconString(ctl.MouseIcon)
942+
If ctl.MouseIcon <> 0 Then
943+
tbControl.Item("MouseIcon") = GetImageString(ctl.MouseIcon)
934944
End If
935945

936946
'tbControl.Item("HelpContextID") = ctl.HelpContextID
@@ -979,8 +989,8 @@ Module FormProcessing
979989
tbControl.Item("Tag") = ctl.Tag
980990
tbControl.Item("MousePointer") = getMousePointerString(ctl.MousePointer)
981991

982-
If ctl.MouseIcon IsNot Nothing Then
983-
tbControl.Item("MouseIcon") = GetMouseIconString(ctl.MouseIcon)
992+
If ctl.MouseIcon <> 0 Then
993+
tbControl.Item("MouseIcon") = GetImageString(ctl.MouseIcon)
984994
End If
985995

986996
'tbControl.Item("HelpContextID") = ctl.HelpContextID
@@ -1066,8 +1076,8 @@ Module FormProcessing
10661076

10671077
tbControl.Item("MousePointer") = getMousePointerString(frm.MousePointer)
10681078

1069-
If frm.MouseIcon IsNot Nothing Then
1070-
tbControl.Item("MouseIcon") = GetMouseIconString(frm.MouseIcon)
1079+
If frm.MouseIcon <> 0 Then
1080+
tbControl.Item("MouseIcon") = GetImageString(frm.MouseIcon)
10711081
End If
10721082

10731083
tbControl.Item("FormDesignerId") = "{" & guid & "}"

0 commit comments

Comments
 (0)