GELÖSCHT

[mirca]

GELÖSCHT

[rolaf]

Ich würde sagen den gleichen Text mit gleichem Font mit TextWidth() aus den 2DDrawing-Funktionen ausmessen.
Ne Krücke, temporär über nen Image, ich weis, müßte aber gehen.

[Derren]

http://purebasic.fr/english/viewtopic.php?f=12&t=38349

[RSBasic]

Alternativ wäre es, ein SysLink-API-Control zu verwenden:

Code: Alles auswählen

;Autor: nico
;Nur mit XP-Skin

EnableExplicit

Define EventID
Define LinkHTML$="<a href="+Chr(34)+"http://www.purebasic.fr/german/index.php"+Chr(34)+">PureBoard</a>"
Define SysLinkHandle

#MAX_LINKID_TEXT=48
#L_MAX_URL_LENGTH=2083

Structure LITEM
  mask.l
  iLink.l
  state.l
  stateMask.l
  szID.w[#MAX_LINKID_TEXT]
  szUrl.w[#L_MAX_URL_LENGTH]
EndStructure

Structure NMLINK
  hdr.NMHDR
  item.LITEM
EndStructure

Procedure.s Uni2Ansi(*Unicode.l)
  Protected size.l
  Protected ansi.s
  
  size.l = WideCharToMultiByte_(#CP_ACP, 0, *Unicode, -1, #Null, #Null, #Null, #Null)
  ansi.s=Space(size)
  WideCharToMultiByte_(#CP_ACP, 0, *Unicode, -1, @ansi, size, #Null, #Null)
  
  ProcedureReturn ansi 
EndProcedure

Procedure WindowCallback(hwnd,msg,wparam,lparam)
  Protected result
  Protected *nmhdr.NMHDR
  Protected *LINK.NMLINK
  Protected *pointeur
  Protected chaine.s
  
  result = #PB_ProcessPureBasicEvents
  Select msg
    Case #WM_NOTIFY
       *nmhdr.NMHDR=lParam
       Select *nmhdr\code
        Case #NM_CLICK
          *LINK.NMLINK = lParam

          *pointeur=AllocateMemory(100)
         
          CopyMemory(@*LINK\item\szUrl[0],*pointeur,100)
          chaine=Uni2Ansi(*pointeur)
          Debug chaine
          
          FreeMemory(*pointeur)
         
      EndSelect
  EndSelect
  
  ProcedureReturn result
EndProcedure

If OpenWindow(0,0,0,500,400,"Window",#PB_Window_SystemMenu|#PB_Window_ScreenCentered)
  SysLinkHandle = CreateWindowEx_(0, "SysLink", LinkHTML$, #WS_CHILD | #WS_VISIBLE, 10, 10, 100, 20, WindowID(0), 2, 0, 0)
  
  SetWindowCallback(@WindowCallback())
  
  Repeat
    EventID=WaitWindowEvent()
    If EventID = #PB_Event_CloseWindow
      End
    EndIf
  ForEver
EndIf

[ts-soft]

Die von RSBasic gepostete Alternative, geändert, so das wirklich Unicode und ASCII funktionieren
Außerdem wurde dabei gleich dieser seit ewigen Zeiten unnötige Uni2Ascii Quatsch entfernt.

Code: Alles auswählen

;Autor: nico
;Nur mit XP-Skin

EnableExplicit

Define EventID
Define LinkHTML$="<a href=" + Chr(34) + "http://www.purebasic.fr/german/index.php" + Chr(34) + ">PureBoard</a>"
Define SysLinkHandle

#MAX_LINKID_TEXT = 48
#L_MAX_URL_LENGTH = 2083

Structure LITEM
  mask.l
  iLink.l
  state.l
  stateMask.l
  szID.w[#MAX_LINKID_TEXT]
  szUrl.w[#L_MAX_URL_LENGTH]
EndStructure

Structure NMLINK
  hdr.NMHDR
  item.LITEM
EndStructure

Procedure WindowCallback(hwnd, msg, wparam, lparam)
  Protected result
  Protected *nmhdr.NMHDR
  Protected *LINK.NMLINK
 
  result = #PB_ProcessPureBasicEvents
  Select msg
    Case #WM_NOTIFY
       *nmhdr.NMHDR = lParam
       Select *nmhdr\code
        Case #NM_CLICK
          *LINK.NMLINK = lParam
          Debug PeekS(@*LINK\item\szUrl[0], -1, #PB_Unicode)
       
      EndSelect
  EndSelect
 
  ProcedureReturn result
EndProcedure

If OpenWindow(0, 0, 0, 500, 400, "Window", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
  SysLinkHandle = CreateWindowEx_(0, "SysLink", LinkHTML$, #WS_CHILD | #WS_VISIBLE, 10, 10, 100, 20, WindowID(0), 2, 0, 0)
 
  SetWindowCallback(@WindowCallback())
 
  Repeat
    EventID = WaitWindowEvent()
    If EventID = #PB_Event_CloseWindow
      End
    EndIf
  ForEver
EndIf 

Gruß
Thomas

[RSBasic]

Danke Thomas für die Anpassung.

[mirca]

GELÖSCHT