CommonControls (Replacement of the MS common controls)

[jpbro]

An additional note on my previous post - it appears that only the naked cursor keys don't work (vbKeyLeft, vbKeyRight, vbKeyUp, vbKeyDown). Press Shift+ or Ctrl+ a cursor key appears to work. Other naked navigation keys such as vbKeyHome, vbKeyEnd also appear to work as expected. Maybe a clue?

---
Additional note: If the Usercontrol has 2 controls (e.g. your RichTextBox and TextBoxW), then the cursor keys push the focus around between the controls. Perhaps another clue?

[Krool]

I have a need for a Unicode RichTextBox control, so I thought I give yours a try. Everything seems to be working pretty well except that if I host your RichTextBox control on another UserControl then the cursor keys don't seem to work any longer. Is there anything special I need to do to get them working on a UserControl, or is there a bug?

This problem was discussed already on page 2 and there is a solution as described below.

Then you need to add the following code to your UserControl:

Implements OLEGuids.IOleInPlaceActiveObjectVB

Private Sub IOleInPlaceActiveObjectVB_TranslateAccelerator(ByRef Handled As Boolean, ByRef RetVal As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long, ByVal Shift As Long)
On Error Resume Next
Dim This As OLEGuids.IOleInPlaceActiveObjectVB
Set This = UserControl.ActiveControl.Object
This.TranslateAccelerator Handled, RetVal, wMsg, wParam, lParam, Shift
End Sub

This is necessary because in this case the Container (UserControl) of the embedded controls receive the TranslateAccelerator message. If the ActiveControl of the UserControl implements the IOleInPlaceActiveObjectVB interface (That are the common controls from my project), then it delegates to it and perform the TranslateAccelerator for that control.

Just put the code fragment into your UserControl and everything should work.

[jpbro]

Hi Krool,

Sorry, I did read the other posts to see if the problem already had a solution, but I guess I misunderstood that that solution would work for this case (should have tried it anyway). Thanks for your help!

[Romeo91]

There are strange program hang when changing font (size and name) for the element comboboxw. Probably when they appear for the property or Font.Name Font.Size put incorrect values​​, such as an erroneous name of the font and size respectively. The greater the time used for the control of the properties, the longer hang

[JohnTurnbull]

Hi,

Just a quick question. I have a form with two TextBoxW controls. Lets call them A and B. No matter which control had the focus when the form loses the focus, control A has the focus when the form regain the focus. Can you suggest a reason for this and/or a way to fix it. The control A was added to the form before control B and A is single line with a maxlength set whereas B is multiline with no length limit.

[Krool]

I have a form with two TextBoxW controls. Lets call them A and B. No matter which control had the focus when the form loses the focus, control A has the focus when the form regain the focus. Can you suggest a reason for this and/or a way to fix it. The control A was added to the form before control B and A is single line with a maxlength set whereas B is multiline with no length limit.

I can't reproduce your problems. In order to help you more please upload the form and tell us which OS you are using.

[JohnTurnbull]

Hi Krool,

Thanks for replying. The form “as is” won’t run without all sorts of things from the rest of the project so I added it to your demo to take stuff out and get it to run there. It wouldn’t load in your demo with the following error log….

===========================================
Line 104: Class GraphicM8.TextBoxW of control ClipName was not a loaded control class.
Line 567: Class GraphicM8.TextBoxW of control Text1 was not a loaded control class.
Line 110: The property name _ExtentX in ClipName is invalid.
Line 111: The property name _ExtentY in ClipName is invalid.
Line 121: The property name Text in ClipName is invalid.
Line 122: The property name MaxLength in ClipName is invalid.
Line 123: The property name CueBanner in ClipName is invalid.
Line 573: The property name _ExtentX in Text1 is invalid.
Line 574: The property name _ExtentY in Text1 is invalid.
Line 585: The property name Text in Text1 is invalid.
Line 586: The property name HideSelection in Text1 is invalid.
Line 587: The property name MultiLine in Text1 is invalid.
Line 588: The property name ScrollBars in Text1 is invalid.
Line 589: The property name CueBanner in Text1 is invalid.

GraphicM8 is my project name so I guess I screwed something up adding your controls to my project!

I get no errors in my project and it runs perfectly apart from the focus thing I described.

Does this tell you what might be wrong or should I send you the form anyway?

Thanks JT

[JohnTurnbull]

