I have programmed a traffic light on visual basic 6.0 but I cant seem to program the countdown(10-0) to be on infinite loop at every light i.e it should countdown from 10 to 0 before each light shows.
Here is my code
Private Sub Timer2_Timer()
If Label1. Caption = 0 Then
Timer2.Enabled = False
MsgBox ("go")
Else
Label1. Caption = Label1. Caption - 1
End If
End Sub
the countdown continues to 1,-2,-3,-4 and so on but I want it to start from 10 again after counting from 10 to 0. How do I put it on endless loop on visual basic 6.0
Instead of:
Timer2.Enabled = False
do something like:
Label1.Caption = 10
That way the timer will keep running forever, and will reset to 10 every time it reaches 0.
Also, to make the code a little more robust, you might take this approach:
Private Const maxCounter As Integer = 10
Private counter As Integer
Private Sub form_Load()
counter = maxCounter
End Sub
Private Sub Timer2_Timer()
If counter = 0 Then
counter = maxCounter
MsgBox ("go")
Else
counter = counter - 1
End If
Label1.Caption = counter
End Sub
One advantage is that your code does not depend on how you set the Caption property at design time. And secondly it is a little more modular and understandable in that the functional logic (how the counter is managed) and the display logic (how the caption is set) are mostly distinct.
Also, using a constant maxCounter just means you don't have to repeat the value in different places, and it can be changed easily without introducing discrepencies.
Obviously this is a small program but these are good programming principles to think about which benefit larger programs tremendously.
Related
I'm new to programming in LUA, although I've learned similar languages like JS. It's frustrating if I have to alter the same script in many parts in a group by replacing each script, and I don't know of an elegant way to do it. Instead, I decided to nest all the parts inside of the script. I've seen some examples and I've tried to adapt some of them, but they don't exactly apply to what I want to do and I can't get them to work.
In essence, what I'm trying to do is monitor all the bricks for a player to contact them. I took the original disappearing brick script that was nested inside each brick and modified it. If a part (brick) is touched, that should call the onTouch function, which will make the brick's transparency decrease over time until the in pairs loop is done, after which the brick disappears and CanCollide is turned off. After 2 seconds, it then returns back to normal. I think the problem is with the coding I used to monitor the parts as I don't really understand the right way to monitor multiple objects. Can someone please help? Thanks!
File structure:
function onTouched(brick)
local delay = .1 -- the delay between each increase in transparency (affects speed of disappearance)
local RestoreDelay = 2 -- delay before the brick reappears
local inc = .1 -- how much the brick disappears each time
-- All characters have a Humanoid object
-- if the model has one, it is a character
local h = script.Child:findFirstChild("Humanoid") -- Find Humanoids in whatever touched this
if (h ~=nil) then -- If there is a Humanoid then
h.Health = h.MaxHealth -- Set the health to maximum (full healing)
for x=0,1, inc do
script.Child.Transparency = x+inc
script.Child.CanCollide = true
wait(delay)
end
wait(delay)
script.Child.Transparency = 1
script.Child.CanCollide = false
wait(RestoreDelay)
script.Child.Transparency = 0
script.Child.CanCollide = true
else
end
end
while true do
local bricks=script:GetChildren():IsA("basic.part")
for x=1,brick in pairs(bricks) do
brick.Touched:connect(onTouched(brick)) -- Make it call onTouched when touched
end
end
end
For the most part, you've gotten it right, but you've got a few syntax errors where there are different conventions between JavaScript and Lua.
In JS, you would fetch an array of objects and then bee able to filter it immediately, but in Lua, there is limited support for that. So a JavaScript line like :
var bricks = script.GetChildren().filter(function(item) {
return item === "basic.part"
})
cannot be done all in one line in Lua without assistance from some library. So you'll need to move the check into the loop as you iterate over the objects.
Other than that, the only other thing to change is the onTouched handler's function signature. The BasePart.Touched event tells you which object has touched the brick, not the brick itself. But by creating a higher order function, it's easy to get access to the brick, and the thing that touched it.
-- create a helper function to access the brick and the thing that touched it
function createOnTouched(brick)
-- keep track whether the animation is running
local isFading = false
return function(otherPart)
-- do not do the animation again if it has already started
if isFading then
return
end
local delay = .1 -- the delay between each increase in transparency (affects speed of disappearance)
local restoreDelay = 2 -- delay before the brick reappears
local inc = .1 -- how much the brick disappears each time
-- All characters have a Humanoid object, check for one
local h = otherPart.Parent:FindFirstChild("Humanoid")
if h then
-- heal the player
h.Health = h.MaxHealth
-- start fading the brick
isFading = true
brick.CanCollide = true
for i = 0, 1, inc do
brick.Transparency = i
wait(delay)
end
-- turn off collision for the brick
wait(delay)
brick.Transparency = 1
brick.Anchored = true
brick.CanCollide = false
-- turn the part back on
wait(restoreDelay)
brick.Transparency = 0
brick.CanCollide = true
-- reset the animation flag
isFading = false
end
end
end
-- loop over the children and connect touch events
local bricks = script:GetChildren()
for i, brick in ipairs(bricks) do
if brick:IsA("BasePart") then
local onTouchedFunc = createOnTouched(brick)
brick.Touched:Connect(onTouchedFunc)
end
end
I am very new to VB and to gain more experience I'm trying to build a calculator. I have it in a working form but would like to enable the number pad keys to input the number to a label. I've tried searching but no luck. All the info I've seen is old which may be why its not working. If you can help that would be great! Thanks!
Ok, I have found and modified this code and it got me a step further by printing the number to the label but now I cannot figure out how enter a row of numbers. After each keydown it removes the previous keyed number to replace with the new number. Any suggestions?
Code:
Sub Calculator_KeyPress(ByVal sender As Object, ByVal e As KeyPressEventArgs) Handles Me.KeyPress
If e.KeyChar >= ChrW(48) And e.KeyChar <= ChrW(57) Then
Label1.Text = e.KeyChar.ToString()
End If
End Sub
I'm surly need some sleep I should have known this.. Since there is many people out there looking for this answer I'm just going to leave it up.
CORRECT CODE:
Sub Calculator_KeyPress(ByVal sender As Object, ByVal e As KeyPressEventArgs) Handles Me.KeyPress
If e.KeyChar >= ChrW(48) And e.KeyChar <= ChrW(57) Then
Label1.Text = Label1.Text + e.KeyChar.ToString()
End If
End Sub
I am running the below code 400 times. I have 60 charts on the sheet. Execution time is 300 sec. If I remove this line
minVal = 0.02 * (cht.Chart.Axes(xlValue).MaximumScale - cht.Chart.Axes(xlValue).MinimumScale)
the speed improves to 190 seconds. This line impacts nothing given minVal is overwritten by 0 right after (for the purpose of the test). I am looking to understand why accessing the axis of the chart is so time consuming and for a workaround.
Sub quickAdjustLabels()
Dim cht As Excel.ChartObject
For Each cht In ActiveSheet.ChartObjects
isProdChart = 0
If cht.Chart.SeriesCollection(1).ChartType <> 5 Then 'different from pie
minVal = 0.02 * (cht.Chart.Axes(xlValue).MaximumScale - cht.Chart.Axes(xlValue).MinimumScale)
minVal = 0
For Each myCollection In cht.Chart.SeriesCollection
'if Stack and if not white visible (white visible are the bottom of waterfall charts / white unvisible are the NC stacks) => remove label is too small
If (myCollection.ChartType = xlColumnStacked Or myCollection.ChartType = xlColumnStacked100) And (myCollection.Format.Fill.Visible = msoFalse Or myCollection.Format.Fill.ForeColor.RGB <> 16777215) Then
myCollection.ApplyDataLabels
vals = myCollection.Values
For i = LBound(vals) To UBound(vals)
If Abs(vals(i)) < minVal Then myCollection.Points(i).HasDataLabel = False
Next
End If
If myCollection.Name = Range("Client") Then isProdChart = 1 'Identify productivity charts
Next myCollection
'Remove labels on productivity charts
If isProdChart = 1 Then
For Each myCollection In cht.Chart.SeriesCollection
If myCollection.ChartType = xlColumnStacked Then myCollection.DataLabels.Delete
Next
End If
End If
Next cht
End Sub
Your problem is not the statement that you pointed out, but actually the statements that apply the DataLabels:
myCollection.ApplyDataLabels
myCollection.Points(i).HasDataLabel = False
Setting the DataLabels take longer time the more points you have in your graph. So trying to avoid running these commands unnecessarily could potentially save you some time. Before setting the values, verify that it is necessary to change them
If Not myCollection.HasDataLabels Then
myCollection.ApplyDataLabels
End If
For i = LBound(Vals) To UBound(Vals)
shouldHaveLabel = True
If Abs(Vals(i)) < MinVal Then
shouldHaveLabel = False
End If
If myCollection.Points(i).HasDataLabel <> shouldHaveLabel Then
myCollection.Points(i).HasDataLabel = shouldHaveLabel
End If
Next
I hope this helps you.
I came to this conclusion by running your code on one of my excel-files with 56 graphs.
I added a time-measure that would tell me at the end of the execution how long time it took to execute, and ran it over and over again, commenting out different blocks of code until I could pinpoint which block was the one taking long time.
Dim tm As Date
tm = Now() 'get timestamp when execution started
...here goes the code to measure...
Debug.Print(Now()-tm)*24*60*60 'Show how many seconds execution took
I have tried a coding that contains a loop to display 1 to 1000 numbers in combo box. I am just a learner to Visual Basic. So I can't able to make that through coding. The coding is as follows:
Private Sub Combo1_change()
Dim a As Integer
While (a <= 1000)
Combo1.AddItem(a, [1]) = a
a=a+1
Wend
End Sub
I have experienced "no error" but none of the number is displayed in the combo box while running. Please, help me by modifying the above code or redirecting me to any other method of inserting elements in combo box.
The Combo1_Change event is definitely not the place you should be looking. That event is fired when the text in the combo is changed. Try the Form_Load event instead:
Private Sub Form_Load()
Dim a As Integer
For a = 1 To 1000
Combo1.AddItem a
Next
End Sub
Please note, a combo with 1000 items isn't the best user experience.
I've got a timer set up to detect if the mouse is over a certain area on my form, which you can imagine to be a rectangle starting at 50,50 (pixels) and ending at 1000,500. If the mouse is inside that rectangle, a second window pops up that acts somewhat like a tooltip, following the mouse around. The problem is that the menus at the top drape over this rectangle, and if you try to use a menu, the second window pops up (the timer sets its visible property to true) as soon as you move down the menu, which ends up closing the menu (I guess due to a loss of focus or something.)
If I can detect when one of the menus is open, I can disable the showing of the tooltip window with an if statement, but I don't know how to do that.
I think I've figured out how to do this by searching WIN32API.txt for "menu" and a little bit of googling, but I'm not really sure. Perhaps this solution only works on my machine.
Putting this code...
Dim hMenu As Long
hMenu = GetMenu(Form1.hwnd)
MsgBox GetMenuState(hMenu, 0, MF_BYPOSITION)
on a timer with an interval of 5000 allows you to the view the menu's state. In a closed state, the number appears to be random (1552, 1296, etc.,) but when the menu is opened, it is offset by 128 from this base value. A menu whose state is 1552 when closed is 1680 when open.
I'm not sure why it's offset by 128 or if this works on all machines (just to be safe, I will program it to check for inequality, not offset by 128), but it appears to be working for me.
If there is a problem with this solution or if there is a better way, please respond with another answer, and I'll be glad to give you credit for the answer instead.
Written by SBEIH Iyad - Syria - Damascus. 4/1/2021.
Using VB6.0, we can.
We check all menus windows if one is opened, it means: menu is opened.
we use API "GetMenu" for hWnd of main-menu,
then with the API "GetMenuState" we check if one of menus is opened.
Vb6.0 CODE:
Private Function GetBit_I(ByVal X As Long, ByVal i As Integer) As Integer
' Get the bit number i of X.
GetBit_I = (X And (2 ^ i)) / (2 ^ i)
End Function
Private Function MainMenuIsOpened(FRM As Form) As Boolean
Const MF_BYPOSITION = 1024
Dim H As Long, i As Integer, L As Long, MCount As Long
MainMenuIsOpened = False
On Error GoTo MainMenuIsOpenedError
H = GetMenu(FRM.HWnd)
MCount = GetMenuItemCount(H)
' MCount is the number of main-menus.
Do While (i < MCount)
L = GetMenuState(H, i, MF_BYPOSITION)
If ((L > -1) And (GetBit_I(L, 7) = 1)) Then
MainMenuIsOpened = True
Exit Do
End If
i = i + 1
Loop
Exit Function
MainMenuIsOpenedError:
MainMenuIsOpened = False
End Function
Good luck.