Advertisement
C_Volume2 Custom Controls/ Forms/ Menus #80497

Changing behaviour of ComboBox and ListBox (Class)

Changing behaviour of ComboBox and ListBox (Class)

AI

KI-Zusammenfassung: This codebase represents a historical implementation of the logic described in the metadata. Our preservation engine analyzes the structure to provide context for modern developers.

Quellcode
original-source
' Adjust Drop Down Width (ComboBox)
Public Sub AdjDropDownWidth(ByVal NewDropDownWidth As Long, ByVal ComboHwnd As Long)
  Call SendMessageLong(ComboHwnd, CB_SETDROPPEDWIDTH, NewDropDownWidth, 0)
  Call SendMessageLong(ComboHwnd, CB_GETDROPPEDWIDTH, 0, 0)
End Sub
Private Function GetCmbItemWidth(ByVal FormHwnd As Long) As Long
  Dim hFont As Long
  Dim hFontOld As Long
  Dim r As Long
  Dim avgWidth As Long
  Dim hDC As Long
  Dim sz As SIZE
  hDC = GetDC(FormHwnd)
  hFont = GetStockObject(ANSI_VAR_FONT)
  hFontOld = SelectObject(hDC, hFont)
  Call GetTextExtentPoint32(hDC, tmp, 52, sz)
  avgWidth = (sz.cX / 52)
  Call SelectObject(hDC, hFontOld)
  Call DeleteObject(hFont)
  Call ReleaseDC(FormHwnd, hDC)
  GetCmbItemWidth = avgWidth
End Function
' Set Drop Down Height (ComboBox)
Public Sub SetCmbDropDownHeight(ByVal numItemsToDisplay As Byte, ByVal objCombo As ComboBox)
  Dim cWidth As Long
  Dim newHeight As Long
  Dim oldScaleMode As Long
  Dim itemHeight As Long
  Dim ComboHwnd As Long
  ComboHwnd = objCombo.hwnd
  oldScaleMode = objCombo.Parent.ScaleMode
  objCombo.Parent.ScaleMode = vbPixels
  cWidth = objCombo.Width
  itemHeight = SendMessageLong(ComboHwnd, CB_GETITEMHEIGHT, 0, 0)
  newHeight = itemHeight * (numItemsToDisplay + 2)
  Call MoveWindow(ComboHwnd, objCombo.Left / Screen.TwipsPerPixelX, objCombo.Top / Screen.TwipsPerPixelX, objCombo.Width / Screen.TwipsPerPixelX, newHeight, True)
  objCombo.Parent.ScaleMode = oldScaleMode
End Sub
' Auto Adjust Drop Down Width (ComboBox)
Public Sub AutoAdjCombo(ByVal objCombo As ComboBox)
  Dim i As Long
  Dim NumOfChars As Long
  Dim LongestComboItem As Long
  Dim avgCharWidth As Long
  Dim NewDropDownWidth As Long
  Dim ComboHwnd As Long
  ComboHwnd = objCombo.hwnd
  For i = 0 To objCombo.ListCount - 1
    NumOfChars = SendMessageLong(ComboHwnd, CB_GETLBTEXTLEN, i, 0)
    If NumOfChars > LongestComboItem Then LongestComboItem = NumOfChars
  Next
  avgCharWidth = GetCmbItemWidth(objCombo.Parent.hwnd)
  NewDropDownWidth = (LongestComboItem - 2) * avgCharWidth
  Call SendMessageLong(ComboHwnd, CB_SETDROPPEDWIDTH, NewDropDownWidth, 0)
  Call SendMessageLong(ComboHwnd, CB_GETDROPPEDWIDTH, 0, 0)
End Sub
' Show Drop Down (ComboBox)
Public Sub Dropdown(ByVal ComboHwnd As Long)
  Call SendMessageLong(ComboHwnd, CB_SHOWDROPDOWN, True, 0)
End Sub
' Hide Drop Down (ComboBox)
Public Sub HideDropDown(ComboHwnd As Long)
  Call SendMessageLong(ComboHwnd, CB_SHOWDROPDOWN, False, ByVal 0)
