Как реализовать подсветку подстроки в строке ?

Форум » GUI » Как реализовать подсветку подстроки в строке ? » Ответить

Как реализовать подсветку подстроки в строке ?

Softlog86: Подскажите способ реализовать подсветку фрагмента текста в строке ? Идеально в виде какого-нибудь контрола вроде LABEL с указанием цвета выделения и подстроки что красить этим цветом .

Ответов - 7

SergKis: Softlog86 Набросок (не проверял) [pre2] CLASS OutL VAR nLine INIT 0 VAR cForm INIT _HMG_ThisFormName VAR cTxt VAR aTxt VAR aSub INIT hb_Hash() VAR cFont INIT _HMG_DefaultFontName VAR nSize INIT _HMG_DefaultFontSize VAR FColor VAR lBold INIT .F. VAR lItalic INIT .F. VAR lUnderl INIT .F. METHOD New( cTxt, nLine ) INLINE ( ::cTxt := AllTrim(cTxt), ::aTxt := hb_ATokens(cTxt, " "), ; ::nLine := iif( empty(nLine), ::nLine, nLine ), Self ) METHOD Out() METHOD Add( cSub, FColor, lBold, lItalic, lUnderl ) INLINE ( hb_HSet(::aSub, lower(cSub), {FColor, lBold, lItalic, lUnderl}) ) ENDCLASS METHOD Out( nRow, nCol ) CLASS OutL Local cForm := ::cForm Local a,c,i,j,l, w := 0, h := 0 Local k := ::nLine Local y := nRow Local x := nCol Local FC, lB, lI, lU Local cF := ::cFont Local nS := ::nSize Local cC := "_Out_" Do While _IsControlDefined(cC + hb_ntos(k + 1)), cForm) k++ EndDo If ::nLine != k ::nLine := k EndIf For i := 1 To len(aTxt) c := cC + hb_ntos(k + i) j := aTxt[ i ] + " " a := hb_HGetDef(::aSub, lower(aTxt[ i ]), NIL) If ! empty(a) FC := a[1] lB := !Empty(a[2]) lI := !Empty(a[3]) lU := !Empty(a[4]) Else FC := ::FColor lB := ::lBold lI := ::lItalic lU := ::lUnderl EndIf DEFINE LABEL &c ROW y COL x VALUE j FONTNAME cF FONTSIZE nS FONTBOLD lB FONTITALIC lI FONTUNDERLINE lU FONTCOLOR FC VCENTERALIGN .T. AUTOSIZE .T. END LABEL l := This.&(c).Width x += l w += l h := Max(h, This.&(c).Height) Next RETURN { h, w } [/pre2] Применять y := 10 x := 20 oL := OutL():New("Aaaa 0000 bbbb cccc ddddd 12345 33") oL:Add( "0000", {200,255,255}, .T. ) oL:Add( "cccc", {200,255,255}, .T., .T. ) a := oL:Out(y, x) y += a[1] + 10 oL := OutL():New("Bbbbb 0000 DDDDD cccc EEEEEEEEE") oL:Add( "0000", {200,255,255}, .T. ) oL:Add( "cccc", {200,255,255}, .T., .T. ) a := oL:Out(y, x) y += a[1] + 10 ...

