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 03.02.2000

Diese Seite wurde zuletzt aktualisiert am 03.02.2000
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 den 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 ListBoxMaskOCX

UserControl ListBoxMask (Public):

Private Const kMarginWidth = 2

Public Event Click()
Public Event DblClick()
Public Event MouseDown(Button As Integer, Shift As Integer, _
 X As Single, Y As Single)
Public Event MouseMove(Button As Integer, Shift As Integer, _
 X As Single, Y As Single)
Public Event MouseUp(Button As Integer, Shift As Integer, _
 X As Single, Y As Single)
Public Event OLEDragDrop(Data As DataObject, Effect As Long, _
 Button As Integer, Shift As Integer, X As Single, Y As Single)
Public Event OLEDragOver(Data As DataObject, Effect As Long, _
 Button As Integer, Shift As Integer, X As Single, Y As Single, _
 State As Integer)

Public Enum lbmAppearanceConstants
  lbm2D
  lbm3D
End Enum

Public Enum lbmOLEDropConstants
  lbmOLEDropNone = vbOLEDropNone
  lbmOLEDropManual = vbOLEDropManual
  lbmOLEDropContainer = 99
End Enum

Private pMarginWidth As Single
Private pOLEDropMode As lbmOLEDropConstants
Private pShowMask As Boolean

Public Property Get Appearance() As lbmAppearanceConstants
  Appearance = ucBorder.Appearance
End Property

Public Property Let Appearance(ByVal New_Appearance _
 As lbmAppearanceConstants)

  Select Case New_Appearance
    Case ucBorder.Appearance
    Case lbm2D, lbm3D
      ucBorder.Appearance = New_Appearance
      UserControl_Resize
    Case Else
      Err.Raise 380
  End Select
  PropertyChanged "Appearance"
End Property

Public Property Get MarginColor() As OLE_COLOR
  MarginColor = ucBorder.BackColor
End Property

Public Property Let MarginColor(ByVal New_MarginColor As OLE_COLOR)
  ucBorder.BackColor = New_MarginColor
  PropertyChanged "MarginColor"
End Property

Public Property Get MarginWidth() As Single
  MarginWidth = pMarginWidth * Screen.TwipsPerPixelX
End Property

Public Property Let MarginWidth(ByVal New_MarginWidth As Single)
  Select Case New_MarginWidth
    Case pMarginWidth
    Case Is >= 2 * Screen.TwipsPerPixelX
      pMarginWidth = New_MarginWidth \ Screen.TwipsPerPixelX
      UserControl_Resize
    Case Else
      pMarginWidth = 2
      UserControl_Resize
  End Select
  PropertyChanged "MarginWidth"
End Property

Public Property Get MaskColor() As OLE_COLOR
  MaskColor = UserControl.BackColor
End Property

Public Property Let MaskColor(ByVal New_MaskColor As OLE_COLOR)
  UserControl.BackColor = New_MaskColor
  PropertyChanged "MaskColor"
End Property

Public Property Get OLEDropMode() As lbmOLEDropConstants
  OLEDropMode = pOLEDropMode
End Property

Public Property Let OLEDropMode(ByVal New_OLEDropMode _
 As lbmOLEDropConstants)

  Select Case New_OLEDropMode
    Case lbmOLEDropContainer
      pOLEDropMode = New_OLEDropMode
      On Error Resume Next
      UserControl.OLEDropMode = Extender.Container.OLEDropMode
      If Err.Number Then
        Err.Clear
        UserControl.OLEDropMode = vbOLEDropNone
      End If
    Case lbmOLEDropNone, lbmOLEDropManual
      pOLEDropMode = New_OLEDropMode
      UserControl.OLEDropMode = pOLEDropMode
    Case Else
      Err.Raise 380
  End Select
  PropertyChanged "OLEDropMode"
End Property

Public Property Get ShowMask() As Boolean
  ShowMask = pShowMask
End Property

Public Property Let ShowMask(ByVal New_ShowMask As Boolean)
  If pShowMask <> New_ShowMask Then
    pShowMask = New_ShowMask
    UserControl_Resize
  End If
  PropertyChanged "ShowMask"
End Property

Private Sub UserControl_Click()
  RaiseEvent Click
End Sub

Private Sub UserControl_DblClick()
  RaiseEvent DblClick
End Sub

Private Sub UserControl_MouseDown(Button As Integer, _
 Shift As Integer, X As Single, Y As Single)

  Dim nX As Single
  Dim nY As Single
  
  If zConvertToContainer(X, Y, nX, nY) Then
    RaiseEvent MouseDown(Button, Shift, nX, nY)
  End If
End Sub

Private Sub UserControl_MouseMove(Button As Integer, _
 Shift As Integer, X As Single, Y As Single)

  Dim nX As Single
  Dim nY As Single
  
  If zConvertToContainer(X, Y, nX, nY) Then
    RaiseEvent MouseMove(Button, Shift, nX, nY)
  End If
