PureBoard

Das deutsche PureBasic-Forum
https://www.purebasic.fr/german/

HyperLinkGadgets automatisch über TextGadgets legen

https://www.purebasic.fr/german/viewtopic.php?t=18180

Seite 1 von 1

HyperLinkGadgets automatisch über TextGadgets legen

Verfasst: 08.11.2008 18:09
von mback2k
Hallo Leute,

mit dem folgendem Code ist es möglich automatisch HyperLinkGadgets über Textstellen in TextGadgets zu legen. Dies ist meine Alternative zum transparenten und randlosen EditorGadget mit Links.

Code: Alles auswählen

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
Der Code enthält ein Beispiel, dass PB4.30 benötigt, der restliche Code ist aber auch unter anderen PB4ern lauffähig.

Hoffentlich kann das jemand gebrauchen :)

Verfasst: 08.11.2008 18:25
von Andesdaf
Toll :allright:
Damit kann ich meine Hilfetexte als einzelnes Wort im Programm mit der CHM-Hilfedatei verknüpfen!
Sehr praktisch :D
Danke!

PS: Willkommen im Board

Re: HyperLinkGadgets automatisch über TextGadgets legen

Verfasst: 08.11.2008 18:27
von ts-soft
mback2k hat geschrieben:Hoffentlich kann das jemand gebrauchen :)
:allright: sehr nützlich

Verfasst: 08.11.2008 19:17
von mback2k
Danke :) Achja, einen Haken hat die Sache aber doch, der Link kann über maximal eine Zeile gehen.

Verfasst: 09.11.2008 13:27
von Andesdaf
mback2k hat geschrieben:Danke :) Achja, einen Haken hat die Sache aber doch, der Link kann über maximal eine Zeile gehen.
Wenn ich einen Link bräuchte, der über eine Zeile ginge, erstellte ich mir ein HyperlinkGadget. (Konjunktiv II)
Alle Zeiten sind UTC+02:00
Seite 1 von 1

Powered by phpBB® Forum Software © phpBB Limited

Deutsche Übersetzung durch phpBB.de