SergKis: Работающий вариант [pre2] /* * MINIGUI - Harbour Win32 GUI library Demo * */ #include "minigui.ch" #include "hbclass.ch" *----------------------------------- FUNC MAIN() *----------------------------------- Local cTxt, aTxt, oLbl Local h := 0, w := 0, s := 10 Local BColor := {220, 220, 220} Local a, c, y, x Local cFile := "test.txt" SET FONT TO "Arial", 12 If ! file(cFile) Create_txt(cFile) EndIf cTxt := hb_memoread(cFile) c := iif( CRLF $ cTxt, CRLF, chr(10) ) aTxt := hb_ATokens(cTxt, c) DEFINE WINDOW _T AT 0,0 WIDTH 100 HEIGHT 100 TITLE 'MiniGUI Label Demo' ; MAIN BACKCOLOR BColor oLbl := cLbl():New(BColor) oLbl:Add('Harbour' , BLUE ) oLbl:Add('Project' , GREEN , .T., .F., .T.) oLbl:Add('Free' , BLUE ) oLbl:Add('Software' , GREEN , .T., .F., .T.) oLbl:Add('General' , BLUE ) oLbl:Add('Public' , YELLOW, .T., .T., .T.) oLbl:Add('License' , BLUE ) oLbl:Add('exception', RED ) y := x := s FOR EACH cTxt IN aTxt if ! empty(cTxt) oLbl:Def(cTxt) a := oLbl:Out(y, x) y += a[1] + s h += a[1] + s w := Max(w, a[2]) EndIf NEXT h += s * 2 w += s * 2 This.Width := w + GetBorderWidth () * 2 This.Height := h + GetBorderHeight() * 2 + GetTitleHeight() END WINDOW CENTER WINDOW _T ACTIVATE WINDOW _T RETURN Nil //////////////////////////////////////////////////////////////////////////////// CLASS cLbl VAR cForm VAR cFont VAR nSize VAR aSub VAR aTxt VAR cTxt VAR BColor VAR FColor VAR lBold INIT .F. VAR lItalic INIT .F. VAR lUnderl INIT .F. VAR nLbl INIT 0 VAR cLbl INIT '_Out_' VAR cSpace INIT ' ' METHOD New( BColor, cFont, nSize ) METHOD Out( nRow, nCol ) METHOD Def( cTxt, cChr ) METHOD Add( cSub, FColor, lBold, lItalic, lUnderl ) INLINE ; ( hb_HSet(::aSub, lower(cSub), { FColor, lBold, lItalic, lUnderl }) ) ENDCLASS METHOD New( BColor, cFont, nSize ) CLASS cLbl ::cForm := _HMG_ThisFormName ::cFont := _HMG_DefaultFontName ::nSize := _HMG_DefaultFontSize ::aSub := hb_Hash() If BColor != Nil; ::BColor := BColor EndIf If cFont != Nil; ::cFont := cFont EndIf If nSize != Nil; ::nSize := nSize Endif RETURN Self METHOD Def( cTxt, cChr ) CLASS cLbl Default cChr := ' ' If hb_IsChar(cTxt) ::cTxt := Alltrim(cTxt) ::aTxt := hb_ATokens(::cTxt, cChr) ElseIf hb_IsArray(cTxt) ::cTxt := '' ::aTxt := cTxt Endif RETURN Self METHOD Out( nRow, nCol ) CLASS cLbl Local a,c,i,j,l, w := 0, h := 0 Local FC, lB, lI, lU Local cWnd := ::cForm Local y := nRow Local x := nCol Local cF := ::cFont Local nS := ::nSize Local BC := ::BColor Local cS := ::cSpace Do While _IsControlDefined(::cLbl + hb_ntos(::nLbl), cWnd) ::nLbl += 1 EndDo For i := 1 To len(::aTxt) c := ::cLbl + hb_ntos(::nLbl) j := ::aTxt[ i ] a := hb_HGetDef(::aSub, lower(j), NIL) If ! empty(a) FC := a[1] lB := !Empty(a[2]) lI := !Empty(a[3]) lU := !Empty(a[4]) Else FC := ::FColor lB := ::lBold lI := ::lItalic lU := ::lUnderl EndIf ::nLbl += 1 DEFINE LABEL &c ROW y COL x VALUE j + cS FONTNAME cF FONTSIZE nS FONTBOLD lB FONTITALIC lI FONTUNDERLINE lU BACKCOLOR BC FONTCOLOR FC VCENTERALIGN .T. AUTOSIZE .T. END LABEL l := This.&(c).Width x += l w += l h := Max( h, This.&(c).Height ) Next RETURN { h, w } FUNC Create_txt( cFile ) Local t t := 'This exception applies only to the code released by the Harbour' + CRLF t += 'Project under the name Harbour. If you copy code from other' + CRLF t += 'Harbour Project or Free Software Foundation releases into a copy of' + CRLF t += 'Harbour, as the General Public License permits, the exception does' + CRLF t += 'not apply to the code that you add in this way. To avoid misleading'+ CRLF t += 'anyone as to the status of such modified files, you must delete' + CRLF t += 'this exception notice from them.' + CRLF hb_memowrit(cFile, t) RETURN Nil [/pre2]

Петр: SergKis пишет: Работающий вариант Хороший пример, надеюсь когда то в MiniGUI 'нативный' colored label появится.

