Automatically place HyperLinkGadgets over TextGadgets

Share your advanced PureBasic knowledge/code with the community.
User avatar
mback2k
Enthusiast
Enthusiast
Posts: 257
Joined: Sun Dec 02, 2007 12:11 pm
Location: Germany

Automatically place HyperLinkGadgets over TextGadgets

Post by mback2k »

I was not able to use a transparent EditorGadget to create a multiline TextGadget like thing with links. I searched for another solution and here is it:

Code: Select all

Enumeration
  #PB_Text_UnderlineLink = 4
EndEnumeration

Procedure GetGadgetTextWidth(Gadget, Text$)
  Protected Image, Width
  Image = CreateImage(#PB_Any, 1, 1)
  StartDrawing(ImageOutput(Image))
    DrawingFont(GetGadgetFont(Gadget))
    Width = TextWidth(Text$)
  StopDrawing()
  FreeImage(Image)
  ProcedureReturn Width
EndProcedure

Procedure GetGadgetTextHeight(Gadget, Text$)
  Protected Image, Height
  Image = CreateImage(#PB_Any, 1, 1)
  StartDrawing(ImageOutput(Image))
    DrawingFont(GetGadgetFont(Gadget))
    Height = TextHeight(Text$)
  StopDrawing()
  FreeImage(Image)
  ProcedureReturn Height
EndProcedure

Procedure.s GetTextWordRange(Text$, Start = 1, Stop = -1)
  Protected Index, Number, Words$
  Number = CountString(Text$, " ") + CountString(Text$, Chr(10))
  If Stop < 0 Or Stop > Number
    Stop = Number + 1
  EndIf
  If Start > Stop
    ProcedureReturn ""
  EndIf
  For Index = Start To Stop
    If Words$
      Words$ + (" " + StringField(Text$, Index, " "))
    Else
      Words$ = StringField(Text$, Index, " ")
    EndIf
    If FindString(Words$, Chr(10), 1) And CountString(Words$, " ")
      Words$ = StringField(Words$, 1, Chr(10)) + Chr(10)
    ElseIf FindString(Words$, Chr(10), 1)
      Words$ = StringField(Words$, 2, Chr(10))
    EndIf
  Next
  ProcedureReturn Words$
EndProcedure

Procedure.s GetTextPerLine(Gadget, Line, Search$ = "")
  Protected Index, Start, Stop, Width, Text$, Line$, Words$, Complete$
  Text$ = GetGadgetText(Gadget)
  Repeat
    If Stop
      Start = Stop-1
    EndIf
    Repeat
      Stop + 1
      Words$ = GetTextWordRange(Text$, Start+1, Stop)
      Width = GetGadgetTextWidth(Gadget, Words$)
    Until Width > GadgetWidth(Gadget) Or Words$ = Right(Text$, Len(Words$)) Or Right(Words$, 1) = Chr(10)
    If Width > GadgetWidth(Gadget)
      Line$ = GetTextWordRange(Text$, Start+1, Stop-1)
    Else
      Line$ = GetTextWordRange(Text$, Start+1, Stop)
    EndIf
    If Search$ And FindString(Line$, Search$, 1)
      ProcedureReturn Line$
      Break
    ElseIf Not Search$ And Line = Index
      ProcedureReturn Line$
      Break
    EndIf
    If Line$ = Right(Text$, Len(Words$))
      Break
    EndIf
    Index + 1
  ForEver
  If Line < 0
    ProcedureReturn Str(Index)
  EndIf
EndProcedure

Procedure AddGadgetHyperLink(Gadget, LinkText$, Color, flags = 0)
  Protected Index, X, Y, Width, Height, Lines, Link, Position, Text$, SubText$
  Text$ = GetGadgetText(Gadget)
  Position = FindString(Text$, LinkText$, 1) 
  If Position
    SubText$ = Left(Text$, Position-1)
    X = GadgetX(Gadget) + GetGadgetTextWidth(Gadget, SubText$)
    Y = GadgetY(Gadget)
    If flags&#PB_Text_UnderlineLink = #PB_Text_UnderlineLink
      Width = GetGadgetTextWidth(Gadget, LinkText$)
      Height = GetGadgetTextHeight(Gadget, LinkText$) + 1
    Else
      Width = GetGadgetTextWidth(Gadget, LinkText$)
      Height = GetGadgetTextHeight(Gadget, LinkText$)
    EndIf
    While Width+(X-GadgetX(Gadget)) > GadgetWidth(Gadget)
      SubText$ = RemoveString(GetTextPerLine(Gadget, Index), Chr(10)) + " "
      X - GetGadgetTextWidth(Gadget, SubText$)
      Y + GetGadgetTextHeight(Gadget, LinkText$)
      Index + 1
    Wend
    If flags&#PB_Text_Center = #PB_Text_Center
      SubText$ = GetTextPerLine(Gadget, #Null, LinkText$) + Chr(10)
      X + Round((GadgetWidth(Gadget) - GetGadgetTextWidth(Gadget, SubText$)) / 2, #PB_Round_Nearest)
    ElseIf flags&#PB_Text_Right = #PB_Text_Right
      SubText$ = GetTextPerLine(Gadget, #Null, LinkText$)
      X + GadgetWidth(Gadget) - GetGadgetTextWidth(Gadget, SubText$)
    EndIf
    If flags&#PB_Text_Border = #PB_Text_Border
      If flags&#PB_Text_Right = #PB_Text_Right
        X - GetSystemMetrics_(#SM_CXEDGE)
      ElseIf flags&#PB_Text_Center <> #PB_Text_Right
        X + GetSystemMetrics_(#SM_CXEDGE)
      EndIf
      Y + GetSystemMetrics_(#SM_CYEDGE)
    EndIf
    If flags&#PB_Text_UnderlineLink = #PB_Text_UnderlineLink
      Link = HyperLinkGadget(#PB_Any, X, Y, Width, Height, LinkText$, Color, #PB_HyperLink_Underline)
    Else
      Link = HyperLinkGadget(#PB_Any, X, Y, Width, Height, LinkText$, Color)
    EndIf
    If Link
      SetGadgetColor(Link, #PB_Gadget_FrontColor, GetGadgetColor(Gadget, #PB_Gadget_FrontColor))
      SetGadgetColor(Link, #PB_Gadget_BackColor, GetGadgetColor(Gadget, #PB_Gadget_BackColor))
    EndIf
  EndIf
  ProcedureReturn Link
EndProcedure

If OpenWindow(0, 0, 0, 420, 220, "LinkGadget Test", $CA0001)
  HideWindow(0, 1)
  
  Dim Links.l(30)
  StartTime = ElapsedMilliseconds()
  
  PanelGadget(10, 10, 10, 400, 200)
  AddGadgetItem(10, -1, "Center")
  TextGadget(0, 10, 10, 375, 150, "Lorem ipsum dolor sit amet, consectetuer adipiscing elit. Aliquam lorem. In nisi velit, volutpat quis, sollicitudin sit amet, aliquet non, sem."+Chr(10)+"Proin fringilla arcu ut lectus. Sed posuere. Donec pellentesque egestas libero. Duis sodales lorem eu massa. Curabitur ante erat, facilisis quis, ultricies quis, commodo In, nibh. Proin at mi. Curabitur pharetra quam non eros. Vestibulum turpis. Cum sociis natoque penatibus et magnis dis parturient montes, nascetur ridiculus mus. Integer fringilla. Suspendisse potenti. Fusce magna magna, hendrerit a, pretium vitae, rhoncus In, lectus. Proin nec odio. Morbi rhoncus condimentum tellus. pellentesque quis neque. Curabitur iaculis, purus sit amet gravida blandit, ipsum neque iaculis eros, Sed fermentum ligula eros at libero.", #PB_Text_Center)
  Links(1) = AddGadgetHyperLink(0, "Lorem ipsum dolor", GetSysColor_(#COLOR_HOTLIGHT), #PB_Text_Center)
  Links(2) = AddGadgetHyperLink(0, "consectetuer adipiscing", GetSysColor_(#COLOR_HOTLIGHT), #PB_Text_Center)
  Links(3) = AddGadgetHyperLink(0, "Sed posuere", GetSysColor_(#COLOR_HOTLIGHT), #PB_Text_Center)
  Links(4) = AddGadgetHyperLink(0, "quam non eros", GetSysColor_(#COLOR_HOTLIGHT), #PB_Text_Center)
  Links(5) = AddGadgetHyperLink(0, "ridiculus mus", GetSysColor_(#COLOR_HOTLIGHT), #PB_Text_Center)
  
  AddGadgetItem(10, -1, "Right")
  TextGadget(1, 10, 10, 375, 150, "Lorem ipsum dolor sit amet, consectetuer adipiscing elit. Aliquam lorem. In nisi velit, volutpat quis, sollicitudin sit amet, aliquet non, sem."+Chr(10)+"Proin fringilla arcu ut lectus. Sed posuere. Donec pellentesque egestas libero. Duis sodales lorem eu massa. Curabitur ante erat, facilisis quis, ultricies quis, commodo In, nibh. Proin at mi. Curabitur pharetra quam non eros. Vestibulum turpis. Cum sociis natoque penatibus et magnis dis parturient montes, nascetur ridiculus mus. Integer fringilla. Suspendisse potenti. Fusce magna magna, hendrerit a, pretium vitae, rhoncus In, lectus. Proin nec odio. Morbi rhoncus condimentum tellus. pellentesque quis neque. Curabitur iaculis, purus sit amet gravida blandit, ipsum neque iaculis eros, Sed fermentum ligula eros at libero.", #PB_Text_Right)
  Links(6) = AddGadgetHyperLink(1, "Lorem ipsum dolor", GetSysColor_(#COLOR_HOTLIGHT), #PB_Text_Right)
  Links(7) = AddGadgetHyperLink(1, "consectetuer adipiscing", GetSysColor_(#COLOR_HOTLIGHT), #PB_Text_Right)
  Links(8) = AddGadgetHyperLink(1, "Sed posuere", GetSysColor_(#COLOR_HOTLIGHT), #PB_Text_Right)
  Links(9) = AddGadgetHyperLink(1, "quam non eros", GetSysColor_(#COLOR_HOTLIGHT), #PB_Text_Right)
  Links(10) = AddGadgetHyperLink(1, "ridiculus mus", GetSysColor_(#COLOR_HOTLIGHT), #PB_Text_Right)
  
  AddGadgetItem(10, -1, "Left")
  TextGadget(2, 10, 10, 375, 150, "Lorem ipsum dolor sit amet, consectetuer adipiscing elit. Aliquam lorem. In nisi velit, volutpat quis, sollicitudin sit amet, aliquet non, sem."+Chr(10)+"Proin fringilla arcu ut lectus. Sed posuere. Donec pellentesque egestas libero. Duis sodales lorem eu massa. Curabitur ante erat, facilisis quis, ultricies quis, commodo In, nibh. Proin at mi. Curabitur pharetra quam non eros. Vestibulum turpis. Cum sociis natoque penatibus et magnis dis parturient montes, nascetur ridiculus mus. Integer fringilla. Suspendisse potenti. Fusce magna magna, hendrerit a, pretium vitae, rhoncus In, lectus. Proin nec odio. Morbi rhoncus condimentum tellus. pellentesque quis neque. Curabitur iaculis, purus sit amet gravida blandit, ipsum neque iaculis eros, Sed fermentum ligula eros at libero.")
  Links(11) = AddGadgetHyperLink(2, "Lorem ipsum dolor", GetSysColor_(#COLOR_HOTLIGHT))
  Links(12) = AddGadgetHyperLink(2, "consectetuer adipiscing", GetSysColor_(#COLOR_HOTLIGHT))
  Links(13) = AddGadgetHyperLink(2, "Sed posuere", GetSysColor_(#COLOR_HOTLIGHT))
  Links(14) = AddGadgetHyperLink(2, "quam non eros", GetSysColor_(#COLOR_HOTLIGHT))
  Links(15) = AddGadgetHyperLink(2, "ridiculus mus", GetSysColor_(#COLOR_HOTLIGHT))
  
  AddGadgetItem(10, -1, "Center + Border")
  TextGadget(3, 10, 10, 375, 150, "Lorem ipsum dolor sit amet, consectetuer adipiscing elit. Aliquam lorem. In nisi velit, volutpat quis, sollicitudin sit amet, aliquet non, sem."+Chr(10)+"Proin fringilla arcu ut lectus. Sed posuere. Donec pellentesque egestas libero. Duis sodales lorem eu massa. Curabitur ante erat, facilisis quis, ultricies quis, commodo In, nibh. Proin at mi. Curabitur pharetra quam non eros. Vestibulum turpis. Cum sociis natoque penatibus et magnis dis parturient montes, nascetur ridiculus mus. Integer fringilla. Suspendisse potenti. Fusce magna magna, hendrerit a, pretium vitae, rhoncus In, lectus. Proin nec odio. Morbi rhoncus condimentum tellus. pellentesque quis neque. Curabitur iaculis, purus sit amet gravida blandit, ipsum neque iaculis eros, Sed fermentum ligula eros at libero.", #PB_Text_Center|#PB_Text_Border)
  Links(16) = AddGadgetHyperLink(3, "Lorem ipsum dolor", GetSysColor_(#COLOR_HOTLIGHT), #PB_Text_Center|#PB_Text_Border)
  Links(17) = AddGadgetHyperLink(3, "consectetuer adipiscing", GetSysColor_(#COLOR_HOTLIGHT), #PB_Text_Center|#PB_Text_Border)
  Links(18) = AddGadgetHyperLink(3, "Sed posuere", GetSysColor_(#COLOR_HOTLIGHT), #PB_Text_Center|#PB_Text_Border)
  Links(19) = AddGadgetHyperLink(3, "quam non eros", GetSysColor_(#COLOR_HOTLIGHT), #PB_Text_Center|#PB_Text_Border)
  Links(20) = AddGadgetHyperLink(3, "ridiculus mus", GetSysColor_(#COLOR_HOTLIGHT), #PB_Text_Center|#PB_Text_Border)
  
  AddGadgetItem(10, -1, "Right + Border")
  TextGadget(4, 10, 10, 375, 150, "Lorem ipsum dolor sit amet, consectetuer adipiscing elit. Aliquam lorem. In nisi velit, volutpat quis, sollicitudin sit amet, aliquet non, sem."+Chr(10)+"Proin fringilla arcu ut lectus. Sed posuere. Donec pellentesque egestas libero. Duis sodales lorem eu massa. Curabitur ante erat, facilisis quis, ultricies quis, commodo In, nibh. Proin at mi. Curabitur pharetra quam non eros. Vestibulum turpis. Cum sociis natoque penatibus et magnis dis parturient montes, nascetur ridiculus mus. Integer fringilla. Suspendisse potenti. Fusce magna magna, hendrerit a, pretium vitae, rhoncus In, lectus. Proin nec odio. Morbi rhoncus condimentum tellus. pellentesque quis neque. Curabitur iaculis, purus sit amet gravida blandit, ipsum neque iaculis eros, Sed fermentum ligula eros at libero.", #PB_Text_Right|#PB_Text_Border)
  Links(21) = AddGadgetHyperLink(4, "Lorem ipsum dolor", GetSysColor_(#COLOR_HOTLIGHT), #PB_Text_Right|#PB_Text_Border)
  Links(22) = AddGadgetHyperLink(4, "consectetuer adipiscing", GetSysColor_(#COLOR_HOTLIGHT), #PB_Text_Right|#PB_Text_Border)
  Links(23) = AddGadgetHyperLink(4, "Sed posuere", GetSysColor_(#COLOR_HOTLIGHT), #PB_Text_Right|#PB_Text_Border)
  Links(24) = AddGadgetHyperLink(4, "quam non eros", GetSysColor_(#COLOR_HOTLIGHT), #PB_Text_Right|#PB_Text_Border)
  Links(25) = AddGadgetHyperLink(4, "ridiculus mus", GetSysColor_(#COLOR_HOTLIGHT), #PB_Text_Right|#PB_Text_Border)
  
  AddGadgetItem(10, -1, "Left + Border")
  TextGadget(5, 10, 10, 375, 150, "Lorem ipsum dolor sit amet, consectetuer adipiscing elit. Aliquam lorem. In nisi velit, volutpat quis, sollicitudin sit amet, aliquet non, sem."+Chr(10)+"Proin fringilla arcu ut lectus. Sed posuere. Donec pellentesque egestas libero. Duis sodales lorem eu massa. Curabitur ante erat, facilisis quis, ultricies quis, commodo In, nibh. Proin at mi. Curabitur pharetra quam non eros. Vestibulum turpis. Cum sociis natoque penatibus et magnis dis parturient montes, nascetur ridiculus mus. Integer fringilla. Suspendisse potenti. Fusce magna magna, hendrerit a, pretium vitae, rhoncus In, lectus. Proin nec odio. Morbi rhoncus condimentum tellus. pellentesque quis neque. Curabitur iaculis, purus sit amet gravida blandit, ipsum neque iaculis eros, Sed fermentum ligula eros at libero.", #PB_Text_Border)
  Links(26) = AddGadgetHyperLink(5, "Lorem ipsum dolor", GetSysColor_(#COLOR_HOTLIGHT), #PB_Text_Border)
  Links(27) = AddGadgetHyperLink(5, "consectetuer adipiscing", GetSysColor_(#COLOR_HOTLIGHT), #PB_Text_Border)
  Links(28) = AddGadgetHyperLink(5, "Sed posuere", GetSysColor_(#COLOR_HOTLIGHT), #PB_Text_Border)
  Links(29) = AddGadgetHyperLink(5, "quam non eros", GetSysColor_(#COLOR_HOTLIGHT), #PB_Text_Border)
  Links(30) = AddGadgetHyperLink(5, "ridiculus mus", GetSysColor_(#COLOR_HOTLIGHT), #PB_Text_Border)
  
  For Index = 1 To ArraySize(Links())
    SetGadgetColor(Links(Index), #PB_Gadget_FrontColor, RGB(0, 0, 255))
  Next
  
  EndTime = ElapsedMilliseconds()
  SetWindowTitle(0, "LinkGadget Test - Done in "+Str(EndTime-StartTime)+"ms")
  HideWindow(0, 0)
  
  Repeat
    Event = WaitWindowEvent()
    Select Event
      Case #PB_Event_Gadget
        For Index = 1 To ArraySize(Links())
          If Links(Index) = EventGadget()
            MessageRequester("Test", "You clicked on: "+GetGadgetText(Links(Index)))
          EndIf
        Next
      Case #PB_Event_CloseWindow
        Break
    EndSelect
  ForEver
EndIf
(The example requires PB4.30, but you should be able to use the procedures with any PB4)

It does automatically place HyperLinkGadgets over the text inside the TextGadget. The procedure does either return #False or the Gadget ID of the created HyperLinkGadget.

Hopefully this will help other people with the same problem :)
Last edited by mback2k on Sat Nov 08, 2008 2:29 pm, edited 5 times in total.
SFSxOI
Addict
Addict
Posts: 2970
Joined: Sat Dec 31, 2005 5:24 pm
Location: Where ya would never look.....

Post by SFSxOI »

This doesn't work with PB 4.20, does it?

Code: Select all

For Index = 1 To ArraySize(Links()) 
User avatar
mback2k
Enthusiast
Enthusiast
Posts: 257
Joined: Sun Dec 02, 2007 12:11 pm
Location: Germany

Re: Automatically place HyperLinkGadgets over TextGadgets

Post by mback2k »

mback2k wrote:(The example requires PB4.30, but you should be able to use the procedures with any PB4)
No, it doesn't. But you can just replace that code with something else to manage the link gadgets. That's part of the example window.
User avatar
mback2k
Enthusiast
Enthusiast
Posts: 257
Joined: Sun Dec 02, 2007 12:11 pm
Location: Germany

Post by mback2k »

Updated the snippet to fix some alignment issues.
User avatar
Tomi
Enthusiast
Enthusiast
Posts: 270
Joined: Wed Sep 03, 2008 9:29 am

Post by Tomi »

Please to provide this for pb 4.20 final, i have not need to this, but i interesting to test it only :wink:

Edit:
If you have't time, no problem, 4.30 final is coming soon :D
User avatar
mback2k
Enthusiast
Enthusiast
Posts: 257
Joined: Sun Dec 02, 2007 12:11 pm
Location: Germany

Post by mback2k »

Just remove this part and it will work on PB4.20:

Code: Select all

  For Index = 1 To ArraySize(Links())
    SetGadgetColor(Links(Index), #PB_Gadget_FrontColor, RGB(0, 0, 255))
  Next 
c4s
Addict
Addict
Posts: 1981
Joined: Thu Nov 01, 2007 5:37 pm
Location: Germany

Re: Automatically place HyperLinkGadgets over TextGadgets

Post by c4s »

Yes, finally I found the behaviour I expect of a HyperlinkGadget.

Thank you very much!

Edit:
Just one small bug: With #PB_Text_Center the hyperlinks are shifted by 1 pixel to the left. But adding the following should do it:

Code: Select all

;line 108, at the end:
+ 1

;line 116, new lines:
ElseIf Flags & #PB_Text_Center = #PB_Text_Center
	X + GetSystemMetrics_(#SM_CXEDGE) - 2
But why?
If any of you native English speakers have any suggestions for the above text, please let me know (via PM). Thanks!
+18
Enthusiast
Enthusiast
Posts: 228
Joined: Fri Oct 24, 2008 2:07 pm

Re: Automatically place HyperLinkGadgets over TextGadgets

Post by +18 »

cool sharing, thx :D
User avatar
mback2k
Enthusiast
Enthusiast
Posts: 257
Joined: Sun Dec 02, 2007 12:11 pm
Location: Germany

Re: Automatically place HyperLinkGadgets over TextGadgets

Post by mback2k »

Here is my latest version of the code, including another center alignment fix and XP style fix:

Code: Select all

Enumeration
  #PB_Text_UnderlineLink = $10000
EndEnumeration

ProcedureDLL SetGadgetFontStyle(Gadget, YSize, Flags=#Null)
  Protected currentFont, newFont, faceName$, lf.LOGFONT
  currentFont = SendMessage_(GadgetID(Gadget), #WM_GETFONT, 0, 0)
  GetObject_(currentFont, SizeOf(LOGFONT), @lf.LOGFONT)
  faceName$ = PeekS(@lf\lfFacename)
  newFont = LoadFont(#PB_Any, faceName$, YSize, flags)
  If newFont
    SetGadgetFont(Gadget, FontID(newFont))
  EndIf
EndProcedure

ProcedureDLL GetGadgetTextWidth(Gadget, Text$)
  Protected Image, Width
  Image = CreateImage(#PB_Any, 1, 1)
  StartDrawing(ImageOutput(Image))
    DrawingFont(GetGadgetFont(Gadget))
    Width = TextWidth(Text$)
  StopDrawing()
  FreeImage(Image)
  ProcedureReturn Width
EndProcedure

ProcedureDLL GetGadgetTextHeight(Gadget, Text$)
  Protected Image, Height
  Image = CreateImage(#PB_Any, 1, 1)
  StartDrawing(ImageOutput(Image))
    DrawingFont(GetGadgetFont(Gadget))
    Height = TextHeight(Text$)
  StopDrawing()
  FreeImage(Image)
  ProcedureReturn Height
EndProcedure

Procedure.s GetTextWordRange(Text$, Start=1, Stop=-1)
  Protected Index, Number, Words$
  Text$ = ReplaceString(Text$, " ", #CR$+" ")
  Text$ = ReplaceString(Text$, #LF$, #LF$+" ")
  Number = CountString(Text$, " ")
  If Stop < 0 Or Stop > Number
    Stop = Number + 1
  EndIf
  For Index = Start To Stop
    If Words$
      Words$ + " " + StringField(Text$, Index, " ")
    Else
      Words$ = StringField(Text$, Index, " ")
    EndIf
  Next
  Words$ = ReplaceString(Words$, #LF$+" ", #LF$)
  Words$ = ReplaceString(Words$, #CR$+" ", " ")
  ProcedureReturn Words$
EndProcedure

Procedure.s GetTextPerLine(Gadget, Line, Search$="")
  Protected Index, Start, Stop, Width, Text$, Line$, Prev$, Words$, Complete$
  Text$ = GetGadgetText(Gadget)
  Repeat
    If Stop
      Start = Stop-1
    EndIf
    Repeat
      Stop + 1
      Prev$ = Words$
      Words$ = GetTextWordRange(Text$, Start+1, Stop)
      Width = GetGadgetTextWidth(Gadget, Words$)-1
    Until Width > GadgetWidth(Gadget) Or Words$ = Right(Text$, Len(Words$)) Or Right(Words$, 1) = #LF$
    If Width > GadgetWidth(Gadget)
      Line$ = Prev$
    Else
      Line$ = Words$
      Stop + 1
    EndIf
    If Search$ And FindString(Line$, Search$, 1)
      ProcedureReturn Line$
      Break
    ElseIf Not Search$ And Line = Index
      ProcedureReturn Line$
      Break
    EndIf
    If Line$ = Right(Text$, Len(Words$))
      Break
    EndIf
    Index + 1
  ForEver
  If Line < 0
    ProcedureReturn Str(Index)
  EndIf
EndProcedure

ProcedureDLL AddGadgetHyperLink(Gadget, HyperLinkID, LinkText$, Color, Flags=#Null)
  Protected Index, X, Y, Width, Height, Lines, Link, Position, Text$, SubText$
  Text$ = GetGadgetText(Gadget)
  Position = FindString(Text$, LinkText$, 1) 
  If Position
    X = GadgetX(Gadget)
    Y = GadgetY(Gadget) - GetGadgetTextHeight(Gadget, LinkText$)
    If flags&#PB_Text_UnderlineLink = #PB_Text_UnderlineLink
      Width = GetGadgetTextWidth(Gadget, LinkText$)
      Height = GetGadgetTextHeight(Gadget, LinkText$) + 1
    Else
      Width = GetGadgetTextWidth(Gadget, LinkText$)
      Height = GetGadgetTextHeight(Gadget, LinkText$)
    EndIf
    Repeat
      Text$ = GetTextPerLine(Gadget, Index)
      SubText$ = Left(Text$, FindString(Text$, LinkText$, 1)-1)
      X = GadgetX(Gadget)
      X + GetGadgetTextWidth(Gadget, SubText$)
      Y + GetGadgetTextHeight(Gadget, LinkText$)
      Index + 1
    Until FindString(Text$, LinkText$, 1)
    If flags&#PB_Text_Right = #PB_Text_Right
      SubText$ = GetTextPerLine(Gadget, #Null, LinkText$)
      X + GadgetWidth(Gadget) - GetGadgetTextWidth(Gadget, SubText$)
    ElseIf flags&#PB_Text_Center = #PB_Text_Center
      SubText$ = GetTextPerLine(Gadget, #Null, LinkText$)
      X + Round((GadgetWidth(Gadget) - GetGadgetTextWidth(Gadget, SubText$)) / 2, #PB_Round_Down)
    EndIf
    If flags&#PB_Text_Border = #PB_Text_Border
      If flags&#PB_Text_Right = #PB_Text_Right
        X - GetSystemMetrics_(#SM_CXEDGE)
      ElseIf flags&#PB_Text_Center <> #PB_Text_Center
        X + GetSystemMetrics_(#SM_CXEDGE)
      EndIf
      Y + GetSystemMetrics_(#SM_CYEDGE)
    EndIf
    If flags&#PB_Text_UnderlineLink = #PB_Text_UnderlineLink
      Link = HyperLinkGadget(HyperLinkID, X, Y, Width, Height, LinkText$, Color, #PB_HyperLink_Underline)
    Else
      Link = HyperLinkGadget(HyperLinkID, X, Y, Width, Height, LinkText$, Color)
    EndIf
    If HyperLinkID <> #PB_Any
      Link = HyperLinkID
    EndIf
    If IsGadget(Link)
      SetGadgetColor(Link, #PB_Gadget_FrontColor, GetGadgetColor(Gadget, #PB_Gadget_FrontColor))
      SetGadgetColor(Link, #PB_Gadget_BackColor, GetGadgetColor(Gadget, #PB_Gadget_BackColor))
    Else
      Link = #Null
    EndIf
  EndIf
  ProcedureReturn Link
EndProcedure
User avatar
omboy
New User
New User
Posts: 6
Joined: Wed Feb 10, 2010 11:28 pm
Location: Russia
Contact:

Re: Automatically place HyperLinkGadgets over TextGadgets

Post by omboy »

Thanks :D
Post Reply