Page 1 of 2 12 LastLast
Results 1 to 40 of 44

Thread: LabelPlus

  1. #1

    Thread Starter
    Hyperactive Member
    Join Date
    Dec 2008
    Location
    Argentina
    Posts
    439

    LabelPlus

    First of all I want to clarify that this control is based on the Firenze Label project, adapted to GDI + with many aggregates since the previous one depends on vbRichClient5.
    They have many properties and events that later I will go with certain data, for the moment I will raise the control with some examples and other controls that accompany.
    You can achieve very nice things with this control, it is only a matter of playing with its properties, you can create many controls from this label is a matter of putting a little imagination. I clarify that it does not act as a programmed control, it is a label not a button so it is in the programmer to give the way in which the seal is repainted when the Down and Up mouse is triggered and other events.

    Some screenshots of what can be achieved with the LabePlus


    Name:  LabelPlus1.jpg
Views: 4022
Size:  22.7 KB
    Name:  LabelPlus2.jpg
Views: 3828
Size:  40.6 KBName:  LabelPlus3.jpg
Views: 3839
Size:  40.0 KBName:  LabelPlus4.jpg
Views: 3975
Size:  57.4 KBName:  LabelPlus5.jpg
Views: 3865
Size:  36.1 KB


    sorry for not leaving a help file

    Version: 1.5.2
    DOWNLOAD
    Last edited by LeandroA; Feb 14th, 2020 at 12:30 PM.
    leandroascierto.com Visual Basic 6 projects

  2. #2
    New Member
    Join Date
    Sep 2011
    Location
    Lima
    Posts
    11

    Re: LabelPlus

    Very valuable control, very useful.

    Excellent work Leandro

    Greetings, from somewhere in Lima / Peru

  3. #3
    New Member
    Join Date
    Sep 2011
    Location
    Lima
    Posts
    11

    Re: LabelPlus

    Very valuable control, very useful.

    Excellent work Leandro

    Greetings, from somewhere in Lima / Peru

  4. #4
    gibra
    Guest

    Re: LabelPlus

    Hi Leandro, great work (as ever). I tried to compile the Menu con LabelPlus project but I get a error:

    Compileation error
    Unable to find Method or member data

    on line:
    Code:
    LabelPlus1.PictureFromStream ReadFile(sFile)
    of file: PropPagLP.pag

    in this routine:
    Code:
    Private Sub cmdBrowse_Click()
        Dim sFile       As String
        Dim svName()    As String
        
        If VBGetOpenFileName(sFile, Filter:=FILTER_PICTURES, Owner:=PropertyPage.hwnd) Then
    
    
            Changed = True
            
            LabelPlus1.PictureFromStream ReadFile(sFile)
            If LabelPlus1.PictureExist Then
                CmdDelete.Enabled = True
            End If
        End If
    End Sub
    P.S.
    Also ucNavBar project contains error when is load.
    Last edited by gibra; Feb 14th, 2020 at 12:49 PM.

  5. #5
    Fanatic Member
    Join Date
    Jun 2016
    Location
    España
    Posts
    514

    Re: LabelPlus

    great job.
    Super they look so pretty.

    in the example "Menu with LabelPlus"
    could do the sub menus.
    and also that could add so dynamic.


    a genius greeting

  6. #6
    PowerPoster
    Join Date
    Jul 2010
    Location
    NYC
    Posts
    5,908

    Re: LabelPlus

    Wow fantastic work Leandro
    Last edited by fafalone; Feb 15th, 2020 at 12:44 AM.

  7. #7

    Thread Starter
    Hyperactive Member
    Join Date
    Dec 2008
    Location
    Argentina
    Posts
    439

    Re: LabelPlus

    hi Gibra i can't reproduce or find its error, maybe the property page doesn't charge the control?, the property page must have a LabelPlus1 control.
    I admit that I still have several points to see, for example the ReadFile function is not unicode , but I don't think this is your problem to compile
    on the other hand PD_icons.RES is poorly formed and I still can't find the solution, there is something that escapes my knowledge.

    Does anyone else have trouble compiling?
    leandroascierto.com Visual Basic 6 projects

  8. #8
    PowerPoster wqweto's Avatar
    Join Date
    May 2011
    Location
    Sofia, Bulgaria
    Posts
    5,230

    Re: LabelPlus

    Here is some sample code for hot-tracking without timers loosly based on Implementing Hot Tracking in an ActiveX control article.

    Place a Label1 on a new windowless user-control and try this code:

    thinBasic Code:
    1. Option Explicit
    2.  
    3. Private Declare Function GetCapture Lib "user32" () As Long
    4. Private Declare Function SetCapture Lib "user32" (ByVal hWnd As Long) As Long
    5. Private Declare Function ReleaseCapture Lib "user32" () As Long
    6. Private Declare Function DispCallFunc Lib "oleaut32" (ByVal pvInstance As Long, ByVal oVft As Long, ByVal lCc As Long, ByVal vtReturn As VbVarType, ByVal cActuals As Long, prgVt As Any, prgpVarg As Any, pvargResult As Variant) As Long
    7.  
    8. Private m_bDown                 As Boolean
    9.  
    10. Private Sub UserControl_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    11.     m_bDown = True
    12.     UserControl_MouseMove Button, Shift, X, Y
    13. End Sub
    14.  
    15. Private Sub UserControl_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    16.     m_bDown = False
    17.     UserControl_MouseMove Button, Shift, X, Y
    18. End Sub
    19.  
    20. Private Sub Label1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    21.     UserControl_MouseMove Button, Shift, Label1.Left + X, Label1.Top + Y
    22. End Sub
    23.  
    24. Private Sub UserControl_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    25.     On Error GoTo EH
    26.     If X >= 0 And X <= ScaleWidth And Y >= 0 And Y <= ScaleHeight Then
    27.         Label1.Caption = IIf(m_bDown, "Down", "Hot")
    28.     Else
    29.         Label1.Caption = IIf(m_bDown, "Down Outside", "Normal")
    30.     End If
    31.     If X >= 0 And X <= ScaleWidth And Y >= 0 And Y <= ScaleHeight Or m_bDown <> 0 Then
    32.         If Not pvGetCapture() Then
    33.             pvSetCapture True
    34.         End If
    35.     Else
    36.         If pvGetCapture() Then
    37.             pvSetCapture False
    38.         End If
    39.     End If
    40.     Exit Sub
    41. EH:
    42.     Debug.Print "UserControl_MouseMove "; Err.Description; Err.Source
    43. End Sub
    44.  
    45. Private Function pvGetCapture() As Boolean
    46.     Const IDX_GetCapture As Long = 19
    47.  
    48.     If UserControl.hWnd = 0 Then
    49.         If DispCallByVtbl(GetInPlaceSiteWindowless(Me), IDX_GetCapture) = 0 Then ' S_OK
    50.             pvGetCapture = True
    51.         End If
    52.     ElseIf GetCapture() = UserControl.hWnd Then
    53.         pvGetCapture = True
    54.     End If
    55. End Function
    56.  
    57. Private Sub pvSetCapture(ByVal bValue As Boolean)
    58.     Const IDX_SetCapture As Long = 20
    59.    
    60.     If UserControl.hWnd = 0 Then
    61.         DispCallByVtbl GetInPlaceSiteWindowless(Me), IDX_SetCapture, CLng(-bValue)
    62.     Else
    63.         If bValue Then
    64.             Call SetCapture(UserControl.hWnd)
    65.         Else
    66.             Call ReleaseCapture
    67.         End If
    68.     End If
    69. End Sub
    70.  
    71. Private Function GetInPlaceSiteWindowless(pCtl As IUnknown) As IUnknown
    72.     Const E_NOINTERFACE As Long = &H80004002
    73.     Const IDX_QueryInterface As Long = 0
    74.     Const IDX_GetClientSite As Long = 4
    75.     Dim aGuid(0 To 3)   As Long
    76.     Dim pOleObject      As IUnknown
    77.     Dim pOleClientSite  As IUnknown
    78.     Dim hResult         As Long
    79.    
    80.     aGuid(0) = &H112: aGuid(2) = &HC0: aGuid(3) = &H46000000 ' IID_IOleObject
    81.     hResult = DispCallByVtbl(pCtl, IDX_QueryInterface, VarPtr(aGuid(0)), VarPtr(pOleObject))
    82.     If hResult < 0 Or pOleObject Is Nothing Then
    83.         Err.Raise IIf(hResult < 0, hResult, E_NOINTERFACE), "IUnknown.QueryInterface(IID_IOleObject)"
    84.     End If
    85.     hResult = DispCallByVtbl(pOleObject, IDX_GetClientSite, VarPtr(pOleClientSite))
    86.     If hResult < 0 Or pOleClientSite Is Nothing Then
    87.         Err.Raise IIf(hResult < 0, hResult, E_NOINTERFACE), "IOleObject.GetClientSite"
    88.     End If
    89.     aGuid(0) = &H922EADA0: aGuid(1) = &H11CF3424  ' IID_IOleInPlaceSiteWindowless
    90.     aGuid(2) = &HAA0070B6: aGuid(3) = &HD8D64C00
    91.     hResult = DispCallByVtbl(pOleClientSite, IDX_QueryInterface, VarPtr(aGuid(0)), VarPtr(GetInPlaceSiteWindowless))
    92.     If hResult < 0 Or GetInPlaceSiteWindowless Is Nothing Then
    93.         Err.Raise IIf(hResult < 0, hResult, E_NOINTERFACE), "IUnknown.QueryInterface(IID_IOleInPlaceSiteWindowless)"
    94.     End If
    95. End Function
    96.  
    97. Private Function DispCallByVtbl(pUnk As IUnknown, ByVal lIndex As Long, ParamArray A() As Variant) As Variant
    98.     Const CC_STDCALL    As Long = 4
    99.     Dim lIdx            As Long
    100.     Dim vParam()        As Variant
    101.     Dim vType(0 To 63)  As Integer
    102.     Dim vPtr(0 To 63)   As Long
    103.     Dim hResult         As Long
    104.    
    105.     vParam = A
    106.     For lIdx = 0 To UBound(vParam)
    107.         vType(lIdx) = VarType(vParam(lIdx))
    108.         vPtr(lIdx) = VarPtr(vParam(lIdx))
    109.     Next
    110.     hResult = DispCallFunc(ObjPtr(pUnk), lIndex * 4, CC_STDCALL, vbLong, lIdx, vType(0), vPtr(0), DispCallByVtbl)
    111.     If hResult < 0 Then
    112.         Err.Raise hResult, "DispCallFunc"
    113.     End If
    114. End Function
    The idea is to use SetCapture on the IOleInPlaceSiteWindowless to keep MouseMove events coming even when the pointer goes outside the user-control's bounds.

    The meat of the code is in GetInPlaceSiteWindowless function which is using the recently somewhat popular DispCallByVtbl helper function.

    cheers,
    </wqw>

  9. #9
    gibra
    Guest

    Re: LabelPlus

    Quote Originally Posted by LeandroA View Post
    hi Gibra i can't reproduce or find its errorDoes anyone else have trouble compiling?
    I discovered the cause:
    because all the projects have the same name (Proyecto1), and in the Property page the LabelPlus1 object refere to the Proyecto1 name,
    when I change the name project of sample, i.e. Proyecto1 to MenuLabelPlus, the name change on the Property page (file) also.
    Therefore, when I running another project, the previous project name Proyecto1 is not recognized.

    Solution:
    So I create a copy of the common files:
    PD_icons.RES, LabelPlus.ctl, LabelPlus.ctx, PropPagLP.pag and PropPagLP.pgx
    in the project folder, then update the project Name with 'new' current project name.
    Last edited by gibra; Feb 15th, 2020 at 03:35 PM.

  10. #10
    Addicted Member
    Join Date
    May 2016
    Location
    China
    Posts
    197

    Re: LabelPlus

    Amazing and incredible! Expect to release vb.net version in the future!

    The login example icon is not displayed clearly.

    Name:  无标题.jpg
