Check self visibility from inside user control - vb6

How do I self-test the visibility of a user control?
There is no UserControl.visible or similar property.

You need to cast the userControl to VBControlExtender
Dim oVBControlExtender As VBControlExtender
Set oVBControlExtender = UserControl.Extender
If oVBControlExtender.Visible = True Then
'Code Here
EndIf

Related

Can I go below a VB6 TextBox control's minimum height enforced by the used font?

I have a TextBox control restricted to numeric input. Its font is Arial, Standard, 10 pt. The container's ScaleMode is set to pixels.
Since the textbox will accept and display only numbers, I do not need all that whitespace around, especially not in the vertical dimension, so I resize the TextBox' height in the designer. My goal is a 20 pixels tall TextBox control.
Attempting to set the Height property in the property window snaps the height to 24 pixels.
It is obvious, that the control's height is enforced by the used font. Using Arial, Standard, 7 pt., I can have my desired height of 20 px. Only that I need a font size of 10 pt.
When using the mouse, resizing works in the designer (for example can I achieve 19 pixels). But at run-time, the height is back to 24 pixels.
I've tried to trick VB in the Initialize event by first giving it a small font, sizing the height, then reset the font size to the original. Nope, 24 pixels.
I also tried to use Window's API function MoveWindow. The box displays at 24 pixels.
Is there any other possibly helpful API function, or is my only possibility to write an own VB user control? (I can make a user control consisting of a TextBox control as its only constituent control, then place its Top into the negative, and the user control's height to the desired height.)
Ok, so I went the stony road and created a user control suitable for me. Should you have the same problem, then this one solves it.
Add a new project of type ActiveX user control. Name the user control UTextBox. Modify the user control's font to what we want (Arial, Standard, 10 pt.), and set its ScaleMode property to pixels. Save the 2 files into a new project folder.
Place a TextBox control at position 0, 0 of the user control, and name it cTextBox. Then the whole core functionality is contained in the Resize event.
Option Explicit
'==============================================================================
'On resizing the control.
'------------------------------------------------------------------------------
Private Sub UserControl_Resize()
Dim lHeightDiff As Long
With cTextBox
'Let the TextBox control inherit the user control's new dimensions.
.Height = UserControl.ScaleHeight
.Width = UserControl.ScaleWidth
'The text box is always centered vertically on the same-sized or smaller
'user control, so that the text still is displayed also when the
'TextBox is larger than the user control's height.
.Top = (UserControl.ScaleHeight - .Height) / 2
End With
End Sub
'==============================================================================
Next is the tedious task to pass to and from the text box control all properties, methods and events, or at least all those you are interested in.
'==============================================================================
'Pass-through properties. Keep it alphabetical.
'------------------------------------------------------------------------------
Public Property Let Alignment(NewAlignment As AlignmentConstants)
cTextBox.Alignment = NewAlignment
PropertyChanged "Alignment"
End Property
'------------------------------------------------------------------------------
Public Property Get Alignment() As AlignmentConstants
Alignment = cTextBox.Alignment
End Property
'------------------------------------------------------------------------------
Public Property Let Enabled(NewState As Boolean)
cTextBox.Enabled = NewState
PropertyChanged "Enabled"
End Property
'------------------------------------------------------------------------------
Public Property Get Enabled() As Boolean
Enabled = cTextBox.Enabled
End Property
'------------------------------------------------------------------------------
Public Property Get hWnd() As Long 'Read-only.
hWnd = cTextBox.hWnd
End Property
'------------------------------------------------------------------------------
Public Property Let Text(NewText As String)
cTextBox.Text = NewText
PropertyChanged "Text"
End Property
...
'==============================================================================
There are (at least) two special properties which should be intercepted and applied onto the user control itself: Appearance and BorderStyle, because the text box can be placed outside the user control and would make these properties partially invisible. For these 2 properties, I was not able to locate their enumerations as shown in the property window, and consequently rolled own ones (there exists a naming convention, use your own names if you wish):
'==============================================================================
'Enumerations.
'------------------------------------------------------------------------------
'Used with the public Appearance property.
Public Enum ETxB_Appearance
TxBApp_2D = 0&
TxBApp_3D = 1&
End Enum
'------------------------------------------------------------------------------
'Used with the public BorderStyle property.
Public Enum ETxB_BorderStyle
TxBBSt_None = 0&
TxBBSt_FixedSingle = 1&
End Enum
'==============================================================================
These are the 2 special properties:
'==============================================================================
'All properties, methods and events which are currently needed are mediated
'to and from the outside world and the TextBox control, with the exception of
'BorderStyle and Appearance, which are properties of the user control, so that
'a frame can be displayed even when it would not fit into the TextBox control.
'------------------------------------------------------------------------------
Public Property Let Appearance(NewAppearance As ETxB_Appearance)
UserControl.Appearance = NewAppearance
PropertyChanged "Appearance"
End Property
'------------------------------------------------------------------------------
Public Property Get Appearance() As ETxB_Appearance
Appearance = UserControl.Appearance
End Property
'------------------------------------------------------------------------------
Public Property Let BorderStyle(NewStyle As ETxB_BorderStyle)
UserControl.BorderStyle = NewStyle
PropertyChanged "BorderStyle"
End Property
'------------------------------------------------------------------------------
Public Property Get BorderStyle() As ETxB_BorderStyle
BorderStyle = UserControl.BorderStyle
End Property
'==============================================================================
Now do the same for all methods.
And now for all events (and of course you need to add Event declarations as well.)
Finally, don't let's forget to happily code the property bag routines to make your user control have persistent properties.
'==============================================================================
'Initializing properties.
'------------------------------------------------------------------------------
Private Sub UserControl_InitProperties()
UserControl.Appearance = TxBApp_2D
...
cTextBox.Alignment = vbLeftJustify
...
End Sub
'==============================================================================
'==============================================================================
'Reading properties.
'------------------------------------------------------------------------------
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
With PropBag
UserControl.Appearance = .ReadProperty("Appearance", TxBApp_2D)
...
cTextBox.Alignment = .ReadProperty("Alignment", vbLeftJustify)
...
End With
End Sub
'==============================================================================
'==============================================================================
'Write properties.
'------------------------------------------------------------------------------
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
With PropBag
.WriteProperty "Appearance", UserControl.Appearance, TxBApp_2D
...
.WriteProperty "Alignment", cTextBox.Alignment, vbLeftJustify
...
End With
End Sub
'==============================================================================
Now the automatic minimum height enforcement is gone. For example can we fit our standard 10 pt Font into a 14 pixels tall control.

Click and CheckStateChanged VB6

According to Microsoft:
"In Visual Basic 6.0, the Click event is raised when the CheckBox state is changed programmatically. "
and this is exactly what i do not want.
I want click event only raise when i click on the checkbox and not when the state is changed.
Any idea how to do it ?
Thank you
you can set a flag when you are populating the form from code to ignore changes. This can get messy if the code is not organized well.
Form Level:
Public IgnoreChange As Boolean
Form Load:
IgnoreChange = False
Event:
If IgnoreChange Then Exit Sub
Your code:
frmReference.IgnoreChange = True
frmReference.Checkbox1.Checked = True
frmReference.IgnoreChange = False
Code should only respond to user actions
Not sure if it's the best way, but one way would be to have a variable called something like IgnoreEvents and set that to true right before changed the state programmatically.
Then in the event handler if that variable is true, you just exit the event handler without doing anything.
Put your Click event code in the MouseDown event instead. You'll have to manually set the checkstate though:
Private Sub Check1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Check1.Value = IIf(Check1.Value = vbChecked, vbUnchecked, vbChecked)
' run other necessary code here
End Sub

How to reset the box

Using masked box in the form
masked1.mask = ##:##
In form load, masked1 display as __:__
Once user enter the values like 08:00 then reset means it should display again like this __:__
How to do this?
To clear a MaskEditBox you set the Text property to an empty string, however when the PromptInclude property is True you'll get an error. I would suggest writing a Sub method that you can call when you want to clear it.
Private Sub ClearMaskedEditBox(ByVal vMaskEditBox As MaskEdBox)
Dim strMask As String
strMask = vMaskEditBox.Mask 'save the current mask
vMaskEditBox.Mask = "" 'clear the control's mask
vMaskEditBox.Text = "" 'clear the text
vMaskEditBox.Mask = strMask 'reset the mask
End Sub
To use you call the Sub with the MaskEditBox control you want to clear.
Call ClearMaskedEditBox(masked1)

vb6: click button on HTMLDocument by code and wait for page to be loaded

i'm using the mshtml.tlb for loading/parsing html and i'd like extend it for clicking elements by code. the problem is trapping the loading-process after eg. a button was clicked.
in my specific case i'd like to perform a user-login.
here's my code:
Dim WithEvents m_doc As HTMLDocument
' load page
Set m_docNU = New HTMLDocument
Set m_doc = m_docNU.createDocumentFromUrl(m_url, vbNullString)
Do While m_doc.readyState = "loading" Or m_doc.readyState = "interactive"
DoEvents
Loop
set txtUsername = m_doc.getElementById("username")
set txtPasswort = m_doc.getElementById("passwort")
set myButton = m_doc.getElementById("submit")
myButton.click
now here's the big question mark: how to continue vb6- like "wait until page is loaded"?
i've tried as above using a do while-loop and checking the readyState, but for some reason the readyState doesn't change after clicking the button ..
any ideas?
thanks
ps: is there a more elegant way instead of the do while-loop? eg. using a progressbar?
use vb.net
wBrowser is a webbroser object
While wBrowser.ReadyState <> WebBrowserReadyState.Complete
Application.DoEvents()
End While

How to call a visio macro from a stencil

i have written some Macros for Visio. Now I copied these to a Stencil called Macros.vss
How can I call my Macros now?
It all depends on what the macros do and how you'd like to call them. I'm going to assume they're simply macros that will execute something within the active Visio page.
By default in Visio VBA, any public subs with no arguments get added to the Visio Tools->Macros menu, in a folder named by the document holding the macros (in this case Macros) and then separated into folders by module name. If you're the only person using the macros then you probably don't need to do anything else.
However, since you put them in a vss file I'll assume you'd like to distribute them to other people.
There's something funny (and by funny I mean irritating) about Visio and how toolbars and buttons work, when added programmatically. Unfortunately, when you create a toolbar using the UIObject and Toolbar and ToolbarItem classes, Visio is going to assume the code you're calling resides in the active drawing, and cannot be in a stencil. So I can give you a little guidance on using those classes, but basically it consists of distributing a .vst template along with your .vss files, with just a single required sub in the .vst file.
So, instead of using a custom toolbar, you can attach code to shape masters in your .vss file that execute the code when they get dropped on a drawing document (using CALLTHIS and the EventDrop event in the shapesheet). With this method I just have a sub that gets called using callthis that takes a shape object as an argument, executes some code, then deletes the shape (if I don't want it around anymore).
And lastly, you can manipulate the Visio UI programmatically to add a toolbar and buttons for your macros. Below is some sample code, basically the way I do it with a solution I developed. As I mentioned above, the most important part of using this method is to have a document template (.vst) that holds a sub (with the below code it must be named RunStencilMacro) that takes a string as an argument. This string should be the "DocumentName.ModuleName.SubName". This sub must take the DocumentName out of the string, and get a Document object handle to that document. Then it must do ExecuteLine on that document with the ModuleName.SubName portion. You'll have to step through the code and figure some things out, but once you get the hang of what's going on it should make sense.
I'm not sure of any other ways to execute the macros interactively with VBA. I think exe and COM addons may not have this issue with toolbars...
Private Sub ExampleUI()
Dim UI As Visio.UIObject
Dim ToolbarSet As Visio.ToolbarSet
Dim Toolbars As Visio.Toolbars
Dim Toolbar As Visio.Toolbar
Dim ToolbarItems As Visio.ToolbarItems
Dim ToolbarItem As Visio.ToolbarItem
Dim TotalToolBars As Integer
Dim Toolbarpos As Integer
Const ToolbarName = "My Toolbar"
' Get the UIObject object for the toolbars.
If Visio.Application.CustomToolbars Is Nothing Then
If Visio.ActiveDocument.CustomToolbars Is Nothing Then
Set UI = Visio.Application.BuiltInToolbars(0)
Else
Set UI = Visio.ActiveDocument.CustomToolbars
End If
Else
Set UI = Visio.Application.CustomToolbars
End If
Set ToolbarSet = UI.ToolbarSets.ItemAtID(visUIObjSetDrawing)
' Delete toolbar if it exists already
TotalToolBars = ToolbarSet.Toolbars.Count
For i = 1 To TotalToolBars
Set Toolbar = ToolbarSet.Toolbars.Item(i - 1)
If Toolbar.Caption = ToolbarName Then
Toolbar.Visible = False
Toolbar.Delete
Exit For
End If
Next
' create toolbar
Set Toolbar = ToolbarSet.Toolbars.Add
Toolbar.Caption = ToolbarName
Dim IconPos As Long ' counter to determine where to put a button in the toolbar
IconPos = IconPos + 1
Dim IconFunction As String
IconFunction = """Macros.Module1.SubName"""
Set ToolbarItem = Toolbar.ToolbarItems.AddAt(IconPos)
With ToolbarItem
.AddOnName = "RunStencilMacro """ & IconFunction & """"
.Caption = "Button 1"
.CntrlType = Visio.visCtrlTypeBUTTON
.Enabled = True
.state = Visio.visButtonUp
.Style = Visio.visButtonIcon
.Visible = True
.IconFileName ("16x16IconFullFilePath.ico")
End With
' Now establish the position of this toolbar
With Toolbar
.Position = visBarTop 'Top overall docking area
.Left = 0 'Puts it x pixels from the left
.RowIndex = 13
.Protection = visBarNoCustomize
Toolbar.Enabled = True
.Visible = True
End With
Visio.Application.SetCustomToolbars UI
Visio.ActiveDocument.SetCustomToolbars UI
End Sub

Resources