-
Aug 26th, 2014, 05:15 AM
#1
Thread Starter
Addicted Member
Listview lvwList and fullrowselect?
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).
-
Aug 26th, 2014, 06:04 PM
#2
Re: Listview lvwList and fullrowselect?
Originally Posted by SuperDre
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
Code:
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)
Code:
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
Last edited by Schmidt; Aug 27th, 2014 at 04:01 AM.
Reason: Changed w for MaxW in the last line of GetColWidth()
-
Aug 27th, 2014, 02:47 AM
#3
Thread Starter
Addicted Member
Re: Listview lvwList and fullrowselect?
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 )
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|