Focus

Depends on the code. Normaly it does not happen.

What do yo do on getfocus and lostfocus events in the custom control?

Saso

Are you using VB6 with the latest service packs?

Try this:

1. Open new VB project
2. Ad MDI form
3. Change property of Form1 to MDI child
4. Ad New control
5. Pot TextBox on the control
6. Put UserControl1 to Form1
7. Run program

When you close Form1 Focus stays on MDI form. So there is something in your control that prevents it.

Saso

In the gotfocus of my control I select all the the in a textbox that is part of my control

I'm using VB6 with service pack 5

Oups
the first line of my last comment was supposed to be:
In the gotfocus of my control I select all the text in a textbox that is part of my control

I tried Saso's idea to create a new project. And the result is the same, so it's definitly my control that makes the mdi lose it's focus.

If you can cut and paste the code of your control, I maby can help you. I had some problems with controls regading focus.

Saso

Sometimes the problem lies on the control which you use in your control. If this is from fm20.dll library than that is most likely the problem, especialy if you use combobox from fm20.dll.

Saso

On my control I use a textbox called txtID and a Vertical scrollbar called vsbID

Ok so heres my code if you want to try it out:

Option Explicit

Private prtyNumeric As Boolean

Dim FromCode As Boolean

Public Event Change()
Public Event KeyDown(KeyCode As Integer, Shift As Integer)
Public Event KeyPress(KeyAscii As Integer)
Public Event QueryChange(ID As String, Cancel As Boolean)

Public Connection As ADODB.Connection
Public rs As New ADODB.Recordset
Public Tag As String
Public Table As String
Public Field As String
Public Criteria As String
Public Locked As Boolean

Public Property Get Enabled() As Boolean
  Enabled = txtID.Enabled
End Property

Public Property Let Enabled(ByVal NewValue As Boolean)
  txtID.Enabled = NewValue
  vsbID.Enabled = NewValue
End Property

Public Property Get Text() As String
  Text = txtID.Text
End Property

Public Property Let Text(ByVal NewValue As String)
  FromCode = True
  txtID.Text = NewValue
  FromCode = False
End Property

Public Property Get Mask() As String
  Mask = txtID.Mask
End Property

Public Property Let Mask(ByVal NewValue As String)
  txtID.Mask = NewValue
End Property

Public Property Get PromptChar() As String
  PromptChar = txtID.PromptChar
End Property

Public Property Let PromptChar(ByVal NewValue As String)
  txtID.PromptChar = NewValue
End Property

Public Property Get SelStart() As Long
  SelStart = txtID.SelStart
End Property

Public Property Let SelStart(ByVal NewValue As Long)
  txtID.SelStart = NewValue
End Property

Public Property Get SelLength() As Long
  SelLength = txtID.SelLength
End Property

Public Property Let SelLength(ByVal NewValue As Long)
  txtID.SelLength = NewValue
End Property

Public Property Get BackColor() As Long
  BackColor = txtID.BackColor
End Property

Public Property Let BackColor(ByVal NewValue As Long)
  txtID.BackColor = NewValue
End Property

Public Property Get MaxLength() As Long
  MaxLength = txtID.MaxLength
End Property

Public Property Let MaxLength(ByVal NewValue As Long)
  txtID.MaxLength = NewValue
End Property


Public Property Get Numeric() As Boolean
  Numeric = prtyNumeric
End Property

Public Property Let Numeric(ByVal NewValue As Boolean)
  prtyNumeric = NewValue

  If prtyNumeric And Len(txtID) > 0 Then Text = Val(txtID)
End Property

Public Property Get NoMatch() As Boolean
  NoMatch = txtID.ForeColor = vbRed
End Property

Private Sub txtID_Change()
  PurgeString txtID, Numeric
  If txtID.Text <> txtID.Tag Then
    If Locked And Not FromCode Then
      txtID.Text = txtID.Tag
    Else
      Refresh
      txtID.Tag = txtID.Text
      RaiseEvent Change
    End If
  End If
End Sub

Private Sub txtID_GotFocus()
  Focus txtID
