Was man wissen muss:
neuer ist nicht unbedingt besser!

Timo Kunze, der Vater der VB6 Unicode-Controls, hat es einmal gut erklärt (Zitat):

"Die 5er greifen auf die comctl32.dll zurück, d. h. sie sind nur eine COM-Hülle um die nativen Controls von Windows (eben so wie meine Controls). Diese COM-Hülle der 5er Controls mag über 10 Jahre alt sein, aber die Unterlage, also die comctl32.dll ist brandaktuell. Deshalb funktioniert mit den 5ern bspw. auch das Theming. Bei den 6er Controls ist Microsoft dagegen einen anderen Weg gegangen. Man hat 1998 oder so den Quellcode der comctl32.dll genommen und ihm ein COM-Interface verpasst. Das Ergebnis war die mscomctl.ocx, die nicht mehr von der comctl32.dll abhängt.

Vorteil: Die Controls verhalten sich auf allen Windows-Versionen gleich.
Nachteil: Man ist auch unter Windows 7 noch auf den Funktionsumfang von 1998 beschränkt. Deshalb funktioniert mit den 6ern bspw. kein Theming."

Um also optisch und funktionell mit VB6 Programme für Vista und Windows 7 zu schreiben empfiehlt es sich die Microsoft Windows Common Controls 5.0 zu verwenden - besonders dann, wenn ListView und/oder TreeView Controls zum Einsatz kommen. Einige der folgenden Tipps setzen den Einsatz der 5er Controls voraus...

Leider stellt das ListView-Control von Hause aus keine Methode zum Optimieren der Spaltenbreite in der Reportansicht zur Verfügung. Diese Funktion läßt sich aber wieder einmal mit einem API-Aufruf nachbilden, und zwar mit dem SendMessage Befehl. Übrigens - auch der Windows Explorer unterstütz diese Funktion: öffnen Sie ein Explorerfenster in der Detailansicht, halten Sie die <Strg>-Taste gedrückt und betätigen die <+>-Taste des Ziffernblocks...

