Outlook ListView Sizing II

Category: Controls - ListView

Date: 03-28-2012

Return to Index


 
'Compilable Example:
#Compiler PBWin 9, PBWin 10
#Compile EXE
#Dim All
#Include "Win32API.inc"
#Include "CommCtrl.inc"
 
%IDC_ListView     = 400
Global hDlg, hListView,hListViewH,hConsole As Dword, OrigLVProc, OrigLVHProc As Long
Global CD(), Tracking As Long
 
Function PBMain() As Long
   Dialog New Pixels, 0, "Outlook Style Resizing",300,300,400,150, %WS_OverlappedWindow To hDlg
   CreateListViewControl
   Dialog Show Modal hDlg Call DlgProc
End Function
 
CallBack Function DlgProc() As Long
   Local w,h,wCol As Long
   Select Case Cb.Msg
      Case %WM_InitDialog
         OrigLVProc = SetWindowLong(hListView, %GWL_WndProc, CodePtr(NewLVProc))  'subclass
      Case %WM_User + 500
         ResizeColumns(Cb.WParam)
         ResizeWindows
      Case %WM_Size
         ResizeWindows
      Case %WM_Destroy
         SetWindowLong hListView, %GWL_WNDPROC, OrigLVProc
   End Select
End Function
 
Sub CreateListViewControl
   Control Add ListView, hDlg, %IDC_ListView,"", 10,10,380,200
   Control Handle hDlg, %IDC_ListView To hListView
   ListView Insert Column hDlg, %IDC_ListView, 1, "Name", 100, 0
   ListView Insert Column hDlg, %IDC_ListView, 2, "Path", 100, 0
   ListView Insert Column hDlg, %IDC_ListView, 3, "Date", 100, 0
   ListView Insert Column hDlg, %IDC_ListView, 4, "Size", 100, 0
   ListView Insert Item hDlg, %IDC_ListView, 1,0, "First Row"
   ListView Set Text hDlg, %IDC_ListView, 1, 2, "Column two data which can be very long if you let it which we will in this case"
   ListView Set Text hDlg, %IDC_ListView, 1, 3, "Column three data which is long but not all that long."
   ListView Set Text hDlg, %IDC_ListView, 1, 4, "This is somewhat short"
   ReDim CD(4)
   CD(1) = 15 : CD(2) = 60 : CD(3) = 15 : CD(4) = 10
End Sub
 
Function NewLVProc(ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As LongAs Long
   Local hdnptr As HD_NOTIFY Ptr, hdiptr As HD_ITEM Ptr, w,iCol,wCol,iResult As Long
   Select Case Msg
      Case %WM_Notify
         hdnptr = lParam
         hdiptr = @hdnptr.pitem
         Select Case @hdnptr.hdr.code
            Case %hdn_DividerDblClickW
               Tracking = 2
               Dialog Post hDlg, %WM_User+500, @hdnptr.iItem + 1, 0
            Case %hdn_TrackW
               Tracking = 1
            Case %hdn_EndTrackW
               iResult = @hdnptr.iItem
               If Tracking Then Dialog Post hDlg, %WM_User+500, @hdnptr.iItem+1, 0
         End Select
   End Select
   Function = CallWindowProc(OrigLVProc, hWnd, MsgwParamlParam)
End Function
 
Sub ResizeWindows
   Local x,y,w,h As Long
   Dialog Get Client hDlg To w,h
   Control Set Size hDlg, %IDC_ListView, w-20, h-20
   Control Get Client hDlg, %IDC_ListView To w,h
   w = w + 20 * IsTrue(GetWindowLong(hListView, %GWL_STYLE) And %WS_VScroll)  'account for scrollbar
   For x = 1 To UBound(CD) : ListView Set Column hDlg, %IDC_ListView, x, CD(x) * w / 100 : Next x
End Sub
 
Sub ResizeColumns(ByVal iCol As Long)
   Local i,j,w,h,iResult,wCol,ww, pToLeft, pToRight,pTotalW, wToLeft, m, cMin As Long
 
   'get/set values needed to adjust column percentages
   Control Get Client hDlg, %IDC_ListView To w,h          'ListView client w,h
   ListView Get Column hDlg, %IDC_Listview, iCol To wCol  'width of column iCol
   m = 20             'min column width - pixels
   cMin = 100 * m/w   'min column width - percentage of w
 
   'set CD(iCol) - percentage of dragged or double-clicked column
   For i = 1 To iCol-1 : pToLeft  = pToLeft  + CD(i) : Next i  '% to left of iCol
   If Tracking = 2 And (pToLeft*w/100 + wCol + m*(UBound(CD)-iCol)) > w Then  'expanded width is wider than client area
      wCol = w * ( 100 - cMin*(UBound(CD)-iCol) - pToLeft ) /100    'shrink wCol to fit client area
      For i = iCol+1 To UBound(CD) : CD(i) = cMin : Next i  'set cols to right to specified small percentage
   End If
   For i = iCol+1 To UBound(CD) : pToRight = pToRight + CD(i) : Next i  '% to right of iCol
   CD(iCol) = 100 * wCol / w
 
   'adjust all other appropriate columns
   If iCol < UBound(CD) Then
      For i = iCol+1 To UBound(CD) : CD(i) = CD(i) / pToRight * (100 - pToLeft - CD(iCol)) : Next i  'all except last column
   Else
      For i = 1 To iCol-1  : CD(i) = CD(i) /pToLeft * (100 - CD(iCol)) : Next i   'last column only
   End If
 
   Tracking = 0
End Sub
 
   '    Cprint "..." + Str$(iCol) + Str$(wCol)
   '        cprint "looking for doubleclick > 100"
   '        cprint "< 100"
   'cprint "insub " + Str$(Tracking) + Str$(Wcol)
   'tracking = 0
   'Exit Sub
 
   '    Select Case iCol
   '        Case 0  'name
   '            ww = colPath + colDate + colSize
   '            colName =  100 * wCol / w
   '            colPath = colPath / ww * (100-colName)
   '            colDate = colDate / ww * (100-colName)
   '            colSize = colSize / ww * (100-colName)
   '        Case 1  'path
   '            ww = colDate + colSize
   '            colPath =  100 * wCol / w
   '            colDate = colDate / ww * (100-colName-colPath)
   '            colSize = colSize / ww * (100-colName-colPath)
   '        Case 2  'date
   '            ww = colSize
   '            colDate =  100 * wCol / w
   '            colSize = colSize / ww * (100-colName-colPath-colDate)
   '        Case 3  'size
   '            ww = colPath + colName + colDate
   '            colSize =  100 * wCol / w
   '            colName = colName / ww * (100-colSize)
   '            colPath = colPath / ww * (100-colSize)
   '            colDate = colDate / ww * (100-colSize)
   '        Case Else
   '    End Select
 
'gbs_01018
'Date: 03-10-2012


created by gbSnippets
http://www.garybeene.com/sw/gbsnippets.htm