I suspect the problem has something to do with your note about changing the project name, but it didn’t mean much to me as I didn’t change any project name. What I did was add your code to my project. To have the LabelW, TextBoxW and Richtextbox, the parts added were…..

Modules
ComCtlsBase.bas
Common.bas
Commondialog.bas
RichTextBoxBase.bas
VisualStyals.bas
Vtablehandle.bas

Class Modules
Enumeration.cls
Isubclass.cls
VtableSubclas.cls

User Controls
LabelW.ctl
RichTextbox.ctl
TextBoxW.ctl

Property pages
PPRichtextBoxGeneral.pag
PPRichtextBoxText.pag
PPTextBoxWText.pag

[JohnTurnbull]

Me again!

I now have two forms with this problem. However, when I added a nice simple form with nothing on it except the two TextBoxWs , that did not have the problem. Today I will take one of the offending forms apart till I find what causes it.

Let you know.

JT

[JohnTurnbull]

OK – Problem solved – My bad!

In case it happen to anyone else, this was the problem.

The forms have all their control Tabstops set to false so that I can handle the tab key. To get the form to load with the focus in the first TextBoxW, that has its Tabstop set to true but its GotFocus event turns it off. When I replaced my VB textboxes with TextBoxWs, I left the Tabstop in the second TextBoxW on true.

Sorry to bother you and thanks again for some great code.

[Romeo91]

Hi Kroll, a problem with the program's freezing appears when you multiple time trying to change any of font properties on any controls.
For example here is a code, and applying the property 10-15 times, the more times apply, the longer the freeze. May be variables are not cleared?

Private Sub Command5_Click ()
ComboBoxW1.Font.Size = 10
End Sub

Private Sub Command6_Click ()
ComboBoxW1.Font.Size = 8
End Sub

P.S. Sorry for my English, in from Russia. I often use Google.Translate

[Krool]

a problem with the program's freezing appears when you multiple time trying to change any of font properties on any controls.

Thanks for this bug report!
It is fixed now.

[jay!]

Really nice work with the unicode controls, thanks for this great work.

Could you add a PictureW control for the picturebox, which could work unicode into the Print statement?

Thank you,
JC

[jpbro]

This problem was discussed already on page 2 and there is a solution as described below.
Just put the code fragment into your UserControl and everything should work.

Just a quick note to anyone else experiencing this issue - if you have one of Krool's common controls on a UserControl, and then have your UserControl on another UserControl (and possibly even that UserControl on an additional UserControl, etc...), then you will need to add the code snippet to every UserControl all the way up the chain in order to get the expected behaviour.

[Krool]

Could you add a PictureW control for the picturebox, which could work unicode into the Print statement?

You can print unicode text into the intrinsic VB PictureBox.
You just need to use an API instead of the VB "Print" command.

Private Declare Function TextOutW Lib "gdi32" (ByVal hDC As Long, ByVal X As Long, ByVal Y As Long, ByVal lpString As Long, ByVal nCount As Long) As Long

Private Sub Command1_Click()
Dim Text As String
Text = "text unicode " & ChrW(&HFA23)
Picture1.AutoRedraw = True
TextOutW Picture1.hDC, 0, 0, StrPtr(Text), Len(Text)
Picture1.Refresh
End Sub

The downside is that the CurrentX and CurrentY property of the PictureBox are not meaningful.
But this can be solved by using the GetTextExtentPoint32() API.

[Bonnie West]

Could you add a PictureW control for the picturebox, which could work unicode into the Print statement?

Here's an alternative approach using the DrawTextW API function. The attached project demonstrates the use of the PrintW subroutine which tries to emulate the native Print method.

[Jonney]

Here's an alternative approach using the DrawTextW API function. The attached project demonstrates the use of the PrintW subroutine which tries to emulate the native Print method.

In your PrintW, Chr$ got error when typing Japanese.

[Bonnie West]

In your PrintW, Chr$ got error when typing Japanese.

Well, I don't know Japanese but I think it won't work in the KeyPress event:

Occurs when the user presses and releases an ANSI key.

I did mention this "limitation" in the instructions:

Type any ASCII character to the Form
or paste any Unicode text

[spinsk]

hey guys, im having a issue with the listview control, when i add to project and its all working fine with styles etc but once i close the main form of my app i get "runtime error 339", any ideas? thanks

[JohnTurnbull]

I have an installed font EPSON 行書体Ｍ and want to use it in textboxW

I use the choosefont dialog in which the name appears correctly