End Sub

Private Sub txtID_KeyDown(KeyCode As Integer, Shift As Integer)
  Dim Used As Boolean
 
  Used = True
  Select Case KeyCode
  Case vbKeyUp: MoveUp
  Case vbKeyDown: MoveDown
  Case vbKeyPageUp: MoveLast
  Case vbKeyPageDown: MoveFirst
  Case Else: Used = False
  End Select
  If Used Then
    txtID_GotFocus
    KeyCode = 0
  End If
  RaiseEvent KeyDown(KeyCode, Shift)
End Sub

Private Sub txtID_KeyPress(KeyAscii As Integer)
  If Locked Then
    KeyAscii = 0
  Else
    If Numeric Then
      If KeyAscii <> 8 And Not IsNumeric(Chr(KeyAscii)) Then KeyAscii = 0
    Else
      If KeyAscii = Asc("'") Then KeyAscii = Asc("?")
    End If
  End If
  RaiseEvent KeyPress(KeyAscii)
End Sub

Private Sub UserControl_Resize()
  txtID.Width = UserControl.Width - vsbID.Width
  vsbID.Left = txtID.Width
 
  txtID.Height = UserControl.Height
  vsbID.Height = UserControl.Height
End Sub

Private Sub vsbID_Change()
  If vsbID.Value <> 1 Then
    If vsbID.Value = 0 Then
      vsbID.Value = 1
      MoveUp
    Else
      vsbID.Value = 1
      MoveDown
    End If
    txtID.SetFocus
    txtID_GotFocus
  End If
End Sub

Private Sub MoveUp()
  If Not Locked Then NextRecord
End Sub

Private Sub MoveDown()
  If Not Locked Then PreviousRecord
End Sub

Private Sub MoveLast()
  If Not Locked Then LastRecord
End Sub

Private Sub MoveFirst()
  If Not Locked Then FirstRecord
End Sub

'***************************
'* Goes to the next record *
'***************************
Public Sub NextRecord()
  Dim rs As ADODB.Recordset
 
  If Numeric Then
    Set rs = Find(Table, Field & " > " & Val(txtID), "Min(" & Field & ") as MinMax")
  Else
    Set rs = Find(Table, Field & " > '" & txtID & "'", "Min(" & Field & ") as MinMax")
  End If
 
  If IsNull(rs("MinMax")) Then Set rs = Find(Table, , "Max(" & Field & ") as MinMax")
  subQueryChange NullKill(rs("MinMax"))
End Sub

'*******************************
'* Goes to the previous record *
'*******************************
Public Sub PreviousRecord()
  Dim rs As ADODB.Recordset
 
  If Numeric Then
    Set rs = Find(Table, Field & " < " & Val(txtID), "Max(" & Field & ") as MinMax")
  Else
    Set rs = Find(Table, Field & " < '" & txtID & "'", "Max(" & Field & ") as MinMax")
  End If
  If IsNull(rs("MinMax")) Then Set rs = Find(Table, , "Min(" & Field & ") as MinMax")
  subQueryChange NullKill(rs("MinMax"))
End Sub

'****************************
'* Goes to the first record *
'****************************
Public Sub FirstRecord()
  Dim rs As ADODB.Recordset
  Set rs = Find(Table, , "Min(" & Field & ") as MinMax")
  subQueryChange NullKill(rs("MinMax"))
End Sub

'***************************
'* Goes to the last record *
'***************************
Public Sub LastRecord()
  Dim rs As ADODB.Recordset
  Set rs = Find(Table, , "Max(" & Field & ") as MinMax")
  subQueryChange NullKill(rs("MinMax"))
End Sub

Public Sub Refresh()
  If Numeric Then
    Set rs = Find(Table, Field & " = " & Val(txtID))
  Else
    Set rs = Find(Table, Field & " = '" & txtID & "'")
  End If
  txtID.PromptInclude = False 'if txtID empty, text returns "" instead of "___-__"
  If Not funNoMatch(rs) And txtID <> "" Then
    txtID.ForeColor = vbButtonText
  Else
    txtID.ForeColor = vbRed
  End If
  txtID.PromptInclude = True
