Listview lvwList and fullrowselect?

[SuperDre]

Is there a way to get 'fullrowselect' when using View=lvwList, Now it only highlights the text itself, but not the whole cell. Another thing which also is annoying is that you actually have to select the text part and you cannot just click right beside it.

Using View = lvwReport does give you the needed look, but that one doesn't wrap the column to the right.. Yes I can add columns on the fly as needed (and therefore wrapping ever 'column' myself), but that means I will loose the icon on the preceding columns.

I want to recreate the 'newer' PrintDialog (you know, the dialog that popups when you for instance try to print in Notepad in Windows 7).

[Schmidt]

I want to recreate the 'newer' PrintDialog (you know, the dialog that popups when you for instance try to print in Notepad in Windows 7).

You mean a Control which puts out something like this here?:



Well - for simpler Controls like this, it is often faster to write one from scratch -
instead of fiddling for hours with API-Calls and SubClassing to force one of the
CommonControls into shape...

Here's the Control which produced the above Output (containing about 130 lines of code) -
no other Controls need to be placed on it - just paste the Code into a Project-Private-UC -
and name it ucStripes.ctl

Option Explicit

Public Event Click()
Public ColWidth As Long, Rows As Long, Cols As Long, VisCols As Long

Private Declare Function HideCaret& Lib "user32" (ByVal hWnd&)
Private Declare Function TextOutW& Lib "gdi32" (ByVal hDC&, ByVal x&, ByVal y&, ByVal lpString&, ByVal nCount&)
Private Declare Function ExtractIconExA& Lib "shell32" (ByVal FName$, ByVal IcoIdx&, hIcoLarge As Any, hIcoSmall As Any, ByVal nIcons&)
Private Declare Function DestroyIcon& Lib "user32" (ByVal hIcon&)
Private Declare Function DrawIconEx& Lib "user32" (ByVal hDC&, ByVal x&, ByVal y&, ByVal hIcon&, ByVal cx&, ByVal cy&, ByVal AniCurSteps&, ByVal FlickerFree&, ByVal Flags&)

Private dx&, dy&, mRowHeight As Long, mIconSpace As Long, mFocused As Boolean, mListIndex As Long
Private mItems As New Collection, mHIcos As New Collection, WithEvents HScr As HScrollBar

Private Sub UserControl_Initialize()
  AutoRedraw = True
  BackColor = vbWhite
  FillStyle = 0
  ScaleMode = vbPixels
  Font.Name = "Segoe UI"
  Font.Size = 9
  mRowHeight = 20
  mIconSpace = 30
  Set HScr = Controls.Add("VB.HScrollBar", "HScr")
      HScr.Visible = True
  mListIndex = -1
End Sub

Public Sub Clear()
  Cleanup
  mListIndex = -1: Refresh
End Sub

Public Sub AddItem(ItemText As String, Optional ByVal Shell32IcoIdx As Long)
Dim hIcoSmall As Long
  mItems.Add ItemText, "Key" & mItems.Count
  ExtractIconExA "shell32.dll", Shell32IcoIdx, ByVal 0&, hIcoSmall, 1
  mHIcos.Add hIcoSmall, "Key" & mHIcos.Count
End Sub

Public Property Get ListIndex() As Long
  ListIndex = mListIndex
End Property
Public Property Let ListIndex(ByVal NewValue As Long)
  If mListIndex = NewValue Or NewValue >= mItems.Count Then Exit Property
  mListIndex = NewValue
  Refresh
  RaiseEvent Click
End Property

Public Property Get ItemTextByIndex(ByVal IdxZerobased As Long) As String
  ItemTextByIndex = mItems("Key" & IdxZerobased)
End Property

Private Sub UserControl_EnterFocus()
  mFocused = True:  Refresh
End Sub
Private Sub UserControl_ExitFocus()
  mFocused = False: Refresh
End Sub

Private Sub UserControl_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
Dim Row: Row = y \ mRowHeight
Dim Col: Col = x \ ColWidth + HScr.Value
If Row >= 0 And Row < Rows And Col >= HScr.Value And Col < Cols Then ListIndex = Row * Cols + Col
End Sub

