X Tutup
Skip to content

Commit bccc63c

Browse files
VBAndCsVBAndCs
committed
sVB 3.0.9.6
1 parent 84b0250 commit bccc63c

Some content is hidden

Large Commits have some content hidden by default. Use the searchbox below for content that may be hidden.

75 files changed

+1574
-963
lines changed

‎DiagramHelper/Designer.vb‎

Lines changed: 14 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -1275,6 +1275,9 @@ Public Class Designer
12751275
Me.Scale = Sc
12761276
End Sub
12771277

1278+
1279+
Public Shared Event OnOpeningCodeFile(fileName As String)
1280+
12781281
Public Shared Sub Open()
12791282
Dim lastDir = GetSetting("SmallVisualBasic", "Files", "Open")
12801283
If lastDir = "" OrElse Not IO.Directory.Exists(lastDir) Then
@@ -1287,19 +1290,24 @@ Public Class Designer
12871290

12881291
Dim dlg As New Microsoft.Win32.OpenFileDialog With {
12891292
.DefaultExt = ".xaml", ' Default file extension
1290-
.Filter = "Diagram Pages|*.xaml",
1291-
.Title = "Open Diagram Design Page",
1293+
.Filter = "Forms|*.xaml;*.sb",
1294+
.Title = "Open Form",
12921295
.InitialDirectory = lastDir
12931296
}
12941297

12951298
If dlg.ShowDialog() = True Then
12961299
SaveSetting("SmallVisualBasic", "Files", "Open", IO.Path.GetDirectoryName(dlg.FileName))
1297-
If Not CurrentPage.IsDirty AndAlso
1300+
If IO.Path.GetExtension(dlg.FileName).ToLower() = ".xaml" Then
1301+
If Not CurrentPage.IsDirty AndAlso
12981302
CurrentPage.IsNew AndAlso Pages.Count = 1 Then
1299-
ClosePage(False, True)
1300-
End If
1303+
ClosePage(False, True)
1304+
End If
13011305

1302-
SwitchTo(dlg.FileName)
1306+
SwitchTo(dlg.FileName)
1307+
CurrentPage.Focus()
1308+
Else
1309+
RaiseEvent OnOpeningCodeFile(dlg.FileName)
1310+
End If
13031311
End If
13041312
End Sub
13051313

‎DiagramHelper/DiagramHelper.vbproj‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -206,9 +206,9 @@
206206
<AppDesigner Include="My Project\" />
207207
</ItemGroup>
208208
<ItemGroup>
209-
<ProjectReference Include="..\SBCompiler\SBCompiler\svB.Compiler.vbproj">
209+
<ProjectReference Include="..\SBCompiler\SBCompiler\sVB.Compiler.vbproj">
210210
<Project>{c35b1c89-a93e-43ff-8608-7c8274562a87}</Project>
211-
<Name>svB.Compiler</Name>
211+
<Name>sVB.Compiler</Name>
212212
</ProjectReference>
213213
<ProjectReference Include="..\WpfDialogs\WpfDialogs.vbproj">
214214
<Project>{c80161ce-9098-4af6-bcf9-39dd675b444c}</Project>

‎LangServices/LangServices.vbproj‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -145,9 +145,9 @@
145145
</Page>
146146
</ItemGroup>
147147
<ItemGroup>
148-
<ProjectReference Include="..\SBCompiler\SBCompiler\svB.Compiler.vbproj">
148+
<ProjectReference Include="..\SBCompiler\SBCompiler\sVB.Compiler.vbproj">
149149
<Project>{c35b1c89-a93e-43ff-8608-7c8274562a87}</Project>
150-
<Name>svB.Compiler</Name>
150+
<Name>sVB.Compiler</Name>
151151
</ProjectReference>
152152
<ProjectReference Include="..\SmallBasicLibrary\sVB.Library.vbproj">
153153
<Project>{3a782b43-424c-4023-a24f-58ac371e18bd}</Project>

‎SBCompiler/SBCompiler/Engine/ProgramEngine.vb‎

Lines changed: 19 additions & 17 deletions
Original file line numberDiff line numberDiff line change
@@ -48,34 +48,36 @@ Namespace Microsoft.SmallVisualBasic.Engine
4848

