vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#
sevDataGrid - Gönnen Sie Ihrem SQL-Kommando diesen krönenden Abschluß!  
 vb@rchiv Quick-Search: Suche startenErweiterte Suche starten   Impressum  | Datenschutz  | vb@rchiv CD Vol.6  | Shop Copyright ©2000-2024
 
zurück
Rubrik: Controls · Sonstiges   |   VB-Versionen: VB5, VB618.08.03
HyperLabel der Extra(Klasse)...

Ein HyperLabel für Mail-, URL- und Dokumentenlinks

Autor:   Roland WutzkeBewertung:     [ Jetzt bewerten ]Views:  13.253 
www.vb-power.netSystem:  Win9x, WinNT, Win2k, WinXP, Win7, Win8, Win10, Win11 Beispielprojekt auf CD 

Im heutigen Internet-Zeitalter verlangen unsere VB-Programme nach einem modernen Look & Feel. Wie man seine Programme mit sogenannten Hyperlinks ausstattet, das zeigt Ihnen nachfolgendes Klassen-Modul.

Ein HyperLabel soll "Links" des folgenden Typs starten können:

  • Mail
  • URL
  • Dokument

Alles was Sie hierzu benötigen, ist eine Picturebox auf der aufrufenden Form. Die Picturebox wird durch die Klasse sogar automatisch auf die richtige Größe angepasst.

Wie wird das Hyperlabel genutzt? Legen Sie in einem neuen Projekt ein neues Klassenmodul an. Benennen Sie das Klassenmodul cHyperLabel. Fügen Sie den nachfolgenden Code in das Klassenmodul ein.

Option Explicit
 
' Benötigte API´s
Private Declare Function SetCapture Lib "user32" ( _
  ByVal hwnd As Long) As Long
 
Private Declare Function ReleaseCapture Lib "user32" () As Long
 
Private Declare Function ShellExecute Lib "shell32.dll" _
  Alias "ShellExecuteA" ( _
  ByVal hwnd As Long, _
  ByVal lpOperation As String, _
  ByVal lpFile As String, _
  ByVal lpParameters As String, _
  ByVal lpDirectory As String, _
  ByVal nShowCmd As Long) As Long
 
' Errorcode ShellExecute
Private Const SE_ERR_NOTFOUND = 2
 
' Aufzählung LinkType
Public Enum eLinkType
  URL = 0
  Mail = 1
  Dokument = 2
End Enum
 
' Öffentliche Events
Public WithEvents Hyperlabel As PictureBox
Public Event Status(ByVal LinkSuccess As Boolean, _
  ByVal ReturnCode As Long)
 
' Öffentliche Eigenschaften der Klasse
Public AddGapWidth As Long
Public AddGapHeight As Long
Public LabelText As String
Public LinkColor As OLE_COLOR
Public Link As String
Public LinkType As eLinkType
Public ShowBold As Boolean
Public TextOffsetX As Long
Public TextOffsetY As Long
Public VisitedLinkColor As OLE_COLOR
 
' Klassenvariablen
Private hasVisited As Boolean
Private Sub Class_Initialize()
  ' Initialisieren der Klasse, Eigenschaften
  ' vorbesetzen
  AddGapWidth = 50
  AddGapHeight = 50
  hasVisited = False
  LinkColor = &HFF0000
  LinkType = URL
  ShowBold = True
  TextOffsetX = 0
  TextOffsetY = 0
  VisitedLinkColor = &HC000C0
End Sub
Public Sub InitHyperLabel()
  ' Initialisieren des HyperLabels
  Dim tmpWidth As Long
 
  With Hyperlabel
    tmpWidth = .Width
    AddGapWidth = IIf(AddGapWidth < 30, 30, AddGapWidth)
    AddGapHeight = IIf(AddGapHeight < 30, 30, AddGapHeight)
    .Cls
    .AutoRedraw = True
    .FontUnderline = True
    .Height = .TextHeight(LabelText) + AddGapHeight
    .Width = .TextWidth(LabelText) + AddGapWidth
    .Left = .Left - ((.Width - tmpWidth) \ 2)
    .BorderStyle = 0
    .CurrentX = TextOffsetX
    .CurrentY = TextOffsetY
    Hyperlabel.Print LabelText
  End With
