Level Extreme platform
Subscription
Corporate profile
Products & Services
Support
Legal
Français
Change color of a substring of a caption
Message
From
05/03/2019 14:52:52
 
 
To
05/03/2019 14:12:59
Cetin Basoz
Engineerica Inc.
Izmir, Turkey
General information
Forum:
Visual FoxPro
Category:
Coding, syntax & commands
Miscellaneous
Thread ID:
01666960
Message ID:
01666998
Views:
155
Likes (2)
>I just read the code quickly and I can see that it wouldn't work for this problem. You might test it yourself to see why it wouldn't. For example try typing "o".
>
>PS: You could use atc() for a simplier lnAt = at(lower...) and instead of abusing & you could use GetPem().

I forget ATC() exists. And I don't mind using ampersands.

May still have bugs.
PUBLIC gcWords
gcWords = "these_these are_are some_some words_words created_created to_to populate_populate the_the checkbox_checkbox controls_controls"

lo = CREATEOBJECT("myClass")
lo.visible = .t.
READ EVENTS


DEFINE CLASS myClass AS Form
    Caption     = "Checkbox Search Test"
    AutoCenter  = .t.
    Width       = 250
    Height      = 300

    PROCEDURE Destroy
        CLEAR EVENTS
    ENDPROC

    PROCEDURE Init
    LOCAL lnI, lcName, lo

        * Add checkboxes
        FOR lnI = 1 TO 10
            lcName = "checkbox" + TRANSFORM(lnI - 1)
            thisForm.AddObject(lcName, "myCheckbox")
            lo          = thisForm.&lcName
            lo.Left     = 5
            lo.Top      = ((lnI + 1) * lo.Height)
            lo.Visible  = .t.
        NEXT

        * Add search string
        thisForm.AddObject("Label", "Label")
        thisForm.Label.Caption      = "Search:"
        thisForm.Label.AutoSize     = .t.
        thisForm.Label.Visible      = .t.
        thisForm.Label.Left         = 5
        thisForm.Label.Top          = 7

        * Add textbox
        thisForm.AddObject("txtSearch", "myTextbox")
        thisform.txtSearch.Top      = 5
        thisForm.txtSearch.Left     = thisForm.Label.left + thisForm.Label.Width + 5
        thisForm.txtSearch.Visible  = .t.
        thisForm.txtSearch.SetFocus
    ENDPROC
ENDDEFINE

DEFINE CLASS myTextbox as TextBox
    PROCEDURE InteractiveChange
    LOCAL lnI
        FOR lnI = 1 TO thisForm.ControlCount
            IF PEMSTATUS(thisForm.Controls[lnI], "mth_highlight", 5)
                thisForm.Controls[lnI].mth_highlight(ALLTRIM(this.Value))
            ENDIF
        NEXT
ENDDEFINE

DEFINE CLASS myLabel AS Label
    BorderStyle = 0
    BorderWidth = 0
ENDDEFINE

DEFINE CLASS myCheckbox AS Container
    lo          = .NULL.
    loLbl       = .NULL.
    BorderStyle = 0
    BorderWidth = 0
    Width       = 300
    Height      = 20

    PROCEDURE Init
    LOCAL lcCheckBox, lcLabel
        * Checkbox
        lcCheckbox          = SYS(2015)
        this.AddObject(lcCheckbox, "CheckBox")
        this.lo             = this.&lcCheckBox
        this.lo.Caption     = SPACE(0)
        this.lo.AutoSize    = .t.
        this.lo.Visible     = .t.

        * Label for display
        lcLabel             = SYS(2015)
        this.AddObject(lcLabel, "Label")
        this.loLbl          = this.&lcLabel
        this.loLbl.Caption  = GETWORDNUM(gcWords, 1 + INT(VAL(RIGHT(this.Name, 1))))
        this.loLbl.AutoSize = .t.
        this.loLbl.Left     = this.lo.left + this.lo.width + 5
        this.loLbl.Visible  = .t.
    ENDPROC

    PROCEDURE mth_highlight
    LPARAMETERS tcSearchText
    LOCAL lnI, lnAt, lcText

        * Remove any previous highlighting
        this.mth_unhighlight

        * Iterate while there are things to highlight
        lnI     = 1
        lcText  = this.loLbl.Caption
        DO WHILE LEN(lcText) > 0
            * Search for another instance
            lnAt = ATC(tcSearchText, lcText)
            IF lnAt = 0
                * All done
                this.loLbl.visible = (lnI = 1)
                EXIT
            ENDIF

            * Display the label portions
            IF lnAt = 1
                * It's at the beginning, only one label
                this.mth_new_label(@lnI,    LEFT(lcText, LEN(tcSearchText)),            .t.)

            ELSE
                * It's somewhere in the middle, two labels required
                this.mth_new_label(@lnI,    LEFT(lcText, lnAt - 1),                     .f.)
                this.mth_new_label(@lnI,    SUBSTR(lcText, lnAt, LEN(tcSearchText)),    .t.)
            ENDIF

            * Move past that content
            lcText = SUBSTR(lcText, lnAt + LEN(tcSearchText))
        ENDDO

        * Is there text remaining?
        IF lnI != 1 AND NOT EMPTY(lcText)
            * Yes
            this.mth_new_label(@lnI, lcText, .f.)
        ENDIF
    ENDPROC

    PROCEDURE mth_new_label
    LPARAMETERS lnI, tcText, tlHighlight
        * Make sure we have a label
        IF TYPE("this.loLbls[" + TRANSFORM(lnI) + "]") != "O"
            DIMENSION this.loLbls[lnI]
            lcLabel= SYS(2015)
            this.AddObject(lcLabel, "Label")
            this.loLbls[lnI] = this.&lcLabel
        ENDIF

        * Set the content
        this.loLbls[lnI].Caption    = tcText
        this.loLbls[lnI].Left       = IIF(lnI = 1, this.loLbl.left, this.loLbls[lnI - 1].Left + this.loLbls[lnI - 1].Width - 2)
        this.loLbls[lnI].AutoSize   = .t.
        this.loLbls[lnI].Visible    = .t.
        this.loLbls[lnI].BackColor  = IIF(tlHighlight, RGB(0,255,0), this.loLbl.BackColor)
        this.loLbls[lnI].ForeColor  = IIF(tlHighlight, RGB(0, 0, 0), this.loLbl.ForeColor)

        * Move to next item
        lnI = lnI + 1
    ENDPROC

    PROCEDURE mth_unhighlight
    LOCAL lnI
        this.loLbl.visible = .t.
        IF TYPE("this.loLbls[1]") = "U"
            this.AddProperty("loLbls[1]", .NULL.)
        ENDIF
        FOR lnI = 1 TO ALEN(this.loLbls, 1)
            IF TYPE("this.loLbls[lnI]") = "O"
                TRY
                    this.RemoveObject(this.loLbls[lnI].Name)
                CATCH
                ENDTRY
            ENDIF
            this.loLbls[lnI] = .NULL.
        NEXT
        DIMENSION this.loLbls[1]
        this.loLbls[1] = .f.
    ENDPROC
ENDDEFINE
Previous
Next
Reply
Map
View

Click here to load this message in the networking platform