Rubrik: Controls · Sonstiges | VB-Versionen: VB5, VB6 | 18.08.03 |
HyperLabel der Extra(Klasse)... Ein HyperLabel für Mail-, URL- und Dokumentenlinks | ||
Autor: Roland Wutzke | Bewertung: | Views: 13.295 |
www.vb-power.net | System: 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:
- 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.