Level Extreme platform
Subscription
Corporate profile
Products & Services
Support
Legal
Français
Change color of a substring of a caption
Message
From
01/11/2019 13:23:09
 
 
To
05/03/2019 14:52:52
General information
Forum:
Visual FoxPro
Category:
Coding, syntax & commands
Miscellaneous
Thread ID:
01666960
Message ID:
01671774
Views:
115
I had occasion to use this source code today. I needed to add some hypertext to a form, and by having each element like this I could extend it to display custom link-like objects.

>>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
Reply
Map
View

Click here to load this message in the networking platform