|
1 | 1 | ' ========================================================================== |
2 | | -' tBUserFormConverter v2.5 |
| 2 | +' tBUserFormConverter v2.6 |
3 | 3 | ' |
4 | 4 | ' A VBIDE add-in (complied with twinBASIC) that converts VBA UserForms for use in twinBASIC. |
5 | 5 | ' |
|
33 | 33 | ' ========================================================================== |
34 | 34 |
|
35 | 35 | Module FormProcessing |
| 36 | + |
| 37 | + '--------------------------------------------------------------------- |
| 38 | + ' MS Forms Enums |
| 39 | + '--------------------------------------------------------------------- |
| 40 | + Private Enum fmMousePointer |
| 41 | + fmMousePointerDefault = 0 ' &H00000000& |
| 42 | + fmMousePointerArrow = 1 ' &H00000001& |
| 43 | + fmMousePointerCross = 2 ' &H00000002& |
| 44 | + fmMousePointerIBeam = 3 ' &H00000003& |
| 45 | + fmMousePointerSizeNESW = 6 ' &H00000006& |
| 46 | + fmMousePointerSizeNS = 7 ' &H00000007& |
| 47 | + fmMousePointerSizeNWSE = 8 ' &H00000008& |
| 48 | + fmMousePointerSizeWE = 9 ' &H00000009& |
| 49 | + fmMousePointerUpArrow = 10 ' &H0000000A& |
| 50 | + fmMousePointerHourGlass = 11 ' &H0000000B& |
| 51 | + fmMousePointerNoDrop = 12 ' &H0000000C& |
| 52 | + fmMousePointerAppStarting = 13 ' &H0000000D& |
| 53 | + fmMousePointerHelp = 14 ' &H0000000E& |
| 54 | + fmMousePointerSizeAll = 15 ' &H0000000F& |
| 55 | + fmMousePointerCustom = 99 ' &H00000063& |
| 56 | + End Enum |
| 57 | + |
| 58 | + Private Enum fmScrollBars |
| 59 | + fmScrollBarsNone = 0 ' &H00000000& |
| 60 | + fmScrollBarsHorizontal = 1 ' &H00000001& |
| 61 | + fmScrollBarsVertical = 2 ' &H00000002& |
| 62 | + fmScrollBarsBoth = 3 ' &H00000003& |
| 63 | + End Enum |
| 64 | + |
| 65 | + Private Enum fmBorderStyle |
| 66 | + fmBorderStyleNone = 0 ' &H00000000& |
| 67 | + fmBorderStyleSingle = 1 ' &H00000001& |
| 68 | + End Enum |
| 69 | + |
| 70 | + Private Enum fmTextAlign |
| 71 | + fmTextAlignLeft = 1 ' &H00000001& |
| 72 | + fmTextAlignCenter = 2 ' &H00000002& |
| 73 | + fmTextAlignRight = 3 ' &H00000003& |
| 74 | + End Enum |
| 75 | + |
| 76 | + Private Enum fmBackStyle |
| 77 | + fmBackStyleTransparent = 0 ' &H00000000& |
| 78 | + fmBackStyleOpaque = 1 ' &H00000001& |
| 79 | + End Enum |
| 80 | + |
| 81 | + Private Enum fmOrientation |
| 82 | + fmOrientationAuto = -1 ' &HFFFFFFFF& |
| 83 | + fmOrientationVertical = 0 ' &H00000000& |
| 84 | + fmOrientationHorizontal = 1 ' &H00000001& |
| 85 | + End Enum |
| 86 | + |
| 87 | + Private Enum fmMultiSelect |
| 88 | + fmMultiSelectSingle = 0 ' &H00000000& |
| 89 | + fmMultiSelectMulti = 1 ' &H00000001& |
| 90 | + fmMultiSelectExtended = 2 ' &H00000002& |
| 91 | + End Enum |
| 92 | + |
| 93 | + Private Enum fmListStyle |
| 94 | + fmListStylePlain = 0 ' &H00000000& |
| 95 | + fmListStyleOption = 1 ' &H00000001& |
| 96 | + End Enum |
| 97 | + |
| 98 | + Enum fmSpecialEffect |
| 99 | + fmSpecialEffectFlat = 0 ' &H00000000& |
| 100 | + fmSpecialEffectRaised = 1 ' &H00000001& |
| 101 | + fmSpecialEffectSunken = 2 ' &H00000002& |
| 102 | + fmSpecialEffectEtched = 3 ' &H00000003& |
| 103 | + fmSpecialEffectBump = 6 ' &H00000006& |
| 104 | + End Enum |
| 105 | + |
| 106 | + Private Enum fmStyle |
| 107 | + fmStyleDropDownCombo = 0 ' &H00000000& |
| 108 | + fmStyleDropDownList = 2 ' &H00000002& |
| 109 | + End Enum |
| 110 | + |
| 111 | + '--------------------------------------------------------------------- |
| 112 | + ' Public Forms Processing (called by Menu entries) |
| 113 | + '--------------------------------------------------------------------- |
36 | 114 |
|
37 | 115 | Public Sub ExportUserForm(activeVBProject As VBProject) |
38 | 116 | Dim ctl As Object |
@@ -439,6 +517,10 @@ Module FormProcessing |
439 | 517 | End If |
440 | 518 | End Function |
441 | 519 |
|
| 520 | + '--------------------------------------------------------------------- |
| 521 | + ' Private Support Procedures |
| 522 | + '--------------------------------------------------------------------- |
| 523 | + |
442 | 524 | 'sort controls in order of descendancy - must process parent controls before their descendants! |
443 | 525 | Private Function SortControls(frm As Object, ByVal dialogName As String) As Collection |
444 | 526 | Dim sorted As New Collection |
@@ -594,7 +676,12 @@ Module FormProcessing |
594 | 676 | tbControl.Item("AutoSize") = ctl.AutoSize |
595 | 677 |
|
596 | 678 | If ctl.BackStyle = fmBackStyleTransparent Then tbControl.Item("BackStyle") = "vbBFTransparent" |
597 | | - tbControl.Item("BorderStyle") = IIf(ctl.BorderStyle = fmBorderStyleNone, "vbNoBorder", "vbFixedSingleBorder") |
| 679 | + |
| 680 | + If ctl.SpecialEffect = fmSpecialEffectFlat Then |
| 681 | + tbControl.Item("BorderStyle") = IIf(ctl.BorderStyle = fmBorderStyleNone, "vbNoBorder", "vbFixedSingleBorder") |
| 682 | + Else |
| 683 | + tbControl.Item("BorderStyle") = "vbFixedSingleBorder" |
| 684 | + End If |
598 | 685 |
|
599 | 686 | 'tbControl.Item("HelpContextID") = ctl.HelpContextID |
600 | 687 | tbControl.Item("ToolTipText") = ctl.ControlTipText |
@@ -717,7 +804,11 @@ Module FormProcessing |
717 | 804 | tbControl.Item("Alignment") = "vbRightJustify" |
718 | 805 | End Select |
719 | 806 |
|
720 | | - tbControl.Item("BorderStyle") = IIf(ctl.BorderStyle = fmBorderStyleNone, "vbNoBorder", "vbFixedSingleBorder") |
| 807 | + If ctl.SpecialEffect = fmSpecialEffectFlat Then |
| 808 | + tbControl.Item("BorderStyle") = IIf(ctl.BorderStyle = fmBorderStyleNone, "vbNoBorder", "vbFixedSingleBorder") |
| 809 | + Else |
| 810 | + tbControl.Item("BorderStyle") = "vbFixedSingleBorder" |
| 811 | + End If |
721 | 812 |
|
722 | 813 | tbControl.Item("VisualStyles") = useVisualStyles |
723 | 814 | If use3DAppearance Then tbControl.Item("Appearance") = vbAppear3d Else tbControl.Item("Appearance") = vbAppearFlat |
@@ -753,9 +844,19 @@ Module FormProcessing |
753 | 844 | If useVBAFont Then SetFontProperties tbControl, ctl |
754 | 845 | tbControl.Item("BackColor") = ctl.BackColor |
755 | 846 | tbControl.Item("ForeColor") = ctl.ForeColor |
756 | | - If ctl.Caption = "" Then |
| 847 | + |
| 848 | + 'If ctl.Caption = "" Then |
| 849 | + ' tbControl.Item("BorderStyle") = IIf(ctl.BorderStyle = fmBorderStyleNone, "vbNoBorder", "vbFixedSingleBorder") |
| 850 | + 'End If |
| 851 | + |
| 852 | + If ctl.SpecialEffect = fmSpecialEffectFlat Then |
757 | 853 | tbControl.Item("BorderStyle") = IIf(ctl.BorderStyle = fmBorderStyleNone, "vbNoBorder", "vbFixedSingleBorder") |
| 854 | + Else |
| 855 | + tbControl.Item("BorderStyle") = "vbFixedSingleBorder" |
758 | 856 | End If |
| 857 | + |
| 858 | + |
| 859 | + |
759 | 860 | tbControl.Item("Caption") = ctl.Caption |
760 | 861 | tbControl.Item("VisualStyles") = useVisualStyles |
761 | 862 | If use3DAppearance Then tbControl.Item("Appearance") = vbAppear3d Else tbControl.Item("Appearance") = vbAppearFlat |
@@ -850,7 +951,11 @@ Module FormProcessing |
850 | 951 | tbControl.Item("TabIndex") = ctl.TabIndex |
851 | 952 | tbControl.Item("TabStop") = ctl.TabStop |
852 | 953 |
|
853 | | - tbControl.Item("BorderStyle") = IIf(ctl.BorderStyle = fmBorderStyleNone, "vbNoBorder", "vbFixedSingleBorder") |
| 954 | + If ctl.SpecialEffect = fmSpecialEffectFlat Then |
| 955 | + tbControl.Item("BorderStyle") = IIf(ctl.BorderStyle = fmBorderStyleNone, "vbNoBorder", "vbFixedSingleBorder") |
| 956 | + Else |
| 957 | + tbControl.Item("BorderStyle") = "vbFixedSingleBorder" |
| 958 | + End If |
854 | 959 |
|
855 | 960 | 'tb is vbComboDropdown,vbComboSimple,vbComboDropdownList |
856 | 961 | Select Case ctl.Style |
@@ -916,7 +1021,11 @@ Module FormProcessing |
916 | 1021 | tbControl.Item("Style") = "vbListBoxCheckBox" |
917 | 1022 | End Select |
918 | 1023 |
|
919 | | - tbControl.Item("BorderStyle") = IIf(ctl.BorderStyle = fmBorderStyleNone, "vbNoBorder", "vbFixedSingleBorder") |
| 1024 | + If ctl.SpecialEffect = fmSpecialEffectFlat Then |
| 1025 | + tbControl.Item("BorderStyle") = IIf(ctl.BorderStyle = fmBorderStyleNone, "vbNoBorder", "vbFixedSingleBorder") |
| 1026 | + Else |
| 1027 | + tbControl.Item("BorderStyle") = "vbFixedSingleBorder" |
| 1028 | + End If |
920 | 1029 |
|
921 | 1030 | tbControl.Item("IntegralHeight") = ctl.IntegralHeight |
922 | 1031 | tbControl.Item("Columns") = ctl.ColumnCount - 1 '? |
|
0 commit comments