Sie sind aktuell nicht angemeldet.

Funktionen: Einloggen  |  Neu registrieren  |  Suchen

Ergänzungsvorschlag Hover-Button
Autor: luet
Datum: 12.08.02 20:49
Hi, ich hab mal den Bug mit der Tag-Eigenschaft beseitigt und den Hovereffekt durch ein Hervorspringen und Fontänderung ergänzt . Bitte mal testen und Reaktionen mal posten. Danke luet Private Declare Function CreateRoundRectRgn Lib "gdi32" _ (ByVal X1 As Long, ByVal Y1 As Long, _ ByVal X2 As Long, ByVal Y2 As Long, _ ByVal X3 As Long, ByVal Y3 As Long) As Long Private Declare Function SetWindowRgn Lib "user32" _ (ByVal hWnd As Long, ByVal hRgn As Long, _ ByVal bRedraw As Boolean) As Long Private Declare Function SetCapture Lib "user32" _ (ByVal hWnd As Long) As Long Private Declare Function ReleaseCapture Lib "user32" () As Long ' Schaltflächen-Farben Private Const lBackcolor_Normal As Long = &HC0C0C0 Private Const lBackColor_Hover As Long = &HC00000 Private Const lForeColor_Normal As Long = &H0 Private Const lForeColor_Hover As Long = &HFFFFFF Dim Bewegt As Boolean Dim Myleft() As Integer Dim Mytop() As Integer Private Sub Form_Load() Dim i As Integer Dim X As Integer Dim Y As Integer Dim n As Long ReDim Myleft(0 To MyButton().Count - 1) ReDim Mytop(0 To MyButton().Count - 1) ' alle "Buttons" durchlaufen For i = 0 To MyButton.UBound With MyButton(i) ' Hintergrundfarbe der Form anpassen .BackColor = Me.BackColor 'Left + Top speichern Myleft(i) = .left Mytop(i) = .Top ' Kein Border! .BorderStyle = 0 .Appearance = 0 .Height = 255 ' Text mittig .Alignment = 2 ' Hinter-/Vordergrundfarbe .BackColor = lBackcolor_Normal .ForeColor = lForeColor_Normal ' Normaler Mauszeiger (kein I) .MousePointer = 1 ' Ecken abrunden X = .Width / Screen.TwipsPerPixelX Y = .Height / Screen.TwipsPerPixelY n = 20 SetWindowRgn .hWnd, _ CreateRoundRectRgn(0, 0, X, Y, 40, n), True End With Next i ' zusätzliche PictureBox außerhalb der Form ' verschieben With Picture1 .Move -100, -100, 15, 15 End With End Sub Private Sub MyButton_MouseDown(Index As Integer, _ Button As Integer, Shift As Integer, _ X As Single, Y As Single) ' Button verschieben With MyButton(Index) .Move Myleft(Index) + 20, Mytop(Index) + 20 End With End Sub Private Sub MyButton_MouseMove(Index As Integer, _ Button As Integer, Shift As Integer, _ X As Single, Y As Single) ' Hover-Effekt realisieren With MyButton(Index) If X >= 0 And Y >= 0 And X <= .Width And Y <= .Height Then ' Maus befindet sich über der "Schaltfläche" SetCapture .hWnd ' If Button = 0 And .Tag = .Top Then If Bewegt = False Then .Move Myleft(Index) - 20, Mytop(Index) - 20 Bewegt = True End If .FontBold = True .ForeColor = lForeColor_Hover .BackColor = lBackColor_Hover Else ' Maus außerhalb ReleaseCapture ' If Button = 0 And .Top <> .Tag Then If Bewegt = True Then .Move Myleft(Index) + 20, Mytop(Index) + 20 Bewegt = False End If .FontBold = False .ForeColor = lForeColor_Normal .BackColor = lBackcolor_Normal End If End With End Sub Private Sub MyButton_GotFocus(Index As Integer) ' Bekommt die TextBox (ähmm... unsere Schaltfläche) ' den Fokus, wird dieser an die nicht sichtbare PictureBox ' umgeleitet, da sonst der I-Cursor zu sehen ist Picture1.SetFocus End Sub Private Sub MyButton_MouseUp(Index As Integer, _ Button As Integer, Shift As Integer, _ X As Single, Y As Single) With MyButton(Index) ' Originalposition wiederherstellen .Move Myleft(Index) - 20, Mytop(Index) - 20 ' Originalfarben .BackColor = lBackcolor_Normal .ForeColor = lForeColor_Normal .FontBold = False End With ' Klick-Event MsgBox "Klick auf " + CStr(MyButton(Index).Name) + " " + CStr(Index) End Sub

Ergänzungsvorschlag Hover-Button

61

luet

12.08.02 20:49

Sie sind nicht angemeldet! Um auf diesen Beitrag zu antworten oder neue Beiträge schreiben zu können, müssen Sie sich zunächst anmelden. Einloggen  |  Neu registrieren

Funktionen:  Zum Thema  |  Gesamtübersicht

Suchen