End Sub

'**********************************************************************************
'* Called when a change is about to happen that doesn't come from typing in txtID *
'**********************************************************************************
Private Sub subQueryChange(ID As String)
  Dim Cancel As Boolean
  If ID <> txtID Then
    RaiseEvent QueryChange(ID, Cancel)
    If Not Cancel Then Text = ID
  Else
    Refresh
  End If
End Sub

'**************************************************
'* Creates an SQL Query and returns the recordset *
'**************************************************
Private Function Find(Table As String, Optional ByVal Criteria As String, Optional Selection As String = "*", Optional first As Boolean = True, Optional ByVal Order As String) As ADODB.Recordset
  Set Find = New ADODB.Recordset
  If Find.State <> 0 Then Find.Close
 
  If Len(Me.Criteria) > 0 Then
    If Len(Criteria) > 0 Then
      Criteria = " WHERE " & Criteria & " AND " & Me.Criteria
    Else
      Criteria = " WHERE " & Me.Criteria
    End If
  Else
    If Len(Criteria) > 0 Then Criteria = " WHERE " & Criteria
  End If
  If Len(Order) > 0 Then Order = " ORDER BY " & Order
  Find.Open "SELECT " & Selection & " FROM " & Table & Criteria & Order, Connection, adOpenStatic, , adCmdText
 
  If Not funNoMatch(Find) Then
    If first Then
      Find.MoveFirst
    Else
      Find.MoveLast
    End If
  End If
End Function

'*********************************************************
'* Returns TRUE if the recordset is not ready to be used *
'*********************************************************
Private Function funNoMatch(rs As ADODB.Recordset) As Boolean
  If rs.State <> 0 Then
    If rs.Fields.Count = 1 Then
      If IsNull(rs(0)) Then 'When Db is empty and Min() is used to find to first record
        funNoMatch = True
      Else
        funNoMatch = rs.BOF Or rs.EOF
      End If
    Else
      funNoMatch = rs.BOF Or rs.EOF
    End If
  Else
    funNoMatch = True
  End If
End Function

'*****************************************************************
'* Prevent undesired characters from being pasted into a textbox *
'*****************************************************************
Private Sub PurgeString(ctr As Control, Optional Numeric As Boolean = False, Optional MaxLength As Integer = 0)
  Dim Modif As Boolean
  Dim s As String
  On Error GoTo InvalidString
  s = ctr
  If Len(s) > 0 Then
    If Replace(s, "'", "?") <> s Then
      s = Replace(s, "'", "?")
      Modif = True
    End If
    If Numeric Then
      If Not IsNumeric(s) Then
        s = Val(s)
        Modif = True
      End If
    End If
    If MaxLength > 0 And Len(s) > MaxLength Then
      s = Left(s, MaxLength)
      Modif = True
    End If
    If Modif Then
      ctr = s
      Focus ctr
    End If
  End If
InvalidString:
End Sub

'****************************
'* Selects all in a textbox *
'****************************
Private Sub Focus(ctr As Control)
  ctr.SelStart = 0
  ctr.SelLength = Len(ctr)
End Sub

'****************************************************
'* Returns the default string if Expression is null *
'****************************************************
Private Function NullKill(Expression, Optional Default As String = "") As String
  If IsNull(Expression) Then
    NullKill = Default
  Else
    If RTrim(Expression) = RTrim(Default) Then
      NullKill = Default
    Else
      NullKill = RTrim(Expression)
    End If
  End If
End Function

Hi!
Sorry, I have problems connecting to this site, or they have, and I do not get e-mail notifications, however:

Now I do not know, how exactly do you want it to work. It works normaly for me. Where dhe focus go, after closing the form. To other program?

However I used VB standard textbox, wich you obviously did not, becuse normal textbox has not the properties PromptChar and Mask.

And you also call procedure PurgeString, wich is not defined in the scope of the control. I think it can not affect the focus behaviour, however it is not good idea to do so.

