Results 1 to 30 of 30

Thread: LabelPlus

  1. #1

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

    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: 1225
Size:  22.7 KB
    Name:  LabelPlus2.jpg
Views: 1227
Size:  40.6 KBName:  LabelPlus3.jpg
Views: 1216
Size:  40.0 KBName:  LabelPlus4.jpg
Views: 1227
Size:  57.4 KBName:  LabelPlus5.jpg
Views: 1221
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
    Frenzied Member gibra's Avatar
    Join Date
    Oct 2009
    Location
    ITALY
    Posts
    1,697

    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.

  5. #5
    Addicted Member
    Join Date
    Jun 2016
    Location
    Espaņa
    Posts
    152

    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

  7. #7

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

    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
    Posts
    2,100

    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
    Frenzied Member gibra's Avatar
    Join Date
    Oct 2009
    Location
    ITALY
    Posts
    1,697

    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.

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

    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: 843
Size:  37.1 KB
    QQ: 289778005

  11. #11

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

    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
    264

    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
    2,406

    Re: LabelPlus

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

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

    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
    188

    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
    2,406

    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
    Hyperactive Member
    Join Date
    Aug 2016
    Posts
    412

    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
    188

    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
    129

    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
    264

    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
    129

    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
    Hyperactive Member
    Join Date
    Aug 2011
    Location
    Palm Coast, FL
    Posts
    342

    Re: LabelPlus

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

  24. #24
    Addicted Member Black_Storm's Avatar
    Join Date
    Sep 2007
    Posts
    241

    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: 273
Size:  26.8 KB

    or

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

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

    Re: LabelPlus

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

  26. #26

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

    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: 116
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
    70

    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: 84
Size:  9.9 KB
    Name:  2020-08-12_085847.png
Views: 84
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
    264

    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: 84
Size:  9.9 KB
    Name:  2020-08-12_085847.png
Views: 84
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
    70

    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: 37
Size:  17.1 KB
    Last edited by cliv; Yesterday at 12:48 AM.

  30. #30
    PowerPoster Arnoutdv's Avatar
    Join Date
    Oct 2013
    Posts
    3,862

    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

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