ABOUT Visual Basic Programmieren Programmierung Download Downloads Tips & Tricks Tipps & Tricks Know-How Praxis VB VBA Visual Basic for Applications VBS VBScript Scripting Windows ActiveX COM OLE API ComputerPC Microsoft Office Microsoft Office 97 Office 2000 Access Word Winword Excel Outlook Addins ASP Active Server Pages COMAddIns ActiveX-Controls OCX UserControl UserDocument Komponenten DLL EXE
Diese Seite wurde zuletzt aktualisiert am 09.11.1999

Diese Seite wurde zuletzt aktualisiert am 09.11.1999
Aktuell im ABOUT Visual Basic-MagazinGrundlagenwissen und TechnologienKnow How, Tipps und Tricks rund um Visual BasicAddIns für die Visual Basic-IDE und die VBA-IDEVBA-Programmierung in MS-Office und anderen AnwendungenScripting-Praxis für IE, Windows Scripting Host und das Scripting-ControlTools, Komponenten und Dienstleistungen des MarktesRessourcen für Programmierer (Bücher, Job-Börse)Dies&Das...

Themen und Stichwörter im ABOUT Visual Basic-Magazin
Code, Beispiele, Komponenten, Tools im Überblick, Shareware, Freeware
Ihre Service-Seite, Termine, Job-Börse
Melden Sie sich an, um in den vollen Genuss des ABOUT Visual Basic-Magazins zu kommen!
Informationen zur AVB-Web-Site, Kontakt und Impressum

Zurück...

Zurück...


Anzeige

Code des Controls ListItemEvents

Option Explicit

Private Declare Function SendMessage Lib "User32" _
 Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, _
 ByVal wParam As Long, ByVal lParam As Long) As Long

Private WithEvents eListBox As ListBox

Public Event InitDone(ByVal Success As Boolean)
Public Event MouseDown(ItemIndex As Long, Button As Integer, _
 Shift As Integer, X As Single, Y As Single)
Public Event MouseMove(ItemIndex As Long, Button As Integer, _
 Shift As Integer, X As Single, Y As Single)
Public Event MouseUp(ItemIndex As Long, Button As Integer, _
 Shift As Integer, X As Single, Y As Single)

Private pEnabled As Boolean
Private pListBox As String

Public Property Get Enabled() As Boolean
  Enabled = pEnabled
End Property

Public Property Let Enabled(ByVal New_Enabled As Boolean)
  pEnabled = New_Enabled
  PropertyChanged "Enabled"
End Property

Public Property Get ItemHeight(Optional ByVal ScaleMode As _
 Integer = vbTwips) As Single
  Dim nItemHeight As Long
  
  Const LB_GETITEMHEIGHT = &H1A1
  
  nItemHeight = SendMessage(eListBox.hWnd, LB_GETITEMHEIGHT, 0, 0)
  ItemHeight = UserControl.ScaleY(nItemHeight, vbPixels, ScaleMode)
End Property

Public Property Let ItemHeight(Optional ByVal ScaleMode As _
 Integer = vbTwips, ByVal New_ItemHeight As Single)
  Dim nItemHeight As Long
  
  Const LB_SETITEMHEIGHT = &H1A0
  
  nItemHeight = UserControl.ScaleY(New_ItemHeight, ScaleMode, vbPixels)
  With eListBox
    SendMessage .hWnd, LB_SETITEMHEIGHT, 0, nItemHeight
    .Refresh
  End With
End Property

Public Property Get ListBox() As String
  zFindListBox
  ListBox = pListBox
End Property

Public Property Let ListBox(ByVal New_ListBox As String)
  If Ambient.UserMode Then
    pListBox = New_ListBox
    zSetListBoxControl
  End If
End Property

Public Property Set ListBox(New_ListBox As Object)
  Dim nSuccess As Boolean
  
  If Ambient.UserMode Then
    pListBox = ""
    If TypeOf New_ListBox Is ListBox Then
      With New_ListBox
        If .Container Is Extender.Container Then
          On Error Resume Next
          Set eListBox = New_ListBox
          nSuccess = Not (eListBox Is Nothing)
          If nSuccess Then
            pListBox = .Name
            RaiseEvent InitDone(nSuccess)
          Else
            Set eListBox = Nothing
          End If
        Else
        End If
      End With
    End If
  End If
End Property

Public Function FindListBox() As Object
  zFindListBox
  Set FindListBox = eListBox
End Function

Public Function HitTest(ByVal Y As Single, Optional ByVal ScaleMode _
 As Integer = vbTwips, Optional ByVal X As Single) As Long
  HitTest = zGetIndex(X, Y, ScaleMode)
End Function

Private Sub eListBox_MouseDown(Button As Integer, _
 Shift As Integer, X As Single, Y As Single)
  If pEnabled Then
    RaiseEvent MouseDown(zGetIndex(X, Y, vbTwips), Button, _
     Shift, X, Y)
  End If