I have problems connecting to this site too for the last couple of days, and I don't receive any email notification, so it's not just you

anyway,
I forgot that I changed my textbox to a maskeditbox, sorry for the confusion this has caused.

The procedure PurgeString is in the code I pasted in my last comment. If you look at this code the third procedure from the bottom is PurgeString.

To find out where the focus was going (since I don't see a program that has the focus in my taskbar) I pressed Alt+F4 to see which program was going to close. After doing this no program was closed and the focus went back on my mdi. So I tried showing my child form and it gave me the error : "Error during load see Form1.log". In Form1.log it was written "Cannot load control RecordList1."

I tried changing my maskeditbox to a textbox , just to see what would happen. When it's a textbox the focus stays on the mdi as it should.

Unfortunatly I need it to be a maskeditbox, but maybe this information can help finding what is causing this.

As I guessed, the problem lies in a control, which you put on your UserControl, but I have one more question: where have you found maskeditbox, in which library. Obviously the problem lies in that control.

It's in MSMASK32.OCX, and it's called "Microsoft Masked Edit Control 6.0 (SP3)" in the Components of the project.

Thanks for sticking with me on this problem sasot. I realy apreciate it.

I see that Mask Edit control has bugg. The workaround is:

If there is no other control on teh form expect your UserControl, add a TextBox1 to your form, set TabStop to False and put it beyond the edge of the form, so user can not see it. Than add:

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
  Text1.SetFocus
End Sub

If there is another control on the form, you can use it to give it focus before closing form.

I tried it and it works.

Saso

Does it work now?

Sorry for the delay I was not able to log on to this site yesterday.

It works but isn't there a way I could arrange this in the control.
You see my application uses this control on 25 forms, I would like it if I didn't have to change it everywhere.
And since there are occasions where all my controls are disabled besides this one I would have to add a hiden control on each form to receive the focus.
Also I would like to use this control in other programs in the future so I don't want to have to patch it everytime.

You can use TextBox from Microsoft Forms 2.0 Object Library instead of Mask Edit control:

1. In components Add Microsoft Forms 2.0 Object Library
2. Delete TxtID from your control
3. Add TextBox from Forms 2.0 to your control and name it TxtID
4. Replace existing procedures TxtID_KeyPress and txtID_KeyDown with:

Private Sub TxtID_KeyPress(KeyAscii As MSForms.ReturnInteger)
' Type of parameter is changed
 Dim KA As Integer 'This line is added
 If Locked Then
   KeyAscii = 0
 Else
   If Numeric Then
     If KeyAscii <> 8 And Not IsNumeric(Chr(KeyAscii)) Then KeyAscii = 0
   Else
     If KeyAscii = Asc("'") Then KeyAscii = Asc("?")
   End If
 End If
 KA = KeyAscii 'This line is added
 RaiseEvent KeyPress(KA) 'This line is changed
End Sub
 
 Private Sub txtID_KeyDown(KeyCode As MSForms.ReturnInteger, Shift As Integer)
 ' Type of parameter is changed
 Dim Used As Boolean
 Dim KC As Integer 'This line is added
 Used = True
 Select Case KeyCode
 Case vbKeyUp: MoveUp
 Case vbKeyDown: MoveDown
 Case vbKeyPageUp: MoveLast
 Case vbKeyPageDown: MoveFirst
 Case Else: Used = False
 End Select
 If Used Then
   txtID_GotFocus
   KeyCode = 0
 End If
 KC = KeyCode 'This line is added
 RaiseEvent KeyDown(KC, Shift) 'This line is changed
End Sub

I don't understand how can I make the TextBox from Microsoft Forms 2.0 object library behave like a mask edit control

I don't see a Mask property or something similar

Sorry. I didnt check it in runtime. Compailer (ctrl F5)didn't complain.

I'll try something else, but I am affraid there is not much more to be done. I'll try some more tricks and will be back later.

Sorry i should say:

Private Sub UserControl_Terminate()
 MainForm.SetFocus
End Sub

Now thats a solution! :)

Thanks alot sasot, it works great.

Glad I could help.