4949
Private Sub DebugShowDialog(formName As String, argsArr As Primitive)
5050
Dim isLoaded = False
51-
If WinForms.Form.GetIsLoaded(formName) Then
52-
WinForms.Form.SetArgsArr(formName, argsArr)
53-
isloaded = True
51+
Dim frmName As New Primitive(formName)
52+
If WinForms.Form.GetIsLoaded(frmName) Then
53+
WinForms.Form.SetArgsArr(frmName, argsArr)
54+
isLoaded = True
5455
Else
55-
Stack.PushValue("_" & CStr(formName).ToLower() & "_argsArr", argsArr)
56+
Stack.PushValue(New Primitive("_" & formName.ToLower() & "_argsArr"), argsArr)
5657
_currentRunner.RunForm(formName)
57-
WinForms.Control.SetVisible(formName, False)
58+
WinForms.Control.SetVisible(frmName, False)
5859
End If
5960

60-
WinForms.Form.ShowDialog(formName)
61+
WinForms.Form.ShowDialog(frmName)
6162
If isLoaded Then WinForms.Form.RaiseOnShown(formName)
6263
End Sub
6364

6465
Private Sub DebugShowForm(formName As String, argsArr As Primitive)
6566
If Not _currentRunner.Evaluating Then
66-
If WinForms.Form.GetIsLoaded(formName) Then
67-
WinForms.Forms.DoShowForm(formName, argsArr)
67+
Dim frmName As New Primitive(formName)
68+
If WinForms.Form.GetIsLoaded(frmName) Then
69+
WinForms.Forms.DoShowForm(frmName, argsArr)
6870
Else
69-
Stack.PushValue("_" & CStr(formName).ToLower() & "_argsArr", argsArr)
71+
Stack.PushValue(New Primitive("_" & formName.ToLower() & "_argsArr"), argsArr)
7072
_currentRunner.RunForm(formName)
7173
End If
7274
End If
7375
End Sub
7476

7577
Private Sub DebugShowChildForm(parentFormName As String, childFormName As String, argsArr As Primitive)
7678
If Not _currentRunner.Evaluating Then
77-
Stack.PushValue("_" & CStr(childFormName).ToLower() & "_argsArr", argsArr)
78-
Dim isLoaded = CBool(WinForms.Form.GetIsLoaded(childFormName))
79+
Stack.PushValue(New Primitive("_" & childFormName.ToLower() & "_argsArr"), argsArr)
80+
Dim isLoaded = CBool(WinForms.Form.GetIsLoaded(New Primitive(childFormName)))
7981
_currentRunner.RunForm(childFormName)
8082
WinForms.Form.SetOwner(childFormName, parentFormName)
8183
If isLoaded Then WinForms.Form.RaiseOnShown(childFormName)
@@ -106,7 +108,7 @@ Namespace Microsoft.SmallVisualBasic.Engine
106108

107109
If Not testMethods.Any Then Return
108110

109-
Dim txtTest = WinForms.Form.AddTestTextBox(formName)
111+
Dim txtTest As New Primitive(WinForms.Form.AddTestTextBox(formName))
110112
Dim errMsg = " doesn't return a value. Use a test function and return a text showing the result of the test."
111113
Dim n = 0
112114

@@ -121,17 +123,17 @@ Namespace Microsoft.SmallVisualBasic.Engine
121123
Dim msg As String = MethodCallExpression.EvaluateFunction(runner, subroutineCall)
122124

123125
If msg = "" Then
124-
WinForms.TextBox.Append(txtTest, testName.Text)
125-
WinForms.TextBox.Append(txtTest, errMsg)
126+
WinForms.TextBox.Append(txtTest, New Primitive(testName.Text))
127+
WinForms.TextBox.Append(txtTest, New Primitive(errMsg))
126128
Else
127-
WinForms.TextBox.Append(txtTest, msg)
129+
WinForms.TextBox.Append(txtTest, New Primitive(msg))
128130
n += 1
129131
End If
130132

131133
Catch ex As Exception
132-
WinForms.TextBox.Append(txtTest, $"{testName} has caused the error: {ex.Message}.")
134+
WinForms.TextBox.Append(txtTest, New Primitive($"{testName} has caused the error: {ex.Message}."))
133135
End Try
134-
WinForms.TextBox.Append(txtTest, vbCrLf)
136+
WinForms.TextBox.Append(txtTest, New Primitive(vbCrLf))
135137
Next
136138
result = n
137139
End Sub