But when I retrieve the name in the variable Tr$, it comes out EPSON ???M not EPSON 行書体Ｍ and when I set the Text1.font.name (a TextboxW) to it, Text1 reversts to Arial

What am I doing wrong..... My code is below and works for all fonts except ones with unicode names....


Private Sub MnuFont_Click()
Dim fdata As ChooseFontType
Dim lData As LOGFONT
Dim Tr$
'..................
Text1.SetFocus
'..................preset log structure
Call StrToByteArray(Text1.Font.Name, lData)
lData.LFHeight = MulDiv(Text1.Font.Size, GetDeviceCaps(hDC, 90), 72)
lData.LFWeight = IIf(Text1.Font.Bold, 700, 400)
lData.LFItalic = Text1.Font.Italic
'lData.LFStrikeOut = Text1.Font.Strikethru
lData.LFUnderline = Text1.Font.Underline
'...................Preset choose font structure
fdata.lStructSize = Len(fdata)
fdata.hWndOwner = EditClip.hWnd
fdata.hDC = EditClip.hDC
fdata.lpLogFont = VarPtr(lData)
fdata.nFontType = &H1
fdata.rgbColors = 0
fdata.Flags = &H1 Or &H40 'Screenfonts/init to log
'....................................
If ChooseFont(fdata) = 0 Then GoTo Cancel
'================================================Text Label==================.....
Tr = StrConv(lData.LFFaceName, vbUnicode)
Tr = Left$(Tr, InStr(Tr, Chr$(0)) - 1)
Text1.Font.Name = Tr

[Krool]

im having a issue with the listview control, when i add to project and its all working fine with styles etc but once i close the main form of my app i get "runtime error 339"

Without more details it is difficult to help. Is this occuring in the IDE only? Or does the executable also crash?
Is this error also occuring in a "blank" project?

I have an installed font EPSON 行書体Ｍ and want to use it in textboxW

But when I retrieve the name in the variable Tr$, it comes out EPSON ???M not EPSON 行書体Ｍ

[...]

Tr = StrConv(lData.LFFaceName, vbUnicode)
Tr = Left$(Tr, InStr(Tr, Chr$(0)) - 1)

You are using the ANSI version of the ChooseFont API. Check whether the Alias of the API is "ChooseFontA" or "ChooseFontW".
The problem is that you are using a byte array in the LFFaceName member of the LogFont structure and using a ANSI API. Because if you would use the Unicode API then the Result would be already in Unicode and thus a StrConv would not be needed.

[JohnTurnbull]

Magic ! Thank you.

I been using basic nearly thirty years but I only just got into unicode and its like I know nothing!

[jay!]

Alright, I've been working with TextBoxW and the Richtextbox now over the course of a few projects and keep getting the same crash, which locks up the VB6 IDE completely and crashes the project.

After putting a TextBoxW control on the form and running the application, I can use it just fine and everything is great. Then, I close the application, and in every project so far it has then gone to this line:

Debug.Assert CBool(OldPointer <> NewPointer)

in the CreateSubclass sub. I commented it out, and found the following occurred:

Out of stack space at:

Private Function Original_IOleIPAO_TranslateAccelerator(ByVal This As OLEGuids.IOleInPlaceActiveObject, ByRef Msg As OLEGuids.OLEACCELMSG) As Long
VTableSubclassIPAO.SubclassEntry(VTableIndexIPAOTranslateAccelerator) = False
Original_IOleIPAO_TranslateAccelerator = This.TranslateAccelerator(ByVal VarPtr(Msg))
VTableSubclassIPAO.SubclassEntry(VTableIndexIPAOTranslateAccelerator) = True
End Function

I commented out the switch lines for the VtableSubclassIPAO there and received the same error OUT OF STACK SPACE for the line

Original_IOleIPAO_TranslateAccelerator = This.TranslateAccelerator(ByVal VarPtr(Msg))

Now it's a Win7 64bit machine, and I need these controls for working with some translation software type stuff. I would be glad to share the project if it would help in debugging the problem for you.

Any suggestions?

Thanks a lot, and great work again on these controls, if this problem can be fixed they're going in my permanent toolbox.

[Niya]

There must be some kind of infinite recursion some where there.

[Romeo91]

Then, I close the application, and in every project so far it has then gone to this line:

Debug.Assert CBool(OldPointer <> NewPointer)

in the CreateSubclass sub. I commented it out, and found the following occurred:

Out of stack space at:

Private Function Original_IOleIPAO_TranslateAccelerator(ByVal This As OLEGuids.IOleInPlaceActiveObject, ByRef Msg As OLEGuids.OLEACCELMSG) As Long
VTableSubclassIPAO.SubclassEntry(VTableIndexIPAOTranslateAccelerator) = False
.....

I also have in my project the same error, for example if i call the unload form (Unload me) from the event key_down (both IDE and the exe), but if I just close the form by pressing X, then unloading occurs normally. I also use the event Query_Unload and Unload.

[spinsk]

hi krool, sorry i figured the problem out, it was because i was using api timers that was causing the issue but i fixed it by saving project hwnd in a variable before sub classing init, however i do have another issue, im trying to add a progress bar to your status bar control via setparent then moving it into the panel i require, all works fine until i resize the form, if increase the width of the form the progress bar disappears and reappears once u release the mouse button from the resize event, also once you maximize the form the progress bar disappears all together and cannot get it back even with calling setparent api again, any idea's? thanks in advanced

[Krool]

After putting a TextBoxW control on the form and running the application, I can use it just fine and everything is great. Then, I close the application, and in every project so far it has then gone to this line:

Debug.Assert CBool(OldPointer <> NewPointer)

How do you close the application? if the above Debug.Assert is firing this is an indication of an "unclean" closure.

i do have another issue, im trying to add a progress bar to your status bar control via setparent then moving it into the panel i require, all works fine until i resize the form, if increase the width of the form the progress bar disappears and reappears once u release the mouse button from the resize event, also once you maximize the form the progress bar disappears all together and cannot get it back even with calling setparent api again, any idea's?

There was indeed a problem in the StatusBar control. I have released an update. Thanks for your report.
Also keep in mind to use the .hWndUserControl and not .hWnd in the SetParent API. Like as following:

SetParent ProgressBar1.hWndUserControl, StatusBar1.hWndOwner

[JohnTurnbull]

You can print unicode text into the intrinsic VB PictureBox.
You just need to use an API instead of the VB "Print" command.

As well as printing unicode to a picturebox, I have a need to set the font of a picturebox to a font which has a unicode name. This result in "Invalid property Value"

Problem would be solved with a PictureboxW control!
Or is there some other way round this?

[Krool]

Update released.

Then, I close the application, and in every project so far it has then gone to this line:

Debug.Assert CBool(OldPointer <> NewPointer)

This update might solve your problems.

[Romeo91]

Update released.
This update might solve your problems.

In my project, this solution did not help. The error in the same place. On my form I use ComboBoxW, CheckBoxW, LabelW, ToolTip now trying to understand what third-party control-collections (Analogs Frame control) affect this.

[JohnTurnbull]

Romeo,

I have about a dozen forms with Krools controls on them and had this problem for a while. It happens when you terminate your app from within the code of a form with the controls.

Solution:-

Add a timer to a form which DOESN'T have Krools controls. The timer event unloads all the forms that have controls on them before unloading itself.

Never had the problem again!

[Krool]

I have about a dozen forms with Krools controls on them and had this problem for a while. It happens when you terminate your app from within the code of a form with the controls.

I can't replicate the problem. Can you share a sample?

[JohnTurnbull]

I don't have the problem. Romeo does. Perhaps he can oblige.

Any chance of the PictureboxW sometime?

[spinsk]

Hi krool, that's for the update, I've come across another issue with the tabs control, when I set the alignment to bottom they appear upside down correctly in IDE but once u compile with manifest they are back to normal? Also is there a way to have the tabs align from the furthest point right instead of always left? Thanks in advanced.

[Krool]

I've come across another issue with the tabs control, when I set the alignment to bottom they appear upside down correctly in IDE but once u compile with manifest they are back to normal?

I assume you mean the 'Placement' property. This property is ignored if the version of comctl32.dll is 6.0 or higher.

[Romeo91]

Debug.Assert CBool(OldPointer <> NewPointer)

Krool, with the latest update, I've lost my mistake in the project.
Thank you very much.

[Krool]

Update released.

I just encountered that any control can receive the focus when pressing a "X" mouse button. Which should not be.
This brought me up to make a intensive test on each WM_MOUSEACTIVATE handler and I found some more bugs...
So in my opinion this is a quite important update.

[JohnTurnbull]

Here's an alternative approach using the DrawTextW API function. The attached project demonstrates the use of the PrintW subroutine which tries to emulate the native Print method.

