I have a WinForm in VB.Net with some images at the background which change every 5 seconds by a timer. The problem is that they change immediately and this does not look nice. I would like to add some fade-in effects, but I got the error that opacity is not a property for tableLayout.backgroundimage. I can only fade the form, but that's not what I want.
Here is my code:
Private Sub Timer1_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer1.Tick
If imageNum > 3 Then
imageNum = 1
End If
Select Case imageNum
Case 1
Me.TableLayoutPanel4.BackgroundImage = Global.posta1.My.Resources.Resources.foto1
For FadeIn = 0.0 To 1.1 Step 0.1
Me.Opacity = FadeIn
Threading.Thread.Sleep(100)
Next
rd_btn1.Checked = False
rd_btn2.Checked = True
Case 2
Me.TableLayoutPanel4.BackgroundImage = Global.posta1.My.Resources.Resources.foto3
rd_btn2.Checked = False
rd_btn3.Checked = True
For FadeIn = 0.0 To 1.1 Step 0.1
Me.Opacity = FadeIn
Threading.Thread.Sleep(100)
Next
Case 3
Me.TableLayoutPanel4.BackgroundImage = Global.posta1.My.Resources.Resources.foto2
For FadeIn = 0.0 To 1.1 Step 0.1
Me.Opacity = FadeIn
Threading.Thread.Sleep(100)
Next
rd_btn3.Checked = False
rd_btn1.Checked = True
End Select
imageNum = imageNum + 1
End Sub
As far as I do know it's not possible to set the opacity of a single control, maybe you can do it by drawing the control yourself but you have to research about that because I have no knowledge about drawing controls yourself..
I'm a novice but what I would think would work would be to draw (using the PaintEventArgs argument of the paint event of the control) to do this:
Draw both the old and the new pic.
Lessen the alpha value of the old pic, whilst increasing the new pic's alha value, until they are 0.0, and 1.0
Hope this helped. Sorry if it didn't.
;)
Related
Hello roblox studio scripters,
I'm a intermediate scripter-builder and need some help with the gui for my game.
I have a start screen with a play button like this:
I'm trying to fade out the gui when the button is clicked, but none of the tutorials worked. This is my script for the button:
local button = script.Parent
local gui = script.Parent.Parent.Parent
button.MouseButton1Down:Connect(function()
gui.Enabled = false
end)
I don't know how to do the changing, would it be BackgroundTransparency? How would you change the transparency from 0 to 1 in 0.01 increments?
I tried to make the gui fade with a for loop, changing the BackgroundTransparency but that didn't work, this is that code:
local button = script.Parent
local gui = script.Parent.Parent.Parent
button.MouseButton1Down:Connect(function()
for i = 0, 100, 1 do
gui.Frame.BackgroundTransparency + 0.01
wait(0.01)
gui.Enabled = false
end
end)
I don't know why it isn't working.
If I have a typo or something, please tell me.
Thanks!
The loop solution has a few typos, here it is fixed:
local button = script.Parent
local gui = script.Parent.Parent.Parent
button.MouseButton1Down:Connect(function()
for i = 0, 100 do
gui.Frame.BackgroundTransparency += 0.01 -- += adds 0.01 each time
task.wait(0.01) -- better than wait(0.01)
end
gui.Enabled = false
end)
However, this is not an ideal solution. A better system would use Roblox's TweenService to change the gui's transparency. Tweens are less jittery, are easier to modify, and have lots of customisation properties including repeating, changing length of time, and style of easing (e.g. going faster at first, then slower near the end; see Easing Styles on the Roblox docs).
local TweenService = game:GetService("TweenService")
local button = script.Parent
local gui = script.Parent.Parent.Parent
local tweenInfo = TweenInfo.new(
2, -- Time
Enum.EasingStyle.Linear, -- Easing Style
Enum.EasingDirection.Out -- Easing Direction
-- See https://create.roblox.com/docs/reference/engine/datatypes/TweenInfo for more available properties
)
local tween = TweenService:Create(
gui.Frame, -- Instance to tween
tweenInfo, -- TweenInfo
{ Transparency = 1 } -- What we want to change
)
button.MouseButton1Down:Connect(function()
tween:Play()
tween.Completed:Wait() -- Wait until tween is complete
gui.Enabled = false
end)
Though both of these solutions change only the transparency of the background, so the child elements, such as the Playbutton, will stay visible until the gui is disabled. You may wish to replace the Frame with a CanvasGroup, which also changes the transparency of its children when its GroupTransparency property is changed.
local tween = TweenService:Create(
gui.CanvasGroup, -- Instance to tween
tweenInfo, -- TweenInfo
{ GroupTransparency = 1 } -- What we want to change
)
So I'm trying to make my form fit to all monitors. Some have different display resolution and scale.
I can resize my form to fit to the display but all properties of its contents don't adjust to that new size.
What I want is if the form is scaled to fit to the display, the controls on the Form should adjust as well. Specifically properties like Left, Top, Width, Height, and so one, on every control.
The size could be scaled down or up.
It's possible to iterate through all of the controls on the form (mostly) programmatically, rather than having to explicitly adjust each control. You may have to put in some exceptions for some types of controls (such as timers, which I've put in the example), but generally you can use something like:
Option Explicit
Private Type ControlInfo_type
Left As Single
Top As Single
Width As Single
Height As Single
FontSize As Single
End Type
Dim ControlInfos() As ControlInfo_type
Private Sub Form_Load()
Dim ThisControl As Control
ReDim Preserve ControlInfos(0 To 0)
ControlInfos(0).Width = Me.Width
ControlInfos(0).Height = Me.Height
For Each ThisControl In Me.Controls
ReDim Preserve ControlInfos(0 To UBound(ControlInfos) + 1)
On Error Resume Next ' hack to bypass controls with no size or position properties
With ControlInfos(UBound(ControlInfos))
.Left = ThisControl.Left
.Top = ThisControl.Top
.Width = ThisControl.Width
.Height = ThisControl.Height
.FontSize = ThisControl.FontSize
End With
On Error GoTo 0
Next
End Sub
Private Sub Form_Resize()
Dim ThisControl As Control, HorizRatio As Single, VertRatio As Single, Iter As Integer
If Me.WindowState = vbMinimized Then Exit Sub
HorizRatio = Me.Width / ControlInfos(0).Width
VertRatio = Me.Height / ControlInfos(0).Height
Iter = 0
For Each ThisControl In Me.Controls
Iter = Iter + 1
On Error Resume Next ' hack to bypass controls
With ThisControl
.Left = ControlInfos(Iter).Left * HorizRatio
.Top = ControlInfos(Iter).Top * VertRatio
.Width = ControlInfos(Iter).Width * HorizRatio
.Height = ControlInfos(Iter).Height * VertRatio
.FontSize = ControlInfos(Iter).FontSize * HorizRatio
End With
On Error GoTo 0
Next
End Sub
I tested this with the default form with a CommandButton, Frame, Timer, and TextBox, and it seemed to work OK. You'll probably want to tune the limits on the minimum and maximum sizes for appearance, and my handling of the font is very crude; this could be optimized also. But perhaps this could be a starting point.
This code depends upon the controls iterating the same way each time, which could conceivably break. One way around this would be to use a Collection or other data structure with the name of the control as a key; when iterating in the .Resize event, each control would be looked up by name. Additional structure will be necessary if any of the controls are themselves arrays, and even more if controls are loaded or unloaded dynamically.
I'm trying to export a picture from a PictureBox but the problem is with the height of the exported picture (the width working perfectly).
I also found out that VB6 border have major effect to the size of the exported picture so I set it to 0.
Just open vb6 drop a PictureBox (and rename it to myPic)...
This is my code :
Option Explicit
Private Sub Form_Load()
myPic.AutoRedraw = True
myPic.BorderStyle = 0
myPic.Appearance = 0
myPic.Width = 100 * Screen.TwipsPerPixelX 'WORKING PERFECTLY!!!
myPic.Height = 100 * Screen.TwipsPerPixelY 'NOT RETURN 100px !!! Why ? 93px instead
myPic.ScaleMode = vbPixels
myPic.PaintPicture LoadPicture(App.Path & "\Source.bmp"), 0, 0, 100, 100
myPic.Picture = myPic.Image
SavePicture myPic.Picture, App.Path & "\Exported.bmp"
End Sub
Any Idea ?
Thanks in advance !
I tried your code, and it works as I think you intended: it shows source.bmp in a 100x100 picturebox and exports it into a bmp of 100x100 pixels
The code I uses is:
Option Explicit
Private Sub Form_Load()
With Picture1
.AutoRedraw = True
.ScaleMode = vbPixels
.BorderStyle = 0
.Appearance = 0
.Width = 100 * Screen.TwipsPerPixelX 'WORKING PERFECTLY!!!
.Height = 100 * Screen.TwipsPerPixelY 'NOT RETURN 100px !!! Why ? 93px instead
.PaintPicture LoadPicture("c:\temp\Source.bmp"), 0, 0, 100, 100
.Picture = .Image
SavePicture .Picture, "c:\temp\Exported.bmp"
End With 'Picture1
End Sub
I just put the .Scalemode to the top as I think that is where it belongs, but your code also works with .Scalemode where you had it.
Could you please add the picture you are trying to rescale?
For the source I used the picture below, which is 300x300 pixels:
And the result was:
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
When I try to google it for 3 days, I found that there is only 1 picture/image available in 1 picbox. My goal is to display multiple images, and they cannot overlap. If they overlap, there a red colour should be shown.
I'm using VB6. I'm using 1 combobox1, for select image n 1 commandbutoon. but when I select 2nd image in click button, the image on picbox will auto overwrite it. Is it caused by .cls ??
Private Sub Combo1_Click()
Dim pin As String
Dim intx As Integer
If UCase$(Combo1.List(intx)) = UCase$(pin) Then
Combo1.ListIndex = intx
End If
End Sub
Private Sub Command1_Click()
If Combo1.ListIndex = 0 Then
Set mPic = pin8.Image
ElseIf Combo1.ListIndex = 1 Then
Set mPic = pin12.Image
Else
Set mPic = pin16.Image
End If
mPicWidth = Me.ScaleX(mPic.Width, vbHimetric, Picture1.ScaleMode)
mPicHeight = Me.ScaleY(mPic.Height, vbHimetric, Picture1.ScaleMode)
ShowPictureAtPosition mLeft, mTop
End Sub
Thank you.
Best regard,
chan
Look, The only way to do that is to add 2 images as resources in the project then make one is the default picture or leave it blank as you wish.
The process now is when you click on the command button you switch between the two pictures.
Button Code:
if
PictureBox1.Image = My.Resources.<Name_of_res_file>.<Name_of_image1111_resource>
Then
PictureBox1.Image = My.Resources.<Name_of_res_file>.<Name_of_image2222_resource>
Else
PictureBox1.Image = My.Resources.<Name_of_res_file>.<Name_of_image1111_resource>
End If
This will switch between the 2 pictures. Hope this helps you.