‎SBCompiler/SBCompiler/Engine/ProgramRunner.vb‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -166,7 +166,7 @@ Namespace Microsoft.SmallVisualBasic.Engine
166166
If subroutines.ContainsKey(key) Then
167167
Dim subroutine = CType(subroutines(key).Parent, SubroutineStatement)
168168
If subroutine.SubToken.Type = TokenType.Sub Then
169-
Return "A subroutine call doesn't return any value!"
169+
Return New Library.Primitive("A subroutine call doesn't return any value!")
170170
End If
171171
End If
172172
Else

‎SBCompiler/SBCompiler/Expressions/ArrayExpression.vb‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -102,7 +102,7 @@ Namespace Microsoft.SmallVisualBasic.Expressions
102102
If idEpr IsNot Nothing Then
103103
Dim fields = runner.Fields
104104
If Not fields.TryGetValue(runner.GetKey(idEpr.Identifier), value) Then
105-
value = ""
105+
value = New Primitive("")
106106
End If
107107

108108
Return Primitive.GetArrayValue(value, _Indexer.Evaluate(runner))

‎SBCompiler/SBCompiler/Expressions/MethodCallExpression.vb‎

Lines changed: 10 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -124,7 +124,7 @@ Namespace Microsoft.SmallVisualBasic.Expressions
124124
If runner.Evaluating AndAlso
125125
(tName = "tw" OrElse tName = "textwindow") AndAlso
126126
(mName = "read" OrElse mName = "readnumber") Then
127-
Return "This method can't be evaluated at this time beecause it expects the user to enter a value in the text window."
127+
Return New Primitive("This method can't be evaluated at this time beecause it expects the user to enter a value in the text window.")
128128
End If
129129

130130
Dim args As New List(Of Object)()
@@ -137,30 +137,30 @@ Namespace Microsoft.SmallVisualBasic.Expressions
137137
Dim typeInfo = runner.TypeInfoBag.Types(tName)
138138
methodInfo = typeInfo.Methods(_MethodName.LCaseText)
139139
If runner.Evaluating AndAlso methodInfo.ReturnType Is GetType(System.Void) Then
140-
Return "A subroutine call doesn't return any value!"
140+
Return New Primitive("A subroutine call doesn't return any value!")
141141
Else
142142
Return CType(methodInfo.Invoke(Nothing, args.ToArray()), Primitive)
143143
End If
144144
End If
145145

146146
Dim type = runner.SymbolTable.GetTypeInfo(_TypeName)
147147
Dim memberInfo = runner.SymbolTable.GetMemberInfo(_MethodName, type, True)
148-
If memberInfo Is Nothing Then Return "???"
148+
If memberInfo Is Nothing Then Return New Primitive("???")
149149

150150
methodInfo = TryCast(memberInfo, MethodInfo)
151-
If methodInfo Is Nothing Then Return "???"
151+
If methodInfo Is Nothing Then Return New Primitive("???")
152152
If runner.Evaluating AndAlso methodInfo.ReturnType Is GetType(System.Void) Then
153-
Return "A subroutine call doesn't return any value!"
153+
Return New Primitive("A subroutine call doesn't return any value!")
154154
End If
155155

156156
Dim key = runner.GetKey(_TypeName)
157-
If Not runner.Fields.ContainsKey(key) Then Return "This object is not set yet"
157+
If Not runner.Fields.ContainsKey(key) Then Return New Primitive("This object is not set yet")
158158
args.Insert(0, runner.Fields(key))
159159
Try
160160
Return CType(methodInfo.Invoke(Nothing, args.ToArray()), Primitive)
161161
Catch ex As Exception
162162
End Try
163-
Return "Can't evaluate this method call at this time. Calling some methods twice can cause errors like when you try to add the same control again on the form"
163+
Return New Primitive("Can't evaluate this method call at this time. Calling some methods twice can cause errors like when you try to add the same control again on the form")
164164
End Function
165165