Hi Bonnie,

I've been using your PrintW to print unicode into pictureboxes with great success. However, when I try using it to the printer, although it executes without error, nothing gets printed at Printer.Enddoc. Any Ideas what I'm doing wrong?

Print routine code.....

Private Sub PrintIt(Landscape As Integer)
Dim Txt$, xx&, Tr$, yy&
Dim Lft&, wid&
'..............

If Text1.Text = "" Then Exit Sub
'....................
On Local Error GoTo SkipFont
Printer.FontName = Text1.Font.Name
On Local Error GoTo 0
SkipFont:
If Err > 0 Then Resume Here1
Here1:
On Local Error GoTo SkipSize
Printer.FontSize = Text1.Font.Size
On Local Error GoTo 0
SkipSize:
If Err > 0 Then Resume Here2
Here2:
On Local Error GoTo Skip3
If Landscape = 0 Then
   Printer.orientation = 1
Else
   Printer.orientation = 2
End If
On Local Error GoTo 0
Skip3:
If Err > 0 Then Resume Here3
Here3:
'====================================
Lft = 1000
On Local Error GoTo NoPrinter
wid = Printer.Width - 2000
On Local Error GoTo 0
Printer.CurrentX = Lft: Printer.CurrentY = Lft
Txt = Text1.Text
'=====================================
PrintLine:
If Printer.CurrentY > Printer.Height - 1200 Then
   Printer.NewPage
   Printer.CurrentX = Lft
   Printer.CurrentY = Lft
End If
Prt.Caption = ""
Do
   Tr = Left$(Txt, 1)
   Txt = Right$(Txt, Len(Txt) - 1)
   '..............................................Line ends
   If Tr = Chr$(13) Then
      '......................................Get rid of first Chr$(10)
      If Left$(Txt, 1) = Chr$(10) Then Txt = Right$(Txt, Len(Txt) - 1)
      '.....................................pass any extra Cr/Lfs
      Do
         If Left$(Txt, 1) <> Chr$(13) And Left$(Txt, 1) <> Chr$(10) Then Exit Do
         Tr = Left$(Txt, 1)
         Txt = Right$(Txt, Len(Txt) - 1)
         Prt.Caption = Prt.Caption + Tr
      Loop
      PrintW Printer, Prt.Caption   ' replacing next line
      'Printer.Print Prt.Caption
      If Txt = "" Then
         Exit Do
       Else
         Printer.CurrentX = Lft
         GoTo PrintLine
      End If
   Else
      Prt.Caption = Prt.Caption + Tr
   End If
   '.................................................End of print
   If Txt = "" Then
      On Local Error Resume Next 'Needed if doc printer is default
      PrintW Printer, Prt.Caption    ' replacing next line
      'Printer.Print Prt.Caption
      On Local Error GoTo 0
      Exit Do
   End If
   '.................................................Word wrap to printer width
   If Printer.TextWidth(Prt.Caption) > wid Then
      Do
         Tr = Right$(Prt.Caption, 1)
         Prt.Caption = Left$(Prt.Caption, Len(Prt.Caption) - 1)
         If Tr = Chr$(32) Then Exit Do
         Txt = Tr + Txt
      Loop
      PrintW Printer, Prt.Caption     ' replacing next line
      'Printer.Print Prt.Caption
      Printer.CurrentX = Lft
      GoTo PrintLine
   End If
Loop
Printer.EndDoc
Exit Sub
NoPrinter:
Resume Here4
Here4:
End Sub

[byweb]

TreeView won't raise "MouseUp" event if mouse is still. Why?

[Romeo91]

Good day.
It is impossible to correctly change the font for the Tooltip, after the form is loaded. I use a two monospaced fonts Lucida Console and Courier New. With the first type there is no problem, but the second font is correctly displayed only after loading a form, and if you try to change it after load form to another font (such as Lucida Console) and back again, the font changes, but not correctly displayed
I added to your project and two buttons Command5 Command6, and added to them the ToolTip.
ComCtlsDemo_TestTTFont.7z.zip (The attached file is a .7z file with a .zip extension so it could be uploaded.)

P.S. Also I Tried to change other properties for LogFont Structure (such as LFQuality As Byte and LFPitchAndFamily As Byte), but the result (as the after form_load) not seen


*********************
Added later.
In windows 7 tooltip font can only be operated in a classical theme, in aero themes font remains unchanged and is likely to default