HyperLinkGadgets automatisch über TextGadgets legen

Hier könnt Ihr gute, von Euch geschriebene Codes posten. Sie müssen auf jeden Fall funktionieren und sollten möglichst effizient, elegant und beispielhaft oder einfach nur cool sein.
Antworten
mback2k

HyperLinkGadgets automatisch über TextGadgets legen

Beitrag 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 :)
Zuletzt geändert von mback2k am 08.11.2008 19:29, insgesamt 1-mal geändert.
Nach oben
Andesdaf
Moderator
Beiträge: 2673
Registriert: 15.06.2008 18:22
Wohnort: Dresden

Beitrag 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
Win11 x64 | PB 6.20
Nach oben
Benutzeravatar
ts-soft
Beiträge: 22292
Registriert: 08.09.2004 00:57
Computerausstattung: Mainboard: MSI 970A-G43
CPU: AMD FX-6300 Six-Core Processor
GraKa: GeForce GTX 750 Ti, 2 GB
Memory: 16 GB DDR3-1600 - Dual Channel
Wohnort: Berlin

Re: HyperLinkGadgets automatisch über TextGadgets legen

Beitrag von ts-soft »

mback2k hat geschrieben:Hoffentlich kann das jemand gebrauchen :)
:allright: sehr nützlich
PureBasic 5.73 LTS | SpiderBasic 2.30 | Windows 10 Pro (x64) | Linux Mint 20.1 (x64)
Nutella hat nur sehr wenig Vitamine. Deswegen muss man davon relativ viel essen.
Bild
Nach oben
mback2k

Beitrag von mback2k »

Danke :) Achja, einen Haken hat die Sache aber doch, der Link kann über maximal eine Zeile gehen.
Nach oben
Andesdaf
Moderator
Beiträge: 2673
Registriert: 15.06.2008 18:22
Wohnort: Dresden

Beitrag 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)
Win11 x64 | PB 6.20
Nach oben
Antworten

Zurück zu „Code, Tipps und Tricks“