SergKis: Добавил в пример tooltip, HandCursor, bAction [pre2] /* * MINIGUI - Harbour Win32 GUI library Demo * */ #include "minigui.ch" #include "hbclass.ch" *----------------------------------- FUNC MAIN() *----------------------------------- Local cTxt, aTxt, oLbl Local h := 0, w := 0, s := 10 Local BColor := {220, 220, 220} Local a, c, y, x Local cFile := "test.txt" SET FONT TO "Arial", 12 If ! file(cFile) Create_txt(cFile) EndIf cTxt := hb_memoread(cFile) c := iif( CRLF $ cTxt, CRLF, chr(10) ) aTxt := hb_ATokens(cTxt, c) DEFINE WINDOW _T AT 0,0 WIDTH 100 HEIGHT 100 TITLE 'MiniGUI Label Demo' ; MAIN BACKCOLOR BColor oLbl := cLbl():New(BColor) oLbl:Add('Harbour' , BLUE ) oLbl:Add('Project' , GREEN , .T., .F., .T.) oLbl:Add('Free' , BLUE ) oLbl:Add('Software' , GREEN , .T., .T., .T., 'Aaaaaaaaa') oLbl:Add('General' , BLUE ) oLbl:Add('Public' , YELLOW, .T., .F., .T., 'Click my', .T., {|o| MsgBox( _GetValue( _HMG_ThisControlName, _HMG_ThisFormName ), "INFO" ) }) oLbl:Add('License' , BLUE ) oLbl:Add('exception', RED ) y := x := s FOR EACH cTxt IN aTxt if ! empty(cTxt) oLbl:Def(cTxt) a := oLbl:Out(y, x) y += a[1] + s h += a[1] + s w := Max(w, a[2]) EndIf NEXT h += s * 2 w += s * 2 This.Width := w + GetBorderWidth () * 2 This.Height := h + GetBorderHeight() * 2 + GetTitleHeight() END WINDOW CENTER WINDOW _T ACTIVATE WINDOW _T RETURN Nil //////////////////////////////////////////////////////////////////////////////// CLASS cLbl VAR cForm VAR cFont VAR nSize VAR aSub VAR aTxt VAR cTxt VAR BColor VAR FColor VAR lBold INIT .F. VAR lItalic INIT .F. VAR lUnderl INIT .F. VAR nLbl INIT 0 VAR cLbl INIT '_Out_' VAR cSpace INIT ' ' METHOD New( BColor, cFont, nSize ) METHOD Out( nRow, nCol ) METHOD Def( cTxt, cChr ) METHOD Add( cSub, FColor, lBold, lItalic, lUnderl, cTool, lHand, bAct ) INLINE ; ( hb_HSet(::aSub, lower(cSub), { FColor, lBold, lItalic, lUnderl, cTool, lHand, bAct }) ) METHOD Block() ENDCLASS METHOD New( BColor, cFont, nSize ) CLASS cLbl ::cForm := _HMG_ThisFormName ::cFont := _HMG_DefaultFontName ::nSize := _HMG_DefaultFontSize ::aSub := hb_Hash() If BColor != Nil; ::BColor := BColor EndIf If cFont != Nil; ::cFont := cFont EndIf If nSize != Nil; ::nSize := nSize Endif RETURN Self METHOD Def( cTxt, cChr ) CLASS cLbl Default cChr := ' ' If hb_IsChar(cTxt) ::cTxt := Alltrim(cTxt) ::aTxt := hb_ATokens(::cTxt, cChr) ElseIf hb_IsArray(cTxt) ::cTxt := '' ::aTxt := cTxt Endif RETURN Self METHOD Out( nRow, nCol ) CLASS cLbl Local a,c,i,j,l, w := 0, h := 0 Local FC, lB, lI, lU, cT, mH Local cWnd := ::cForm Local y := nRow Local x := nCol Local cF := ::cFont Local nS := ::nSize Local BC := ::BColor Local cS := ::cSpace Local o := Self Do While _IsControlDefined(::cLbl + hb_ntos(::nLbl), cWnd) ::nLbl += 1 EndDo For i := 1 To len(::aTxt) c := ::cLbl + hb_ntos(::nLbl) j := ::aTxt[ i ] a := hb_HGetDef(::aSub, lower(j), NIL) If ! empty(a) FC := a[1] lB := !Empty(a[2]) lI := !Empty(a[3]) lU := !Empty(a[4]) cT := a[5] lH := !Empty(a[6]) Else FC := ::FColor lB := ::lBold lI := ::lItalic lU := ::lUnderl cT := Nil lH := .F. EndIf ::nLbl += 1 DEFINE LABEL &c ROW y COL x VALUE j + cS FONTNAME cF FONTSIZE nS FONTBOLD lB FONTITALIC lI FONTUNDERLINE lU BACKCOLOR BC FONTCOLOR FC TOOLTIP cT VCENTERALIGN .T. AUTOSIZE .T. ACTION o:Block() If lH ON MOUSEHOVER CursorHand() EndIf END LABEL l := This.&(c).Width x += l w += l h := Max( h, This.&(c).Height ) Next RETURN { h, w } METHOD Block() CLASS cLbl Local v := trim(_GetValue(_HMG_ThisControlName, ::cForm)) Local a := hb_HGetDef(::aSub, lower(v), NIL) If hb_IsArray(a) .and. hb_IsBlock(a[7]) EVal(a[7], Self) EndIf RETURN NIL FUNC Create_txt( cFile ) Local t t := 'This exception applies only to the code released by the Harbour' + CRLF t += 'Project under the name Harbour. If you copy code from other' + CRLF t += 'Harbour Project or Free Software Foundation releases into a copy of' + CRLF t += 'Harbour, as the General Public License permits, the exception does' + CRLF t += 'not apply to the code that you add in this way. To avoid misleading'+ CRLF t += 'anyone as to the status of such modified files, you must delete' + CRLF t += 'this exception notice from them.' + CRLF hb_memowrit(cFile, t) RETURN Nil [/pre2]

Andrey: Классный пример !

SergKis: SergKis пишет Добавил в пример Чтобы переменная o в блоке кода не провисала, подправил [pre2] oLbl:Add('Public' , YELLOW, .T., .F., .T., 'Click my', .T., ; {|o| MsgBox('Value:' + _GetValue( _HMG_ThisControlName, _HMG_ThisFormName ) + ; CRLF + 'Class:' + o:ClassName, "INFO" ) }) [/pre2]

SergKis: еще подправить надо METHOD Out( nRow, nCol ) CLASS cLbl Local a,c,i,j,l, w := 0, h := 0 Local FC, lB, lI, lU, cT, lH // было mH

полная версия страницы