Private Sub UserControl_Resize()
  dx = ScaleWidth: dy = ScaleHeight - HScr.Height
  HScr.Move 0, IIf(dy > 0, dy, 1), dx, 17
  Refresh
End Sub

Private Sub HScr_Change()
  Refresh
End Sub
Private Sub HScr_Scroll()
  Refresh
End Sub
Private Sub HScr_GotFocus()
  HideCaret HScr.hWnd
End Sub

Private Sub Refresh()
Dim x As Long, y As Long, xOffs As Long, yOffs As Long, S As String, Key, BorderColor
  Cls
  ColWidth = GetColWidth
  Rows = dy \ mRowHeight
  If ColWidth = 0 Or Rows = 0 Then Exit Sub
  Cols = mItems.Count \ Rows + IIf(mItems.Count Mod Rows, 1, 0)

  VisCols = dx \ ColWidth + IIf(dx Mod ColWidth, 1, 0)
  If VisCols > mItems.Count Then VisCols = mItems.Count
  If Cols < VisCols - 1 Then Cols = VisCols - 1

  On Error Resume Next
    HScr.LargeChange = VisCols - IIf(ColWidth * VisCols < dx, 0, 1)
  On Error GoTo 0
  HScr.Max = Cols - HScr.LargeChange
  For y = 0 To Rows - 1
    For x = 0 To Cols - 1
      Key = "Key" & y * Cols + x
      If ItemExists(Key) And x >= HScr.Value And x < HScr.Value + VisCols Then
        S = mItems(Key)
        xOffs = (x - HScr.Value) * ColWidth
        yOffs = y * mRowHeight

        If mListIndex = y * Cols + x Then 'the select-rectangle
          FillColor = IIf(mFocused, &HFFEEDD, &HEEEEEE)
          BorderColor = IIf(mFocused, &HDDAA44, &HCCCCCC)
          Line (xOffs + 1, yOffs)-(xOffs + ColWidth - 2, yOffs + mRowHeight - 1), BorderColor, B
        End If
        TextOutW hDC, mIconSpace + xOffs - 6, yOffs + (mRowHeight - TextHeight(S)) / 2, StrPtr(S), Len(S)
        DrawIconEx hDC, xOffs + 5, yOffs + mRowHeight / 2 - 8, mHIcos(Key), 16, 16, 0, 0, 3 'DI_NORMAL
      End If
    Next x
  Next y
  UserControl.Refresh
End Sub

Private Function ItemExists(Key) As Boolean
On Error GoTo ErrExit
  mItems.Item Key
  ItemExists = True
ErrExit:
End Function

Private Function GetColWidth() As Long
Dim W As Long, MaxW As Long, Item
  For Each Item In mItems
    W = TextWidth(CStr(Item)): If W > MaxW Then MaxW = W
  Next
  GetColWidth = MaxW + mIconSpace + 12
End Function

Private Sub Cleanup()
Dim hIcon
  For Each hIcon In mHIcos: DestroyIcon hIcon: Next
  Set mItems = New Collection
  Set mHIcos = New Collection
End Sub

Private Sub UserControl_Terminate()
  Cleanup
End Sub

Code for a small TestForm (ucStripes1 and ucStripes2 needs to be placed on it)

Option Explicit
 
Private Sub Form_Load()
Dim i As Long
  For i = 1 To 20
    ucStripes1.AddItem "Some longer Item " & i, i
    ucStripes2.AddItem "Some longer Item " & i, i + 60
  Next i
End Sub

Private Sub Form_Resize()
  ucStripes1.Move 0.05 * ScaleWidth, 0.1 * ScaleHeight, ScaleWidth * 0.9, 0.3 * ScaleHeight
  ucStripes2.Move 0.05 * ScaleWidth, 0.5 * ScaleHeight, ScaleWidth * 0.9, 0.3 * ScaleHeight
End Sub

Private Sub ucStripes1_Click()
  Caption = "Click on: " & ucStripes1.ItemTextByIndex(ucStripes1.ListIndex)
End Sub

Olaf

[SuperDre]

We do already have some own usercontrols, and your control looks great, I'll have a look at it, thanx.. (hehe, if I could rate your post, I would have given it a high rating )