' Deklaration:
Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
        (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

' Funktion:
Public Sub lvwSetColumnWidth(lstView As ListView, ByVal colIdx As Long)
  Const LV_SETCOLUMNWIDTH As Long = &H101E
 
  With lstView
    ' Prüfen, ob das Listview in der Ansicht "Report" ist
    If .View = lvwReport Then
      If colIdx > 0 And colIdx <= .ColumnHeaders.Count Then
        SendMessage .hwnd, LV_SETCOLUMNWIDTH, colIdx - 1, -2
      End If
    End If
  End With
End Sub

' Aufruf für alle Spalten eines ListView:
For i = 1 To ListView1.ListItms.Count
  lvwSetColumnWidth ListView1, i
Next i

Autor: ralf schlegel
Stand: 12/2004

Nach oben

Das TabStrib-Control und seine Registerkarten wird in den meisten Anwendungen zum Beispiel in der Auswahl der Programmeigenschaften eingesetzt. Leider, so scheint es, gibt es keine Methode um eine bestimmte Registerkarte zur Laufzeit zu aktivieren. Und dennoch läßt sich diese Eigenschaft mit einer einzigen Codezeile realisieren:

TabStrip1.Tabs(Index).Selected = True

Wobei 'Index' für die gewünschte Registerkarte steht.
Vorsicht: Der Index beginnt in diesem Fall bei 1!

Autor: ralf schlegel
Stand:03/2005

Nach oben

Wenn Sie den Slider der Standard-Controls mit der Maus verschieben, so erscheint grundsätzlich der Wert (value) des Controls als ToolTip-Text. Das ist nicht immer sinnvoll und kann mit zwei einfachen SendMessage Aufrufen unterbunden werden. Kopieren Sie die unten stehende Funktion in ein Programm-Modul und rufen Sie sie einmal (zum Beispiel in der Load-Anweisung der Parent-Form) auf. Übergeben Sie der Funktion das Handle des Sliders:

' Deklaration:
Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
        (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

' Funktion:
Public Sub sliderToolTipOff(ByVal hwnd As Long)
  Dim ret As Long

  ret = SendMessage(hwnd, &H41E, 0&, ByVal 0&)
  SendMessage ret, &H401, 0&, ByVal 0&
End Sub

Autor: ralf schlegel
Stand: 03/2007

Nach oben

Mit dem Standard ListView-Control die Abstände der Icons einstellen...
Das ist eine Funktion, die man vergeblich in den Eigenschaften dieses Controls sucht.
In der MSDN wird man aber schnell fündig: es ist wieder einmal die SendMessage-Funktion, die uns von der API angeboten wird, um eben diesen Effekt nachzubilden. Leider funktioniert das Ganze unter VB6 mal wieder nicht so richtig: egal was wir als Parameter übergeben - das Ergebnis sind stets die gleichen überlappenden Icons! Abhilfe schafft hier eine kleine Änderung:
Verwenden Sie PostMessage statt SendMessage!

Hintergrund: PostMessage arbeitet fast genauso wie SendMessage - setzt die Nachricht in die Warteschlange von Windows, kehrt aber sofort zurück, während SendMessage auf einen Rückgabewert wartet! Das scheint in VB Probleme zu verursachen. Also nutzen Sie die Post und vertrauen darauf, dass die Zustellung auch erfolgt! :-)

Was Sie sonst noch wissen sollten:

• Die Abstände wSpace und hSpace repräsentieren Pixel (und nicht Twips!)
• Zum gewünschten Abstand muß die aktuelle Icongröße addiert werden!
  Bsp.: gewünschter Abstand = 40px, Icongröße = 32px -> wSpace/hSpace = 40+32 = 72
• wSpace = -1 und hSpace = -1 setzt die Abstände wieder auf Default
• Die Funktion muss vor dem Füllen des ListView-Controls aufgerufen werden!

' Deklaration:
Public Declare Function PostMessage Lib "user32" Alias" PostMessageA" (ByVal hWnd As Long, _
       ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

' Funktion:
' Setzt den Abstand der Icons im ListView-Control in Pixel
' Minimaler Wert ist 4Pixel! wSpace/hSpace = Icongröße+Abstand in Pixel!
Public Function ListViewSetIconSpace(ByVal hWnd As Long, _
                ByVal wSpace As Integer, ByVal hSpace As Integer) As Long
  Dim isp As Long

  isp = (wSpace And &HFFFF&) Or (hSpace * &H10000) ' MakeLong
  ListViewSetIconSpace = PostMessage(hWnd, &H1035&, 0, isp)
End Function

Autor: ralf schlegel
Stand: 06/2009

Nach oben

Zum Speichern und Wiederherstellen der Spaltenreihenfolge stellt Microsoft im ListView API die Methoden LVM_SETCOLUMNORDERARRAY und LVM_GETCOLUMNORDERARRAY zur Verfügung, die wir in VB6 mit der SendMessage Funktion leicht implementieren können:

' Konstanten:
Private Const LVM_FIRST As Long = &H1000&
Private Const LVM_SETCOLUMNORDERARRAY As Long = (LVM_FIRST + 58)
Private Const LVM_GETCOLUMNORDERARRAY As Long = (LVM_FIRST + 59)

' Declaration Systemfunktionen:
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, _
        ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function SendMessageLong Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, _
        ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Private Function pSetColumnOrderArray(ByVal hwnd As Long, ByVal iCount As Long, _
                                        ByRef lpiArray As Long) As Boolean
  pSetColumnOrderArray = SendMessage(hwnd, LVM_SETCOLUMNORDERARRAY, ByVal iCount, lpiArray)
End Function

Private Function pGetColumnOrderArray(ByVal hwnd As Long, ByVal iCount As Long, _
                                        ByRef lpiArray() As Long) As Boolean
  ReDim lpiArray(iCount - 1)
  pGetColumnOrderArray = SendMessage(hwnd, LVM_GETCOLUMNORDERARRAY, ByVal iCount, lpiArray(0))
End Function

Es bietet sich nun an, diese Information in der Registry zu speichern. Wie man den Funktionen aber entnehmen kann, arbeitet Microsoft hierbei mit einem LongArray! Um nun dieses LongArray mit den VB Funktionen GetSetting und SaveSetting verarbeiten zu können, muss dieses Array in einen String gewandelt werden. Dafür benötigen wir 2 Hilfsfunktionen:

' Wandelt ein LongArray in einen String,
' wobei das Trennzeichen optional gewählt werden kann:
Private Function pLongArrayToString(ByRef lArray() As Long, _
                                    Optional delimiter As String = ";") As String
  Dim i As Long
  
  If IsArray(lArray) Then
    For i = LBound(lArray) To UBound(lArray)
      pLongArrayToString = pLongArrayToString & CStr(lArray(i)) & delimiter
    Next
  End If
End Function

' Zerlegt den übergebenen String gemäß Trennzeichen und
' gibt die Werte as LongArray zurück
Private Function pStringToLongArray(ByVal s As String, _
                                    Optional delimiter As String = ";") As Long()
  Dim i As Long
  Dim fld() As Long
  Dim fields() As String
  
  fields = Split(s, delimiter)
  ReDim fld(UBound(fields))
  For i = 0 To UBound(fields)
    fld(i) = Val(fields(i))
  Next i
  Erase fields
  pStringToLongArray = fld
End Function

Kommen wir nun zu den eigentlichen Funktionen: lvwLoadColumnOrder und lvwSaveColumnOrder.
Diesen Funktionen muß lediglich das ListView-Objekt übergeben werden. Die Deklaration "As Object" ermöglicht uns dabei die gleichzeitige Verwendung der ListViews der Common Controls 5.0 UND 6.0 in einem Projekt:

Public Sub lvwLoadColumnOrder(ByVal lstView As Object)
  Dim nr As Long, cols() As Long
  Dim regString As String
  
  With lstView
    nr = .ColumnHeaders.Count
    If nr = 0 Then Exit Sub
    regString = GetSetting(App.Title, "Settings", .Parent.Name & "." & .Name & "_Columns", "0;")
    cols = pStringToLongArray(regString)
    If UBound(cols) > nr Then ReDim Preserve cols(nr)
    pSetColumnOrderArray .hwnd, UBound(cols), cols(0)
  End With
End Sub

Public Sub lvwSaveColumnOrder(ByVal lstView As Object)
  Dim nr As Long, cols() As Long
  Dim regString As String
  
  With lstView
    nr = .ColumnHeaders.Count
    If nr = 0 Then Exit Sub
    pGetColumnOrderArray .hwnd, nr, cols
    regString = pLongArrayToString(cols)
    SaveSetting App.Title, "Settings", .Parent.Name & "." & .Name & "_Columns", regString
  End With
End Sub

Damit Sie nicht alles abtippen oder kopieren müssen, finden Sie hier ein kleines Demoprojekt zum Download:

   0005_LVColumnOrder.zip

Autor: ralf schlegel
Stand: 02/2011

Nach oben

Wie man den XP-Style und die Windows-Themes ins eigene Projekt mit Hilfe einer Manifestdatei einbindet, wird ja bereits in zahlreichen Tipps im Internet beschrieben. Leider geht man hierbei aber immer nur auf die Standard-Controls ein.
Dass das Ganze auch mit ListView und TreeView funktioniert, zeigt der folgende Tipp:

Voraussetzungen / Einschränkungen:

• Die Anwendung läuft unter Windows XP oder höher
• Sie verwenden die Microsoft Common Controls V5.0 (nicht 6.0!)
• Es wurde eine Manifestdatei angelegt oder als Resource eingebunden
• Der Effekt ist nur in der compilierten Anwendung sichtbar (nicht in der IDE)

Da der Quellcode etwas umfangreicher ist schauen Sie sich bitte das Beispielprojekt an und kopieren die benötigten Dateien oder Funktionen dann in Ihr Projekt. Das Beispiel sollte ausreichend dokumentiert sein: alles zur Erweiterung der Styles findet in der 'Form_Load' Prozedur statt. Die Manifestdatei wurde per Resource eingebunden.

   0006_XPThemes.zip

Autor: ralf schlegel
Stand: 03/2011

Nach oben

Ein Hintergrundbild als Wasserzeichen LVBKIF_TYPE_WATERMARK im ListView zu implementieren, ist in VisualBasic 6 nicht so einfach möglich!

• Das Problem: laut MSDN muss für das Wasserzeichen die Grafik als Handle übergeben. Dabei übernimmt das ListView die 'Speicherkontrolle' des Bildes, d.h.: wird ein anderes Bild ins ListView geladen, oder das ListView selbst entladen, so wird die Grafik zerstört!
• Die Lösung: wir müssen von dem zu verwendenden Bild eine Kopie im Speicher erstellen und hiervon das Bitmap-Handle an die ListView-Funktion übergeben. Löschen brauchen wir diese Kopie nicht mehr - das übernimmt in jedem Fall das Control.

Hier also erst einmal die Funktion, die aus einem beliebigen Picture-Objekt eine Bitmap-Kopie erzeugt und das Handle zurückgibt:

Private Declare Function GetObjectAPI Lib "gdi32" Alias "GetObjectA" ( _
        ByVal hObject As Long, ByVal nCount As Long, ByRef lpObject As Any) As Long
Private Declare Function CreateDCAsNull Lib "gdi32" Alias "CreateDCA" (ByVal lpDevName As String, _
        lpDeviceName As Any, lpOutput As Any, lpInitData As Any) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, _
        ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, _
        ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, _
        ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Private Type BITMAP
  bmType As Long
  bmWidth As Long
  bmHeight As Long
  bmWidthBytes As Long
  bmPlanes As Long
  bmBitsPixel As Integer
  bmBits As Long
End Type

Private Function pBitmapHandleFromPicture(ByVal iPic As IPicture) As Long
  Dim hDCDesktop As Long, hBMP As Long
  Dim hDC1 As Long, hBmpOld1 As Long
  Dim hDC2 As Long, hBmpOld2 As Long
  Dim tBMP As BITMAP
   
  If iPic Is Nothing Then Exit Function
  GetObjectAPI iPic.Handle, Len(tBMP), tBMP
  hDCDesktop = CreateDCAsNull("DISPLAY", ByVal 0&, ByVal 0&, ByVal 0&)
  If hDCDesktop Then
    hDC1 = CreateCompatibleDC(hDCDesktop)
    If hDC1 Then
      hBmpOld1 = SelectObject(hDC1, iPic.Handle)
      hDC2 = CreateCompatibleDC(hDCDesktop)
      If hDC2 Then
        hBMP = CreateCompatibleBitmap(hDCDesktop, tBMP.bmWidth, tBMP.bmHeight)
        If hBMP Then
          hBmpOld2 = SelectObject(hDC2, hBMP)
          BitBlt hDC2, 0, 0, tBMP.bmWidth, tBMP.bmHeight, hDC1, 0, 0, vbSrcCopy
          SelectObject hDC2, hBmpOld2
          pBitmapHandleFromPicture = hBMP
        End If  ' hBMP
        DeleteDC hDC2
      End If  ' hDC2
      SelectObject hDC1, hBmpOld1
      DeleteDC hDC1
    End If  ' hDC1
    DeleteDC hDCDesktop
  End If  ' hDCDesktop
End Function

Kommen wir nun zum eigentlichen Funktionsaufruf lvwSetWatermark. Dieser Funktion übergeben wir das ListView-Handle, sowie ein beliebiges Bildobjekt. Das kann eine Picturebox, oder ein Bild aus einer ImgaeList sein. Wichtig ist, das ein evtl. bereits geladenes Hintergrundbild erst einmal gelöscht wird LVBKIF_SOURCE_NONE, sonst funktioniert es nicht! Zum Ende der Funktion setzten wir noch den Text mit LVM_SETTEXTBKCOLOR auf transparenten Hintergrund, damit er die Grafik nicht zerstückelt. Hier die dafür benötigten Constanten, Deklarationen und Typen:

' Constants:
Public Const LVM_FIRST As Long = &H1000&
Public Const LVM_SETTEXTBKCOLOR As Long = (LVM_FIRST + 38)
Public Const LVM_SETBKIMAGE As Long = (LVM_FIRST + 68)

' LVM_SET/GETBKIMAGE Flags
Private Const LVBKIF_SOURCE_NONE As Long = &H0
Private Const LVBKIF_SOURCE_HBITMAP As Long = &H1         ' >= WinXP, only visible in compiled mode
Private Const LVBKIF_SOURCE_URL As Long = &H2
Private Const LVBKIF_SOURCE_MASK As Long = &H3
Private Const LVBKIF_STYLE_NORMAL As Long = &H0
Private Const LVBKIF_STYLE_TILE As Long = &H10
Private Const LVBKIF_TYPE_WATERMARK As Long = &H10000000  ' >= WinXP, only visible in compiled mode

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

Private Type LVBKIMAGE
  ulFlags As Long                       ' LVBKIF_*
  hBM As Long                           ' bitmap handle
  pszImage As String                    ' file name
  cchImageMax As Long                   ' size of max file name
  xOffsetPercent As Long                ' x offset
  yOffsetPercent As Long                ' y offset
End Type
Private Const CLR_DEFAULT = &HFF000000  ' default background color
Private Const CLR_NONE = &HFFFFFFFF     ' no background color (transparent)


Public Sub lvwSetWatermark(ByVal lvHwnd As Long, ByVal iPic As IPicture)
  Dim bgi As LVBKIMAGE
  
  With bgi
    ' first clear up any background:
    .ulFlags = LVBKIF_SOURCE_NONE
    SendMessage lvHwnd, LVM_SETBKIMAGE, 0, bgi
    ' then set watermark image:
    .ulFlags = LVBKIF_TYPE_WATERMARK
    .hBM = pBitmapHandleFromPicture(iPic)
    SendMessage lvHwnd, LVM_SETBKIMAGE, 0, bgi
    SendMessageLong lvHwnd, LVM_SETTEXTBKCOLOR, 0&, -1&
  End With
End Sub

ACHTUNG: das Ganze funktioniert nur bei Verwendung der ListViews der Common Controls 5.0, Windows XP oder neuer und ist nur in compilierter EXE sichtbar! Ausserdem muß vor der Zuweisung des Wasserzeichens noch die Grafikpufferung durch den API-Aufruf LVS_EX_DOUBLEBUFFER aktiviert werden, was aus Platzgründen hier nicht angegeben ist! Der gesamte Quellcode ist im Demoprojekt zum Download enthalten...

   0007_LVWatermark.zip

Autor: ralf schlegel
Stand: 05/2011

Nach oben