End Sub

Private Sub eListBox_MouseMove(Button As Integer, _
 Shift As Integer, X As Single, Y As Single)
  If pEnabled Then
    RaiseEvent MouseMove(zGetIndex(X, Y, vbTwips), Button, _
     Shift, X, Y)
  End If
End Sub

Private Sub eListBox_MouseUp(Button As Integer, _
 Shift As Integer, X As Single, Y As Single)
  If pEnabled Then
    RaiseEvent MouseUp(zGetIndex(X, Y, vbTwips), Button, _
     Shift, X, Y)
  End If
End Sub

Private Sub tmrSetListBox_Timer()
  tmrSetListBox.Enabled = False
  zSetListBoxControl
End Sub

Private Sub UserControl_Initialize()
  pEnabled = True
End Sub

Private Sub UserControl_Paint()
  If Not Ambient.UserMode Then
    With UserControl
      UserControl.Line (.ScaleWidth \ 2, 0)-Step(0, _
       .ScaleHeight), vbBlue
      UserControl.Line (0, .ScaleHeight \ 2)-Step(.ScaleWidth, _
       0), vbBlue
      UserControl.Line (0, 0)-(.ScaleWidth - 1, _
       .ScaleHeight - 1), vbBlack, B
    End With
  End If
End Sub

Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
  pEnabled = PropBag.ReadProperty("Enabled", True)
  pListBox = PropBag.ReadProperty("ListBox", "")
  If Ambient.UserMode Then
    Extender.Visible = False
    If Len(pListBox) Then
      tmrSetListBox.Enabled = True
    End If
  End If
End Sub

Private Sub UserControl_Resize()
  Static sInProc As Boolean
  
  If sInProc Then
    Exit Sub
  Else
    sInProc = True
  End If
  If Not Ambient.UserMode Then
    With UserControl
      .Size 1.5 * .TextHeight("A") * Screen.TwipsPerPixelX, _
       1.5 * .TextHeight("A") * Screen.TwipsPerPixelY
    End With
  End If
  sInProc = False
End Sub

Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
  PropBag.WriteProperty "Enabled", pEnabled, True
  PropBag.WriteProperty "ListBox", pListBox, ""
End Sub

Private Sub zFindListBox()
  Dim nControl As Control
  Dim nLeft As Single
  Dim nTop As Single
  
  If Not Ambient.UserMode Then
    pListBox = ""
    With Extender
      nLeft = .Left + (.Width \ 2)
      nTop = .Top + (.Height \ 2)
    End With
    On Error Resume Next
    For Each nControl In UserControl.Parent.Controls
      If TypeOf nControl Is ListBox Then
        With nControl
          If .Container Is Extender.Container Then
            Select Case nLeft
              Case .Left To .Left + .Width
                Select Case nTop
                  Case .Top To .Top + .Height
                    If .Index < 0 Then
                      pListBox = .Name
                      If Ambient.UserMode Then
                        zSetListBoxControl
                      End If
                      Exit For
                    End If
                End Select
            End Select
          End If
        End With
      End If
    Next
    Extender.ZOrder 0
  End If
End Sub

Private Sub zSetListBoxControl()
  Dim nControl As Control
  Dim nSuccess As Boolean
  
  Set eListBox = Nothing
  On Error Resume Next
  For Each nControl In UserControl.Parent.Controls
    With nControl
      If .Container Is Extender.Container Then
        If .Name = pListBox Then
          Set eListBox = nControl
          nSuccess = Not (eListBox Is Nothing)
          RaiseEvent InitDone(nSuccess)
          If nSuccess Then
            Exit For
          End If
        End If
      End If
    End With
  Next
  pListBox = ""
End Sub

Private Function zGetIndex(ByVal iX As Single, ByVal iY As Single, _
 ByVal iScaleMode As Integer) As Long
  Dim nXPoint As Long
  Dim nYPoint As Long
  Dim nPoint As Long
  Dim nIndex As Long
  
  Const LB_ITEMFROMPOINT = &H1A9

  With UserControl
    nXPoint = .ScaleX(iX, iScaleMode, vbPixels)
    nYPoint = .ScaleY(iY, iScaleMode, vbPixels)
    nPoint = nYPoint * 65536 + nXPoint
  End With
  With eListBox
    nIndex = SendMessage(.hWnd, LB_ITEMFROMPOINT, 0, nPoint)
    Select Case nIndex
      Case 0 To .ListCount - 1
        zGetIndex = nIndex
      Case Else
        zGetIndex = -1
    End Select
  End With
End Function

Zurück zu "Hit-Parade" Zurück zum Text   


Komponenten-Übersicht

Zum Seitenanfang

Copyright © 1999 - 2017 Harald M. Genauck, ip-pro gmbh  /  Impressum

Zum Seitenanfang

Zurück...

Zurück...

Download Internet Explorer