End Sub

Private Sub UserControl_MouseUp(Button As Integer, _
 Shift As Integer, X As Single, Y As Single)

  Dim nX As Single
  Dim nY As Single
  
  If zConvertToContainer(X, Y, nX, nY) Then
    RaiseEvent MouseUp(Button, Shift, nX, nY)
  End If
End Sub

Private Sub UserControl_OLEDragDrop(Data As DataObject, _
 Effect As Long, Button As Integer, Shift As Integer, _
 X As Single, Y As Single)

  Dim nX As Single
  Dim nY As Single
  
  If zConvertToContainer(X, Y, nX, nY) Then
    RaiseEvent OLEDragDrop(Data, Effect, Button, Shift, nX, nY)
  End If
End Sub

Private Sub UserControl_OLEDragOver(Data As DataObject, _
 Effect As Long, Button As Integer, Shift As Integer, _
 X As Single, Y As Single, State As Integer)

  Dim nX As Single
  Dim nY As Single
  
  If zConvertToContainer(X, Y, nX, nY) Then
    RaiseEvent OLEDragOver(Data, Effect, Button, Shift, _
     nX, nY, State)
  End If
End Sub

Private Sub UserControl_Initialize()
  pMarginWidth = kMarginWidth
  pShowMask = True
End Sub

Private Sub UserControl_InitProperties()
  ucBorder.BackColor = vbWindowBackground
  UserControl.BackColor = Ambient.BackColor
End Sub

Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
  ucBorder.Appearance = PropBag.ReadProperty("Appearance", lbm3D)
  ucBorder.BackColor = PropBag.ReadProperty("MarginColor", _
   vbWindowBackground)
  pMarginWidth = PropBag.ReadProperty("MarginWidth", kMarginWidth)
  UserControl.BackColor = PropBag.ReadProperty("MaskColor", _
   Ambient.BackColor)
  Me.OLEDropMode = PropBag.ReadProperty("OLEDropMode", _
   lbmOLEDropNone)
  pShowMask = PropBag.ReadProperty("ShowMask", True)
End Sub

Private Sub UserControl_Resize()
  If pShowMask Then
    ln.Visible = False
    With UserControl
      If .Width < 6 * Screen.TwipsPerPixelX Then
        ucBorder.Visible = False
      Else
        On Error Resume Next
        ucBorder.Move .ScaleWidth - _
         (pMarginWidth * Screen.TwipsPerPixelX), 0, _
         .Width, .ScaleHeight
        ucBorder.Visible = Not CBool(Err.Number)
        Err.Clear
      End If
    End With
    UserControl.BackStyle = 1
  Else
    ucBorder.Visible = False
    UserControl.BackStyle = 0
    If Ambient.UserMode Then
      ln.Visible = False
    Else
      ln.X1 = UserControl.ScaleWidth - Screen.TwipsPerPixelX
      ln.X2 = ln.X1
      ln.Y1 = 0
      ln.Y2 = UserControl.ScaleHeight
      ln.Visible = True
      ln.Refresh
    End If
  End If
  ucBorder.Refresh
  UserControl.Refresh
End Sub

Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
  PropBag.WriteProperty "Appearance", ucBorder.Appearance, lbm3D
  PropBag.WriteProperty "MarginColor", ucBorder.BackColor, _
   vbWindowBackground
  PropBag.WriteProperty "MaskColor", UserControl.BackColor, _
   Ambient.BackColor
  PropBag.WriteProperty "MarginWidth", pMarginWidth, kMarginWidth
  PropBag.WriteProperty "OLEDropMode", pOLEDropMode, lbmOLEDropNone
  PropBag.WriteProperty "ShowMask", pShowMask, True
End Sub

Private Function zConvertToContainer(ByVal X As Single, _
 ByVal Y As Single, rX As Single, rY As Single) As Boolean

  If X < ucBorder.Left Then
    With Extender
      rX = UserControl.ScaleX(X, vbTwips, vbContainerPosition) _
       + .Left
      rY = UserControl.ScaleY(Y, vbTwips, vbContainerPosition) _
       + .Top
    End With
    zConvertToContainer = True
  End If
End Function

 

UserControl ucBorder (Private):

Private pBackColor As Long

Public Property Get Appearance() As Integer
  Appearance = UserControl.Appearance
End Property

Public Property Let Appearance(ByVal New_Appearance As Integer)
  UserControl.Appearance = New_Appearance
End Property

Public Property Get BackColor() As OLE_COLOR
  BackColor = pBackColor
End Property

Public Property Let BackColor(ByVal New_BackColor As OLE_COLOR)
  pBackColor = New_BackColor
  UserControl.BackColor = pBackColor
End Property

Public Sub Refresh()
  UserControl.Refresh
  UserControl.BackColor = pBackColor
End Sub

Zum Text "ListBox sortiert & maskiert" 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