166166
Friend Shared Function EvaluateFunction(
@@ -169,7 +169,7 @@ Namespace Microsoft.SmallVisualBasic.Expressions
169169

170170
subroutine.Execute(runner)
171171
If subroutine.DontExecuteSub Then
172-
Return "A subroutine call doesn't return any value!"
172+
Return New Primitive("A subroutine call doesn't return any value!")
173173
End If
174174

175175
Dim retKey = $"{subroutine.Name.LCaseText}.return"
@@ -178,14 +178,14 @@ Namespace Microsoft.SmallVisualBasic.Expressions
178178
If result.HasValue Then
179179
Return result.Value
180180
ElseIf runner.Evaluating Then
181-
Return "A subroutine call doesn't return any value!"
181+
Return New Primitive("A subroutine call doesn't return any value!")
182182
Else
183183
Return New Primitive()
184184
End If
185185
ElseIf runner.Fields.ContainsKey(retKey) Then
186186
Return runner.Fields(retKey)
187187
ElseIf runner.Evaluating Then
188-
Return "A subroutine call doesn't return any value!"
188+
Return New Primitive("A subroutine call doesn't return any value!")
189189
Else
190190
Return New Primitive()
191191
End If

‎SBCompiler/SBCompiler/Expressions/PropertyExpression.vb‎

Lines changed: 4 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -99,15 +99,15 @@ Namespace Microsoft.SmallVisualBasic.Expressions
9999
ElseIf runner.TypeInfoBag.Types.ContainsKey(tName) Then
100100
Dim typeInfo = runner.TypeInfoBag.Types(tName)
101101
Dim propKey = _PropertyName.LCaseText
102-
If Not typeInfo.Properties.ContainsKey(propKey) Then Return "???"
102+
If Not typeInfo.Properties.ContainsKey(propKey) Then Return New Primitive("???")
103103

104104
Dim propertyInfo = typeInfo.Properties(propKey)
105105
Return CType(propertyInfo.GetValue(Nothing, Nothing), Primitive)
106106

107107
Else
108108
Dim type = runner.SymbolTable.GetTypeInfo(_TypeName)
109109
Dim memberInfo = runner.SymbolTable.GetMemberInfo(_PropertyName, type, False)
110-
If memberInfo Is Nothing Then Return "???"
110+
If memberInfo Is Nothing Then Return New Primitive("???")
111111

112112
Dim propInfo = TryCast(memberInfo, PropertyInfo)
113113
If propInfo IsNot Nothing Then
@@ -117,11 +117,11 @@ Namespace Microsoft.SmallVisualBasic.Expressions
117117
Dim methodInfo = TryCast(memberInfo, MethodInfo)
118118
If methodInfo IsNot Nothing Then
119119
Dim key = runner.GetKey(_TypeName)
120-
If Not runner.Fields.ContainsKey(key) Then Return "This object is not set yet"
120+
If Not runner.Fields.ContainsKey(key) Then Return New Primitive("This object is not set yet")
121121
Return CType(methodInfo.Invoke(Nothing, New Object() {runner.Fields(key)}), Primitive)
122122
End If
123123

124-
Return "Event Handler"
124+
Return New Primitive("Event Handler")
125125
End If
126126
End Function
127127

‎SBCompiler/SBCompiler/Parser.vb‎

Lines changed: 0 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1326,7 +1326,6 @@ Namespace Microsoft.SmallVisualBasic
13261326
Return New DateResult(Nothing, True)
13271327
End If
13281328
End If
1329-
13301329
End Function
13311330

13321331

‎Samples/Color Samples/Highlight and select labels/Form1.sb‎

Lines changed: 47 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,47 @@
1+
_Color = Colors.LightGreen
2+
3+
ForEach _Label In Me.Controls
4+
_Label.OnClick = Label_OnClick
5+
_Label.OnMouseEnter = Label_OnMouseEnter
6+
_Label.OnMouseLeave = Label_OnMouseLeave
7+
_Label.BackColor = Colors.LightGreen
8+
Next
9+
10+
Sub Label_OnClick()
11+
ForEach _label In Me.Controls
12+
If _label = Event.SenderControl Then
13+
If _Color = Colors.LightGreen Then
14+
_label.BackColor = Colors.Red
15+
_label.FontBold = True
16+
Else
17+
_label.BackColor = Colors.LightGreen
18+
_label.FontBold = False
19+
EndIf
20+
_Color = _label.BackColor
21+
ElseIf _label.TypeName = ControlTypes.Label Then
22+
_label.BackColor = Colors.LightGreen
23+
_label.FontBold = False
24+
EndIf
25+
Next
26+
EndSub
27+
28+
29+
' ------------------------------------------------
30+
Sub Label_OnMouseEnter()
31+
_Label = Event.SenderControl
32+
_Color = _Label.BackColor
33+
If _Color = Colors.Red Then
34+
_Label.BackColor = Colors.Goldenrod
35+
Else
36+
_Label.BackColor = Colors.Gold
37+
EndIf
38+
39+
EndSub
40+
41+
42+
' ------------------------------------------------
43+
Sub Label_OnMouseLeave()
44+
_Label = Event.SenderControl
45+
_Label.BackColor = _Color
46+
EndSub
47+

0 commit comments

Comments
 (0)
X Tutup