I am new to using VB6 and I do it only because I have a project which created since 25 years ago.
I need to limit the size of a form, specifically MinWidth and MaxHeight.
I there any Property which can make me do that, like in WinForms or WPF?
example:
FormName.MinWidth =1000;
I tried this but not working correctly:
If W < 7399 Then
W = 7400
Enabled = False
DoEvents: DoEvents
Enabled = True
ElseIf W >= 7400 Then
W = cmdSelect.Width
DoEvents: DoEvents
Enabled = True
End If
The general approach would be to respond to the Form_Resize event.
Option Explicit
Private Const MINWIDTH As Single = 1000
Private Const MAXHEIGHT As Single = 6000
Private Sub Form_Resize()
If Me.WindowState = vbMinimized Then Exit Sub
If Me.Width < MINWIDTH Then Me.Width = MINWIDTH
If Me.Height > MAXHEIGHT Then Me.Height = MAXHEIGHT
End Sub
Related
Screenshot
In the above form, I have an SSTab. The Add Characteristics button is an added control to create rows of characteristics. On click of this button, I can keep adding Dynamic controls (Checkbox, Label, Text, Combobox and other controls.) Now I want to capture the Action. for Example, change of Text in Combobox or Change in CheckBox Status. I am not able to trap the Event to identify which control and what code will help me capture the action of a Dynamic Control (on the first Tab)
Can some one help me with a good solution? I have been desperately searching for over a month and have not got a solution so far.
Let me know how I can send the VB code as a ZIP file for reference over email.
Expectation:
1. I should be able to capture delete Row change in the check box
2. I should be able to capture changes in Combo box
Static Controls:
1. Form: frmcharacteristics
2. Button: cmdAddCharacteristics
3. SSTab: tabDisplay
Code in Module1:
Public SR_NO As Long
Public Top_Position As Long
code in frmCharacterisitcs:
Option Explicit
Dim WithEvents Ch_Delete_Row As CheckBox
Dim WithEvents Ch_SR_NO As Label
Dim WithEvents Ch_Name As TextBox
Dim WithEvents Ch_Type As ComboBox
Dim WithEvents Extended_Control As VBControlExtender
Private Sub cmdAddCharacteristics_Click()
Module1.SR_NO = Module1.SR_NO + 1
Set Ch_Delete_Row = frmCharacteristics.Controls.Add("VB.CheckBox", "Ch_Delete_Row" & (Module1.SR_NO), tabDisplay)
Ch_Delete_Row.Visible = True
Ch_Delete_Row.Top = Module1.Top_Position + 100
Ch_Delete_Row.Width = 1000
Ch_Delete_Row.Left = 500
Ch_Delete_Row.Caption = ""
Ch_Delete_Row.Height = 315
'MsgBox Ch_Delete_Row.Name
Set Ch_SR_NO = frmCharacteristics.Controls.Add("VB.Label", "Ch_SR_NO" & (Module1.SR_NO), tabDisplay)
Ch_SR_NO.Visible = True
Ch_SR_NO.Top = Module1.Top_Position + 200
Ch_SR_NO.Width = 750
Ch_SR_NO.Left = Ch_Delete_Row.Left + Ch_Delete_Row.Width + 400
Ch_SR_NO.Caption = Module1.SR_NO
Ch_SR_NO.Height = 315
Set Ch_Name = frmCharacteristics.Controls.Add("VB.TextBox", "Ch_Name" & (Module1.SR_NO), tabDisplay)
Ch_Name.Visible = True
Ch_Name.Top = Module1.Top_Position + 100
Ch_Name.Width = 2000
Ch_Name.Left = Ch_SR_NO.Left + Ch_SR_NO.Width + 200
Ch_Name.Text = ""
Ch_Name.Height = 315
Set Ch_Type = frmCharacteristics.Controls.Add("VB.ComboBox", "Ch_Type" & (Module1.SR_NO), tabDisplay)
Ch_Type.Visible = True
Ch_Type.Top = Module1.Top_Position + 100
Ch_Type.Width = 1500
Ch_Type.Left = Ch_Name.Left + Ch_Name.Width + 50
Ch_Type.Text = ""
'Ch_Type.Height = 315
Ch_Type.AddItem "Service"
Ch_Type.AddItem "Special"
Ch_Type.AddItem "Option"
Module1.Top_Position = Module1.Top_Position + 400
End Sub
Private Sub Form_Load()
Module1.SR_NO = 0
Dim Test_Line As Control
Set Test_Line = frmCharacteristics.Controls.Add("VB.Line", "LINE", frmCharacteristics)
Test_Line.Visible = True
Test_Line.X1 = 100
Test_Line.Y1 = 600
Test_Line.X2 = frmCharacteristics.Width
Test_Line.Y2 = 600
Top_Position = Test_Line.Y1
frmCharacteristics.Show
tabDisplay.Width = frmCharacteristics.Width - 1000
tabDisplay.Height = frmCharacteristics.Height - 1500
tabDisplay.Left = frmCharacteristics.Left + 200
Call set_labels
End Sub
Sub set_labels()
Dim Label_SR_NO As Control
Dim Label_Name As Control
Dim Label_Delete_Row As Control
Dim Label_Type As Control
Set Label_Delete_Row = frmCharacteristics.Controls.Add("VB.Label", "Label_Delete_Row" & (Module1.SR_NO), tabDisplay)
Label_Delete_Row.Visible = True
Label_Delete_Row.Top = Module1.Top_Position + 100
Label_Delete_Row.Width = 1000
Label_Delete_Row.Left = 300
Label_Delete_Row.Caption = "Delete(Y/N)"
Label_Delete_Row.Height = 315
Set Label_SR_NO = frmCharacteristics.Controls.Add("VB.Label", "Label_SR_NO" & (Module1.SR_NO), tabDisplay)
Label_SR_NO.Visible = True
Label_SR_NO.Top = Module1.Top_Position + 100
Label_SR_NO.Width = 750
Label_SR_NO.Left = Label_Delete_Row.Left + Label_Delete_Row.Width + 400
Label_SR_NO.Caption = "SR_NO"
Label_SR_NO.Height = 315
Set Label_Name = frmCharacteristics.Controls.Add("VB.Label", "Label_Name" & (Module1.SR_NO), tabDisplay)
Label_Name.Visible = True
Label_Name.Top = Module1.Top_Position + 100
Label_Name.Width = 2000
Label_Name.Left = Label_SR_NO.Left + Label_SR_NO.Width + 400
Label_Name.Caption = "Characteristics Name"
Label_Name.Height = 315
Set Label_Type = frmCharacteristics.Controls.Add("VB.Label", "Label_Type" & (Module1.SR_NO), tabDisplay)
Label_Type.Visible = True
Label_Type.Top = Module1.Top_Position + 100
Label_Type.Width = 1500
Label_Type.Left = Label_Name.Left + Label_Name.Width + 50
Label_Type.Caption = "Charac. Type"
Label_Type.Height = 315
Module1.Top_Position = Module1.Top_Position + 400
End Sub
i would like create a rectangle in a different picture.
For example: the code is inside testpicture, but i would like that this rect is create in testpicture2.
How is possible please ?
Thank you very much
The solution...
Private Sub GenerateRuntimeForm()
Dim ctrl As Control
Set frm = New Form1
Set cmdOK = Nothing
Set cmdCancel = Nothing
Set txtInput = Nothing
Set lblDisplay = Nothing
'clear the form
For Each ctrl In frm
ctrl.Visible = False
Next
Set cmdOK = frm.Controls.Add("VB.CommandButton", "cmdOK")
Set cmdCancel = frm.Controls.Add("VB.CommandButton", "cmdCancel")
Set txtInput = frm.Controls.Add("VB.TextBox", "txtInput")
Set lblDisplay = frm.Controls.Add("VB.Label", "lblDisplay")
With frm
'Set form's width and height
.Width = 4000
.Height = 2500
.Caption = "Run-Time Generated Form"
End With
'Setup rest of controls
With lblDisplay
.Top = 250
.Left = 250
.AutoSize = True
.FontBold = True
.Caption = IIf(allowNumericOnly, "Enter Your Age:", "Enter Your Last Name:")
End With
With txtInput
.Top = lblDisplay.Top + lblDisplay.Height + 250
.Left = 250
.Height = 295
If allowNumericOnly Then
.Width = 500
.MaxLength = 3
Else
.Width = 2500
End If
End With
With cmdOK
.Top = txtInput.Top + txtInput.Height + 375
.Width = 800
.Left = 1000
.Height = cmdGenerate(0).Height
cmdOK.Caption = "&OK"
.Enabled = False
End With
With cmdCancel
.Left = cmdOK.Left + cmdOK.Width + 100
.Top = cmdOK.Top
.Width = cmdOK.Width
.Height = cmdOK.Height
.Caption = "&Cancel"
End With
cmdOK.Visible = True
cmdCancel.Visible = True
lblDisplay.Visible = True
txtInput.Visible = True
frm.Show vbModal
End Sub
I have created a simple form in VB6, and added a simple, blank user control. The only code are Debug.Print statements in all major events.
For some reason, when the form is closed, the order of events in the User Control are:
Terminate
Initialize
Read Properties
Resize
Why is this happening? Why are Initialize, ReadProperties and Resize called after Terminate? I could not find any evidence of this in Microsoft documentation.
EDIT:
Here is the code.
User control:
VERSION 5.00
Begin VB.UserControl UserControl1
ClientHeight = 3600
ClientLeft = 0
ClientTop = 0
ClientWidth = 4800
ScaleHeight = 3600
ScaleWidth = 4800
End
Attribute VB_Name = "UserControl1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Private Sub UserControl_Initialize()
Debug.Print "Initialize"
End Sub
Private Sub UserControl_InitProperties()
Debug.Print "InitProperties"
End Sub
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
Debug.Print "ReadProperties"
End Sub
Private Sub UserControl_Resize()
Debug.Print "Resize"
End Sub
Private Sub UserControl_Show()
Debug.Print "Show"
End Sub
Private Sub UserControl_Terminate()
Debug.Print "Terminate"
End Sub
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
Debug.Print "WriteProperties"
End Sub
Form:
VERSION 5.00
Begin VB.Form Form1
Caption = "Form1"
ClientHeight = 3030
ClientLeft = 120
ClientTop = 450
ClientWidth = 4560
LinkTopic = "Form1"
ScaleHeight = 3030
ScaleWidth = 4560
StartUpPosition = 3 'Windows Default
Begin Project1.UserControl1 UserControl1
Height = 2535
Left = 240
TabIndex = 0
Top = 240
Width = 4095
_extentx = 7223
_extenty = 4471
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Debug.Print means your running this in debug mode in the IDE.
When debugging you would see a Terminate when the form unloads, you then see the reinitialisation of the User Control as its re-loaded in the Form in the Form Designer for editing.
This won't happen from a compiled EXE, you can replace Debug.Print with MsgBox to verify this.
I have below macro.
Could you please modify it in such ways that it will show slide number on the top and also extract notes page.
I tried all ways but couldn't get answer-:
Sub WriteToWord()
Dim aSlide As Slide, MyDoc As New Word.Document, MyRange As Word.Range
Dim aTable As Table, aShape As Shape, TablesCount As Integer, ShapesCount As Integer
Dim i As Word.Paragraph
On Error Resume Next
With MyDoc
.Application.Visible = False
.Application.ScreenUpdating = False
For Each aSlide In ActivePresentation.Slides
For Each aShape In aSlide.Shapes
Set MyRange = .Range(.Content.End - 1, .Content.End - 1)
Select Case aShape.Type
Case msoAutoShape, msoPlaceholder, msoTextBox
If aShape.TextFrame.HasText Then
aShape.TextFrame.TextRange.Copy
MyRange.Paste
With MyRange
.ParagraphFormat.Alignment = wdAlignParagraphLeft
For Each i In MyRange.Paragraphs
If i.Range.Font.Size >= 16 Then
i.Range.Font.Size = 14
Else
i.Range.Font.Size = 12
End If
Next
End With
End If
Case msoPicture
aShape.Copy
MyRange.PasteSpecial DataType:=wdPasteMetafilePicture
ShapesCount = .Shapes.Count
With .Shapes(ShapesCount)
.LockAspectRatio = msoFalse
.Width = Word.CentimetersToPoints(14)
.Height = Word.CentimetersToPoints(6)
.Left = wdShapeCenter
.ConvertToInlineShape
End With
.Content.InsertAfter Chr(13)
Case msoEmbeddedOLEObject, msoLinkedOLEObject, msoLinkedPicture, msoOLEControlObject
aShape.Copy
MyRange.PasteSpecial DataType:=wdPasteOLEObject
ShapesCount = .Shapes.Count
With .Shapes(ShapesCount)
.LockAspectRatio = msoFalse
.Width = Word.CentimetersToPoints(14)
.Height = Word.CentimetersToPoints(6)
.Left = wdShapeCenter
.ConvertToInlineShape
End With
.Content.InsertAfter Chr(13)
Case msoTable
aShape.Copy
MyRange.Paste
TablesCount = .Tables.Count
With .Tables(TablesCount)
.PreferredWidthType = wdPreferredWidthPercent
.PreferredWidth = 100
.Range.Font.Size = 11
End With
.Content.InsertAfter Chr(13)
End Select
Next
If aSlide.SlideIndex < ActivePresentation.Slides.Count Then .Content.InsertAfter Chr(12)
.UndoClear ' Clear used memory
Next
' Change white font to black color
With .Content.Find
.ClearFormatting
.Format = True
.Font.Color = wdColorWhite
.Replacement.Font.Color = wdColorAutomatic
.Execute Replace:=wdReplaceAll
End With
MsgBox "PPT Converted to WORD completed, Please check and save document", vbInformation + vbOKOnly, "ExcelHome/ShouRou"
.Application.Visible = True
.Application.ScreenUpdating = True
End With
End Sub
Sub Auto_Open() ' Add PPTtoWord to Tool Bar when Powerpoint start
Dim MyControl As CommandBarControl
On Error Resume Next
Application.CommandBars("Standard").Controls("PPTtoWord").Delete
Set MyControl = Application.CommandBars("Standard").Controls.Add(Before:=1)
With MyControl
.Caption = "PPTtoWord"
.FaceId = 567 ' Word Icon
.Enabled = True
.Visible = True
.Width = 100
.OnAction = "WriteToWord"
.Style = msoButtonIconAndCaption
End With
End Sub
Sub Auto_Close() ' Delete PPTtoWord from Tool Bar when Powerpoint close
On Error Resume Next
Application.CommandBars("Standard").Controls("PPTtoWord").Delete
End Sub
You are running this from Word and automating PowerPoint using early binding, you need to fully qualify any PowerPoint reference.
Have you added a reference to PowerPoint library.
Change to aShape As PowerPoint.Shape
Grab the reference to the running instance of PowerPoint. PowerPoint is single instance multi-use so you can use this.
Dim PPT as PowerPoint.Application
Set PPT = CreateObject("PowerPoint.Application")
Fully qualify all references to ActivePresentation with PPT.ActivePresentation
Your macro should run then and generate something so that you can continue debugging.
I'm making an application where I need "enemies" to pace back and forth, how would I automatically move the picture from left to right and repeat?
Heres my current code.
Private Sub Timer1_Timer()
enemy1.Left = enemy1.Left - 5
End Sub
Option Explicit
Const nTwipsPerMove = 15
Private Sub Timer1_Timer()
Static strDirection As String
If strDirection = "" Then strDirection = "left"
If enemy.Left > 0 Then
If strDirection = "left" Then
enemy.Left = enemy.Left - nTwipsPerMove
ElseIf strDirection = "right" Then
enemy.Left = enemy.Left + nTwipsPerMove
End If
End If
If enemy.Left = 0 Then
If strDirection = "left" Then strDirection = "right"
enemy.Left = enemy.Left + nTwipsPerMove
End If
If enemy.Left + enemy.Width = Me.Width - nTwipsPerMove * 5 Then
If strDirection = "right" Then strDirection = "left"
enemy.Left = enemy.Left - nTwipsPerMove
End If
End Sub
nTwipsPerMove means how many twips to move in each loop
Timer1.Interval = 10
I'm admitting right now that my VB is rusty. Been about 10 years since I've used it. I don't have anyway to test this code, but I think this sample should get you close, or at least get you pointed in the right direction.
Private Sub Timer1_Timer()
Do
enemy1.Left = enemy1.Left - 5
If enemy1.Left = < 5 Then
Do
enemy1.Right = enemy1.Right + 5
Loop Until enemy1.Right = > 1000 'or whatever your size is
End If
Loop
End Sub
you can also use 1 variable for its speed, and make it negative when the enemy has to move the other way
'1 form with :
' 1 timer : name=Timer1
' 1 picturebox : name=Picture1
Option Explicit
Private msngStep As Single
Private Sub Form_Load()
Timer1.Interval = 200 'delay in milliseconds between steps
msngStep = ScaleWidth / 20 'step size, and direction
End Sub
Private Sub Timer1_Timer()
Dim sngX As Single
With Picture1 'the enemy
sngX = .Left + msngStep 'calculate new position
If (sngX < 0) Or (sngX > (ScaleWidth - .Width)) Then 'check boundary
msngStep = msngStep * -1 'adjust direction
sngX = sngX + 2 * msngStep 'keep enemy inside
End If
.Left = sngX 'move to new position
End With 'Picture1
End Sub
VB (like C#) should have a built in Timer object. Using the timer you should be able to create a event handler that is triggered after a set amount of time, in that function you can move the picture and restart the timer if you still need it.