Views: 2946
Size:  37.1 KB
    QQ: 289778005

  11. #11

    Thread Starter
    Hyperactive Member
    Join Date
    Dec 2008
    Location
    Argentina
    Posts
    439

    Re: LabelPlus

    Hi wqweto, very interesting routine, unfortunately it would not be effective with this control since if a label is inside the other one, the one inside it does not receive the mouse enter event.
    Already in the next version I am implementing MouseOver and MouseOut (they are different from MouseEnter and MouseLeave)
    Thank you for your contribution
    leandroascierto.com Visual Basic 6 projects

  12. #12

    Thread Starter
    Hyperactive Member
    Join Date
    Dec 2008
    Location
    Argentina
    Posts
    439

    Re: LabelPlus

    @ChenLin surely its DPI is greater than 100, so I recommend that you compile the project and execute it so you will notice it correctly.
    leandroascierto.com Visual Basic 6 projects

  13. #13
    PowerPoster
    Join Date
    Feb 2017
    Posts
    5,119

    Re: LabelPlus

    Thank you very much Leandro, I think I will use it.

  14. #14
    Addicted Member
    Join Date
    Jul 2017
    Posts
    233

    Re: LabelPlus

    Absolutely fabulous ,

    I am big fan of firenze label and yes it had some limitations . Most of them are eliminated here . One of them was how it implemented mouse enter and exit events . So , I second weqweto`s suggestion .

  15. #15
    Addicted Member
    Join Date
    May 2016
    Location
    China
    Posts
    197

    Re: LabelPlus

    Quote Originally Posted by LeandroA View Post
    @ChenLin surely its DPI is greater than 100, so I recommend that you compile the project and execute it so you will notice it correctly.
    Make sure the DPI is 100. I tested it on all three computers. The operating system distribution is windows server, windows7, windows 10, and all of them are compiled and tested.
    QQ: 289778005

  16. #16
    PowerPoster
    Join Date
    Feb 2017
    Posts
    5,119

    Re: LabelPlus

    Hello, JFY I tested here at 125% (120 DPI) on Windows 10 v1909 and it looked OK, no problem.
    I tested it in the IDE and it is manifested for common controls and DPI aware.

  17. #17
    Fanatic Member
    Join Date
    Aug 2016
    Posts
    683

    Re: LabelPlus

    Quote Originally Posted by LeandroA View Post
    @ChenLin surely its DPI is greater than 100, so I recommend that you compile the project and execute it so you will notice it correctly.
    i have the same question..

    can set picturesetwidth=32 may be show completely.

    picture can not stretch.may you can add this function....

  18. #18
    Addicted Member
    Join Date
    May 2016
    Location
    China
    Posts
    197

    Re: LabelPlus

    Quote Originally Posted by xxdoc123 View Post
    i have the same question..

    can set picturesetwidth=32 may be show completely.

    picture can not stretch.may you can add this function....

    Thank you @ xxdoc123, I tested your method and it works, as long as it is set to more than 20.
    QQ: 289778005

  19. #19

  20. #20
    Addicted Member shagratt's Avatar
    Join Date
    Jul 2019
    Location
    Argentina
    Posts
    198

    Re: LabelPlus

    Hi Leandro! I'm wondering... In DrawAcrylicBlur(...) you call "GdipCreateEffect(&H633C80A4, &H482B1843, &H28BEF29E, &HD4FDC534, lEffect)" , but at the end there is no call to "GdipDeleteEffect(lEffect)". Could it be a leak of a GDI object or it is intended?

  21. #21

    Thread Starter
    Hyperactive Member
    Join Date
    Dec 2008
    Location
    Argentina
    Posts
    439

    Re: LabelPlus

    Quote Originally Posted by shagratt View Post
    Hi Leandro! I'm wondering... In DrawAcrylicBlur(...) you call "GdipCreateEffect(&H633C80A4, &H482B1843, &H28BEF29E, &HD4FDC534, lEffect)" , but at the end there is no call to "GdipDeleteEffect(lEffect)". Could it be a leak of a GDI object or it is intended?

    Ups! very true, I forgot that detail, thanks for advising.
    leandroascierto.com Visual Basic 6 projects

  22. #22
    Addicted Member shagratt's Avatar
    Join Date
    Jul 2019
    Location
    Argentina
    Posts
    198

    Re: LabelPlus

    Quote Originally Posted by LeandroA View Post
    Ups! very true, I forgot that detail, thanks for advising.
    Still leaking...mmm... its also missing "Call GdipDisposeImage(hImage)" ! Almost missed that one.
    In the end I changed it to:

    Code:
            'Cleanup
            Call GdipDeleteBrush(hBrush)
            Call GdipDeleteGraphics(hGraphics2)
            Call GdipDisposeImage(hImage)
            Call GdipDisposeImage(hImage2)
            Call GdipDeleteEffect(lEffect)

  23. #23
    Fanatic Member
    Join Date
    Aug 2011
    Location
    Palm Coast, FL
    Posts
    515

    Re: LabelPlus

    Looks very useful! Is there any documentation other than the included samples?

  24. #24
    Fanatic Member Black_Storm's Avatar
    Join Date
    Sep 2007
    Location
    any where
    Posts
    579

    Re: LabelPlus

    when i want open samples use projects i can see just this error : "expersion too complex" how can open projects without this error.because i can open projects now.

    Name:  1.jpg
Views: 2349
Size:  26.8 KB

    or

    Name:  2.jpg
Views: 2355
Size:  20.6 KB

  25. #25
    Lively Member
    Join Date
    Feb 2006
    Posts
    106

    Re: LabelPlus

    Unicode caption in IDE - property pages like TextBoxW from Krools Common Controls, can be implemented?
    Name:  2020-08-10_155737.png
Views: 2053
Size:  7.7 KB

  26. #26

    Thread Starter
    Hyperactive Member
    Join Date
    Dec 2008
    Location
    Argentina
    Posts
    439

    Re: LabelPlus

    Quote Originally Posted by cliv View Post
    Unicode caption in IDE - property pages like TextBoxW from Krools Common Controls, can be implemented?
    Name:  2020-08-10_155737.png
Views: 2053
Size:  7.7 KB
    Hi Cliv, I think I did not understand the question correctly, but if you refer to putting a unicode text at design time you can do it through the properties page, as I did not want to subclassify I put a button to the right of the text box to input , that text box is unicode.
    leandroascierto.com Visual Basic 6 projects

  27. #27
    Lively Member
    Join Date
    Feb 2006
    Posts
    106

    Re: LabelPlus

    Quote Originally Posted by LeandroA View Post
    I think I did not understand the question correctly.
    yes, i mean input unicode in the IDE using properties page ... but i am not able to input romanian characters in a English OS directly from keyboard (with ROU keyboard layout selected)
    Name:  2020-08-12_084825.png
Views: 2159
Size:  9.9 KB
    Name:  2020-08-12_085847.png
Views: 2100
Size:  7.8 KB

    ...thank you for support
    Last edited by cliv; Aug 12th, 2020 at 01:19 AM.

  28. #28

    Thread Starter
    Hyperactive Member
    Join Date
    Dec 2008
    Location
    Argentina
    Posts
    439

    Re: LabelPlus

    Quote Originally Posted by cliv View Post
    yes, i mean input unicode in the IDE using properties page ... but i am not able to input romanian characters in a English OS directly from keyboard (with ROU keyboard layout selected)
    Name:  2020-08-12_084825.png
Views: 2159
Size:  9.9 KB
    Name:  2020-08-12_085847.png
Views: 2100
Size:  7.8 KB

    ...thank you for support
    ok now I understand, but I don't know what the reason is, that is where my knowledge goes, I'm not sure if it's because of the input method or GDI +, maybe someone can provide some information
    leandroascierto.com Visual Basic 6 projects

  29. #29
    Lively Member
    Join Date
    Feb 2006
    Posts
    106

    Re: LabelPlus

    OS: Windows 10 Pro Version 1903 - x64, language: english, keyboard: english(US keyboard), romanian(standard keyboard).
    Switch keyboard layout to ROU and input unicode in the IDE using properties page:

    1. LabelPlus - not working (direct type in IDE properties page)
    2. LabelPlus - working (paste from clipboard - input unicode in Notepad and then copy to clipboard)
    3. TextBoxW (Krools Common Controls) - working (direct type in IDE properties page)
    4. UniSuiteFree (Textbox, Label, ...) Dana Seaman - CyberActiveX - working (direct type in IDE properties page)
    Name:  2020-08-13_083947.png
Views: 2128
Size:  17.1 KB
    Last edited by cliv; Aug 13th, 2020 at 12:48 AM.

  30. #30
    PowerPoster Arnoutdv's Avatar
    Join Date
    Oct 2013
    Posts
    5,989

    Re: LabelPlus

    I never understood why people insist to use the property window to set captions or whatever.
    Just set the correct value in the Form_Load

  31. #31
    New Member mirzaasif4249's Avatar
    Join Date
    Oct 2020
    Location
    Pakistan
    Posts
    4

    Re: LabelPlus

    I am a newbie and want to know to open another form with the click event of ucNavBar. Attachment 180400

  32. #32
    Lively Member
    Join Date
    Feb 2006
    Posts
    106

    Re: LabelPlus

    Quote Originally Posted by cliv View Post
    1. LabelPlus - not working (direct type in IDE properties page)
    People are all stressed about the PropertyBag not supporting Unicode, but that's not a problem. There is a problem with the actual properties window. That does NOT support Unicode, but if you're willing to build your own properties window (which can be done in VB6), you can circumvent that problem too. However, back to the PropertyBag. The problem is that .FRM files are written out in ANSI (which can't do Unicode), and the PropertyBag must be written out to these .FRM files. But there's also the .FRX files. Any binary stuff or non-ANSI stuff (including Unicode) is written into these .FRX files. Therefore, any Unicode fields we have in our custom controls must be coerced into these .FRX files and not the ANSI .FRM file. Here are two procedures for assisting with that. Just use them to go back and forth before writing your strings into the PropertyBag and everything will work. When you hit "save" that field of the PropertyBag will be written into the .FRX rather than the .FRM
    From here ...
    https://www.vbforums.com/showthread....=1#post4719635

  33. #33
    Fanatic Member
    Join Date
    Aug 2011
    Location
    Palm Coast, FL
    Posts
    515

    Re: LabelPlus

    Wow - what an impressive user control this seems to be. Working my way through the demo projects right now.

    Only thing missing is user documentation - that would make this perfection! Thanks Leandro!

  34. #34
    Fanatic Member
    Join Date
    Aug 2011
    Location
    Palm Coast, FL
    Posts
    515

    Re: LabelPlus

    I've been able to create a Chip UI component using this excellent control. One thing I can't figure out however is how to set a Picture for a label. I see many Picture related properties on the label's Property Page.

    Name:  LabelPlus picture properties.png
Views: 507
Size:  11.8 KB

    And in the AVG demo, I can see that LabelPlus13 has a picture set via the Custom property on the Property Page. But my labels don't have a Custom property...

    What am I missing? I'm looking for a simple .Picture property which can be set at design or runtime.

    Thanks in advance for any assistance you can provide.

    @LeandroA

  35. #35
    Member
    Join Date
    Aug 2023
    Posts
    56

    Re: LabelPlus

    Probably you forgot to add the properties page to your project, just only the control, take a look to that.

  36. #36
    Fanatic Member
    Join Date
    Aug 2011
    Location
    Palm Coast, FL
    Posts
    515

    Re: LabelPlus

    Quote Originally Posted by zx81sp View Post
    Probably you forgot to add the properties page to your project, just only the control, take a look to that.
    Thanks for your help with this. When I add the Property Page (PropPagLP.pag) from the demo into my project, I get a "Method or Data Member not found" error in the Property Page's cmdBrowse_Click code for this method "LabelPlus1.PictureFromStream" and several entries in a LOG file which is created.

    Attachment 190721


    Line 64: Class Proyecto1.LabelPlus of control LabelPlus1 was not a loaded control class.
    Line 70: The property name _ExtentX in LabelPlus1 is invalid.
    Line 71: The property name _ExtentY in LabelPlus1 is invalid.
    Line 72: The property name BorderCornerLeftTop in LabelPlus1 is invalid.
    Line 73: The property name BorderCornerRightTop in LabelPlus1 is invalid.
    Line 74: The property name BorderCornerBottomRight in LabelPlus1 is invalid.
    Line 75: The property name BorderCornerBottomLeft in LabelPlus1 is invalid.
    Line 76: The property name Caption in LabelPlus1 is invalid.
    Line 77: The property name CaptionBorderColor in LabelPlus1 is invalid.
    Line 87: The property name ShadowColorOpacity in LabelPlus1 is invalid.
    Line 88: The property name CallOutAlign in LabelPlus1 is invalid.
    Line 89: The property name CallOutWidth in LabelPlus1 is invalid.
    Line 90: The property name CallOutLen in LabelPlus1 is invalid.
    Line 92: The property name PictureArr in LabelPlus1 is invalid.

  37. #37
    Fanatic Member
    Join Date
    Aug 2011
    Location
    Palm Coast, FL
    Posts
    515

    Re: LabelPlus

    I have resolved the issue I was having with the Property Page.

    I had copied the Property Page from his demo project into my project folder. When I examined the property page in a text editor I saw that the definition for the LabelPlus1 control on the Property Page included his demo project name like this:
    "Begin Proyecto1.LabelPlus LabelPlus1".

    I simply had to change his project name to the name of my project.

    Probably a rookie mistake but I've never encountered this before.

  38. #38
    Member
    Join Date
    Aug 2023
    Posts
    56

    Re: LabelPlus

    Quote Originally Posted by AAraya View Post
    I have resolved the issue I was having with the Property Page.

    I had copied the Property Page from his demo project into my project folder. When I examined the property page in a text editor I saw that the definition for the LabelPlus1 control on the Property Page included his demo project name like this:
    "Begin Proyecto1.LabelPlus LabelPlus1".

    I simply had to change his project name to the name of my project.

    Probably a rookie mistake but I've never encountered this before.
    Some of Leandro's controls are attached to the name "proyecto1" and must be adapted to your project name but it worths because his controls are unbeilable.

  39. #39
    Fanatic Member
    Join Date
    Aug 2011
    Location
    Palm Coast, FL
    Posts
    515

    Re: LabelPlus

    Quote Originally Posted by zx81sp View Post
    Some of Leandro's controls are attached to the name "proyecto1" and must be adapted to your project name but it worths because his controls are unbeilable.
    Yes, his user controls are wonderful! The only oddity I've found is why I can't just simply set a .Picture() property on the user control at runtime. If I could do this, they would be perfect!

  40. #40
    Hyperactive Member
    Join Date
    Jun 2022
    Posts
    261

    Re: LabelPlus

    Quote Originally Posted by wqweto View Post
    Here is some sample code for hot-tracking without timers loosly based on Implementing Hot Tracking in an ActiveX control article.

    Place a Label1 on a new windowless user-control and try this code:

    thinBasic Code:
    1. Option Explicit
    2.  
    3. Private Declare Function GetCapture Lib "user32" () As Long
    4. Private Declare Function SetCapture Lib "user32" (ByVal hWnd As Long) As Long
    5. Private Declare Function ReleaseCapture Lib "user32" () As Long
    6. Private Declare Function DispCallFunc Lib "oleaut32" (ByVal pvInstance As Long, ByVal oVft As Long, ByVal lCc As Long, ByVal vtReturn As VbVarType, ByVal cActuals As Long, prgVt As Any, prgpVarg As Any, pvargResult As Variant) As Long
    7.  
    8. Private m_bDown                 As Boolean
    9.  
    10. Private Sub UserControl_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    11.     m_bDown = True
    12.     UserControl_MouseMove Button, Shift, X, Y
    13. End Sub
    14.  
    15. Private Sub UserControl_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    16.     m_bDown = False
    17.     UserControl_MouseMove Button, Shift, X, Y
    18. End Sub
    19.  
    20. Private Sub Label1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    21.     UserControl_MouseMove Button, Shift, Label1.Left + X, Label1.Top + Y
    22. End Sub
    23.  
    24. Private Sub UserControl_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    25.     On Error GoTo EH
    26.     If X >= 0 And X <= ScaleWidth And Y >= 0 And Y <= ScaleHeight Then
    27.         Label1.Caption = IIf(m_bDown, "Down", "Hot")
    28.     Else
    29.         Label1.Caption = IIf(m_bDown, "Down Outside", "Normal")
    30.     End If
    31.     If X >= 0 And X <= ScaleWidth And Y >= 0 And Y <= ScaleHeight Or m_bDown <> 0 Then
    32.         If Not pvGetCapture() Then
    33.             pvSetCapture True
    34.         End If
    35.     Else
    36.         If pvGetCapture() Then
    37.             pvSetCapture False
    38.         End If
    39.     End If
    40.     Exit Sub
    41. EH:
    42.     Debug.Print "UserControl_MouseMove "; Err.Description; Err.Source
    43. End Sub
    44.  
    45. Private Function pvGetCapture() As Boolean
    46.     Const IDX_GetCapture As Long = 19
    47.  
    48.     If UserControl.hWnd = 0 Then
    49.         If DispCallByVtbl(GetInPlaceSiteWindowless(Me), IDX_GetCapture) = 0 Then ' S_OK
    50.             pvGetCapture = True
    51.         End If
    52.     ElseIf GetCapture() = UserControl.hWnd Then
    53.         pvGetCapture = True
    54.     End If
    55. End Function
    56.  
    57. Private Sub pvSetCapture(ByVal bValue As Boolean)
    58.     Const IDX_SetCapture As Long = 20
    59.    
    60.     If UserControl.hWnd = 0 Then
    61.         DispCallByVtbl GetInPlaceSiteWindowless(Me), IDX_SetCapture, CLng(-bValue)
    62.     Else
    63.         If bValue Then
    64.             Call SetCapture(UserControl.hWnd)
    65.         Else
    66.             Call ReleaseCapture
    67.         End If
    68.     End If
    69. End Sub
    70.  
    71. Private Function GetInPlaceSiteWindowless(pCtl As IUnknown) As IUnknown
    72.     Const E_NOINTERFACE As Long = &H80004002
    73.     Const IDX_QueryInterface As Long = 0
    74.     Const IDX_GetClientSite As Long = 4
    75.     Dim aGuid(0 To 3)   As Long
    76.     Dim pOleObject      As IUnknown
    77.     Dim pOleClientSite  As IUnknown
    78.     Dim hResult         As Long
    79.    
    80.     aGuid(0) = &H112: aGuid(2) = &HC0: aGuid(3) = &H46000000 ' IID_IOleObject
    81.     hResult = DispCallByVtbl(pCtl, IDX_QueryInterface, VarPtr(aGuid(0)), VarPtr(pOleObject))
    82.     If hResult < 0 Or pOleObject Is Nothing Then
    83.         Err.Raise IIf(hResult < 0, hResult, E_NOINTERFACE), "IUnknown.QueryInterface(IID_IOleObject)"
    84.     End If
    85.     hResult = DispCallByVtbl(pOleObject, IDX_GetClientSite, VarPtr(pOleClientSite))
    86.     If hResult < 0 Or pOleClientSite Is Nothing Then
    87.         Err.Raise IIf(hResult < 0, hResult, E_NOINTERFACE), "IOleObject.GetClientSite"
    88.     End If
    89.     aGuid(0) = &H922EADA0: aGuid(1) = &H11CF3424  ' IID_IOleInPlaceSiteWindowless
    90.     aGuid(2) = &HAA0070B6: aGuid(3) = &HD8D64C00
    91.     hResult = DispCallByVtbl(pOleClientSite, IDX_QueryInterface, VarPtr(aGuid(0)), VarPtr(GetInPlaceSiteWindowless))
    92.     If hResult < 0 Or GetInPlaceSiteWindowless Is Nothing Then
    93.         Err.Raise IIf(hResult < 0, hResult, E_NOINTERFACE), "IUnknown.QueryInterface(IID_IOleInPlaceSiteWindowless)"
    94.     End If
    95. End Function
    96.  
    97. Private Function DispCallByVtbl(pUnk As IUnknown, ByVal lIndex As Long, ParamArray A() As Variant) As Variant
    98.     Const CC_STDCALL    As Long = 4
    99.     Dim lIdx            As Long
    100.     Dim vParam()        As Variant
    101.     Dim vType(0 To 63)  As Integer
    102.     Dim vPtr(0 To 63)   As Long
    103.     Dim hResult         As Long
    104.    
    105.     vParam = A
    106.     For lIdx = 0 To UBound(vParam)
    107.         vType(lIdx) = VarType(vParam(lIdx))
    108.         vPtr(lIdx) = VarPtr(vParam(lIdx))
    109.     Next
    110.     hResult = DispCallFunc(ObjPtr(pUnk), lIndex * 4, CC_STDCALL, vbLong, lIdx, vType(0), vPtr(0), DispCallByVtbl)
    111.     If hResult < 0 Then
    112.         Err.Raise hResult, "DispCallFunc"
    113.     End If
    114. End Function
    The idea is to use SetCapture on the IOleInPlaceSiteWindowless to keep MouseMove events coming even when the pointer goes outside the user-control's bounds.

    The meat of the code is in GetInPlaceSiteWindowless function which is using the recently somewhat popular DispCallByVtbl helper function.

    cheers,
    </wqw>
    @wqweto
    The idea is to use SetCapture on the IOleInPlaceSiteWindowless to keep MouseMove events coming even when the pointer goes outside the user-control's bounds.
    Could you elaborate on this ? Does this method still rely on the label being above the windowless control while leaving some space between the bounding rect of the label and the bounding rectangle of the windowless control?

    Thanks.

Page 1 of 2 12 LastLast

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width