End Sub
Private Sub Hyperlabel_Click()
  ' Klick auf das HyperLabel wurde ausgelöst
  Dim tmpString As String
  Dim lRet As Long
 
  ' Init der Eigenschaft Link
  tmpString = Link
  If tmpString = "" Then
    RaiseEvent Status(False, SE_ERR_NOTFOUND)
    Exit Sub
  End If
 
  ' LinkType auswerten
  Select Case LinkType
    Case eLinkType.URL
      If Left$(LCase(tmpString), 7) <> "http://" Then _
        tmpString = "http://" & tmpString
    Case eLinkType.Mail
      If Left$(LCase(tmpString), 7) <> "mailto:" Then _
        tmpString = "mailto:" & tmpString
  End Select
 
  ' Link starten
  Screen.MousePointer = 11
  lRet = ShellExecute(Hyperlabel.Parent.hwnd, "open", _
    tmpString, vbNullString, vbNullString, vbNormalFocus)
  Screen.MousePointer = 0
 
  ' Returncode auswerten und RaiseEvent auslösen
  hasVisited = IIf(lRet <> SE_ERR_NOTFOUND, True, False)
  RaiseEvent Status(lRet <> SE_ERR_NOTFOUND, lRet)
  If hasVisited Then Hyperlabel_MouseMove 0, 0, -1, -1
  DoEvents
End Sub
Private Sub Hyperlabel_MouseMove(Button As Integer, _
  Shift As Integer, X As Single, Y As Single)
 
  ' Mausbewegungen auswerten
  Dim l As Long
  Dim tmpWidth As Long
  Static SaveColor As OLE_COLOR
  Static isMouseOver As Boolean
 
  With Hyperlabel
    ' Ist die Maus über dem HyperLabel ?
    If X >= 0 And X <= .Width And Y >= 0 And Y <= .Height Then
      l = SetCapture(.hwnd)
      If Not isMouseOver Then
        isMouseOver = True
        SaveColor = .ForeColor
        .Cls
        .ForeColor = IIf(hasVisited = True, _
          VisitedLinkColor, LinkColor)
        If ShowBold Then
          tmpWidth = .Width
          .FontBold = True
          .Width = .TextWidth(LabelText) + AddGapWidth
          .Left = .Left - ((.Width - tmpWidth) \ 2)
        End If
        .CurrentX = TextOffsetX
        .CurrentY = TextOffsetY
        Hyperlabel.Print LabelText
        DoEvents
      End If
 
    ' Hat die Maus das HyperLabel verlassen ?
    Else
      l = ReleaseCapture()
      isMouseOver = False
      .Cls
      .ForeColor = SaveColor
      If ShowBold Then
        tmpWidth = .Width
        .FontBold = False
        .Width = .TextWidth(LabelText) + AddGapWidth
        .Left = .Left - ((.Width - tmpWidth) \ 2)
      End If
      .CurrentX = TextOffsetX
      .CurrentY = TextOffsetY
      Hyperlabel.Print LabelText
      DoEvents
    End If
  End With
End Sub

Beispiel:
Platzieren Sie eine Picturebox (Picture1) auf die Form1 und fügen den nachfolgenden Code in das Codefenster:

Option Explicit
Private WithEvents nHyperURL As cHyperLabel
Private Sub Form_Load()
  Set nHyperURL = New cHyperLabel
  Set nHyperURL.Hyperlabel = Picture1
 
  With nHyperURL
    .LabelText = "vbarchiv"
    .Link = "www.vbarchiv.net"
    .LinkType = URL
    .InitHyperLabel
  End With
End Sub

Das HyperLabel verfügt insgesamt über:

  • 11 Eigenschaften
  • 1 Methode
  • 1 Ereignis

Wie Sie den vollen Umfang des HyperLabels zusammen mit einigen Grafikelementen nutzen können, zeigt Ihnen eindrucksvoll unser Demoprojekt.

Dieser Tipp wurde bereits 13.253 mal aufgerufen.

Voriger Tipp   |   Zufälliger Tipp   |   Nächster Tipp

Über diesen Tipp im Forum diskutieren
Haben Sie Fragen oder Anregungen zu diesem Tipp, können Sie gerne mit anderen darüber in unserem Forum diskutieren.

Neue Diskussion eröffnen

nach obenzurück


Anzeige

Kauftipp Unser Dauerbrenner!Diesen und auch alle anderen Tipps & Tricks finden Sie auch auf unserer aktuellen vb@rchiv  Vol.6
(einschl. Beispielprojekt!)

Ein absolutes Muss - Geballtes Wissen aus mehr als 8 Jahren vb@rchiv!
- nahezu alle Tipps & Tricks und Workshops mit Beispielprojekten
- Symbol-Galerie mit mehr als 3.200 Icons im modernen Look
Weitere Infos - 4 Entwickler-Vollversionen (u.a. sevFTP für .NET), Online-Update-Funktion u.v.m.
 
   

Druckansicht Druckansicht Copyright ©2000-2024 vb@rchiv Dieter Otter
Alle Rechte vorbehalten.
Microsoft, Windows und Visual Basic sind entweder eingetragene Marken oder Marken der Microsoft Corporation in den USA und/oder anderen Ländern. Weitere auf dieser Homepage aufgeführten Produkt- und Firmennamen können geschützte Marken ihrer jeweiligen Inhaber sein.

Diese Seiten wurden optimiert für eine Bildschirmauflösung von mind. 1280x1024 Pixel