End Sub
' Copy contents of a listbox to another listbox
Public Function CopyListToList(SourceHwnd As Long, DestHwnd As Long) As Long
  Dim c As Long
  Const LB_GETCOUNT = &H18B
  Const LB_GETTEXT = &H189
  Const LB_ADDSTRING = &H180
  Dim numitems As Long
  Dim sItemText As String * 255
  numitems = SendMessageLong(SourceHwnd, LB_GETCOUNT, 0&, 0&)
  LockWinUpdate DestHwnd
  If numitems > 0 Then
    For c = 0 To numitems - 1
      Call SendMessageStr(SourceHwnd, LB_GETTEXT, c, ByVal sItemText)
      Call SendMessageStr(DestHwnd, LB_ADDSTRING, 0&, ByVal sItemText)
    Next
  End If
  LockWinUpdate 0&
  numitems = SendMessageLong(DestHwnd, LB_GETCOUNT, 0&, 0&)
  CopyListToList = numitems
End Function
' Copy contents of a listbox to a combobox
Public Function CopyListToCombo(SourceHwnd As Long, DestHwnd As Long) As Long
  Dim c As Long
  Const LB_GETCOUNT = &H18B
  Const LB_GETTEXT = &H189
  Const CB_GETCOUNT = &H146
  Const CB_ADDSTRING = &H143
  Dim numitems As Long
  Dim sItemText As String * 255
  numitems = SendMessageLong(SourceHwnd, LB_GETCOUNT, 0&, 0&)
  LockWinUpdate DestHwnd
  If numitems > 0 Then
    For c = 0 To numitems - 1
      Call SendMessageStr(SourceHwnd, LB_GETTEXT, c, ByVal sItemText)
      Call SendMessageStr(DestHwnd, CB_ADDSTRING, 0&, ByVal sItemText)
    Next
  End If
  LockWinUpdate 0&
  numitems = SendMessageLong(DestHwnd, CB_GETCOUNT, 0&, 0&)
  CopyListToCombo = numitems
End Function
'Set horizontal extent (ListBox)
Public Sub SetLBHorizontalExtent(objLB As ListBox)
  Dim i As Integer
  Dim res As Long
  Dim Scrollwidth As Long
  With objLB
    For i = 0 To .ListCount
      If .Parent.TextWidth(.List(i)) > Scrollwidth Then _
      Scrollwidth = .Parent.TextWidth(.List(i))
    Next i
    res = SendMessage(.hwnd, LB_SETHORIZONTALEXTENT, _
      (Scrollwidth + 100) / Screen.TwipsPerPixelX, 0)
  End With
End Sub
' Highlight An Item When Your Mouse Is Over It (ListBox)
Public Sub HighlightLBItem(ByVal LBHwnd As Long, ByVal X As Single, ByVal Y As Single)
  Dim ItemIndex As Long
  Dim AtThisPoint As POINTAPI
  AtThisPoint.X = X \ Screen.TwipsPerPixelX
  AtThisPoint.Y = Y \ Screen.TwipsPerPixelY
  Call ClientToScreen(LBHwnd, AtThisPoint)
  ItemIndex = LBItemFromPt(LBHwnd, AtThisPoint.X, AtThisPoint.Y, False)
  If ItemIndex <> SendMessage(LBHwnd, LB_GETCURSEL, 0, 0) Then
    Call SendMessage(LBHwnd, LB_SETCURSEL, ItemIndex, 0)
  End If
End Sub
' Set Tab Stops (ListBox)
Public Sub SetTabsTops(ByVal LBHwnd As Long)
  Dim tabsets&(2)
  tabsets(0) = 45
  tabsets(1) = 110
  Call SendMessageLongByRef(LBHwnd, LB_SETTABSTOPS, 2, tabsets(0))
End Sub
' Increase Performance of Adding Data Into
' ComboBox and ListBox
Private Sub LockWinUpdate(ByVal hwndLock As Long)
  Call LockWindowUpdate(hwndLock)
End Sub
Originalkommentare (3)
Wiederhergestellt von der Wayback Machine