Outlook ListView Sizing VII

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() As Single, wCol(), Tracking, cm As Long
 
Function PBMain() As Long
   Dialog New Pixels, 0, "Outlook Resizing",600,1100,420,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
         cm = 20
         OrigLVProc = SetWindowLong(hListView, %GWL_WndProc, CodePtr(NewLVProc))  'subclass
      Case %WM_User + 500
         ResizeColumnsLV(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,400,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(1 To 4), wCol(1 To 4)
   CD(1) = 0.15 : CD(2) = 0.60 : CD(3) = 0.15 : CD(4) = 0.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 DisplayStuff
   Local sResult As Single, i, wTotal, iResult As Long, temp$
   sResult = 0 : wTotal = 0
   For i = 1 To UBound(CD)
      sResult = sResult + CD(i)
      ListView Get Column hDlg, %IDC_ListView, i To iResult
      temp$ = temp$ + Str$(iResult)
      wTotal = wTotal + iResult
   Next i
   Dialog Set Text hDlg, Str$(sResult) + Str$(wTotal) + temp$
End Sub
 
Sub ResizeWindows
   Static wOld As Long
   Local i,w,h,wTotal,wNew As Long
   Local adj,pRem,cMin As Single
   Dialog Get Client hDlg To wNew,h
 
   If wNew > wOld Then 'getting bigger
      Control Set Size hDlg, %IDC_ListView, wNew-20, h-20
      Control Get Client hDlg, %IDC_ListView To w,h       'with no border, same as size
      w = w + 20 * IsTrue(GetWindowLong(hListView, %GWL_STYLE) And %WS_VScroll)  'account for vertical scrollbar
   Else  'getting smaller
      w = wNew - 20
   End If
 
   'adjust column width proportionate to %'s (use temporary wCol() values to avoid horizontal scrollbar)
   For i = 1 To UBound(CD) : wCol(i) = CD(i) * (w) : wTotal = wTotal + wCol(i) : Next i   'get total width
   'adjust rightmost column if total column width exceeds ListView client width
   If wTotal <> w Then wCol(UBound(CD)) = wCol(UBound(CD)) - (wTotal-w)   '<-- resize rightmost column width as needed
   'set column width
   For i = 1 To UBound(CD) : ListView Set Column hDlg, %IDC_ListView, i, wCol(i) : Next i
 
   'no column allowed to be less than cmin
   cMin = cm/w
   For i = 1 To UBound(CD)
      If CD(i) <= cMin Then
         CD(i) = cMin : adj = adj + cMin  'total of columns that are at cMin
      Else
         pRem = pRem + CD(i)  'total of columns that are not at cMin
      End If
   Next i
   For i = 1 To UBound(CD)
      If CD(i) > cMin Then CD(i) = CD(i)/pRem * (1 - adj)  'non-cMin columns adjusted proportionately to fill non-cMin space
   Next i
 
   If wNew <= wOld Then Control Set Size hDlg, %IDC_ListView, w, h-20
 
   Dialog Get Client hDlg To wOld,h
End Sub
 
Sub ResizeColumnsLV(ByVal iCol As Long)
   Local i,j,w,h,iResult,wCol,ww, wToLeft,wToRight,wTotal,flag As Long
   Local sResult, pToLeft, pToRightNew, pToRightOld, pRemToRight, adj, cMin As Single, temp$
 
   '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
   cMin = cm/w                                             'min column percentage w
   If wCol < cm Then wCol = cm                              'minimum column width
 
   'get total width of all columns, including newly resized iCol
   For i = 1 To iCol-1
      ListView Get Column hDlg, %IDC_ListView, i To iResult   'column width
      pToLeft  = pToLeft  + CD(i) : wToLeft  = wToLeft  + iResult
   Next i
 
   'if wCol is too big (either by double-click or by user re-sizing with mouse) lower wCol
   If (wToLeft + wCol) > (w - (UBound(CD)-iCol) * cm) Then
      wCol = w - wToLeft - (UBound(CD)-iCol)*cm
      For i = iCol+1 To UBound(CD) : CD(i) = cMin : Next i
      CD(iCol) = wCol / w
   Else
      CD(iCol) = wCol / w
      If iCol < UBound(CD) Then
         pToRightNew = 1 - pToLeft - CD(iCol)
         For i = iCol+1 To UBound(CD) : pToRightOld = pToRightOld + CD(i) : Next i
         For i = iCol+1 To UBound(CD) : CD(i) = CD(i)/pToRightOld * (1 - pToLeft - CD(iCol)) : Next i    'resize all
         For i = iCol+1 To UBound(CD)
            If CD(i) <= cMin Then
               CD(i) = cMin : adj = adj + cMin
            Else
               pRemToRight = pRemToRight + CD(i)
            End If
         Next i  'total of non-cMin
         For i = iCol+1 To UBound(CD)
            If CD(i) > cMin Then CD(i) = CD(i)/pRemToRight * (1 - pToLeft - CD(iCol) - adj )
         Next i          'resize non-cMin
      Else
         For i = 1 To iCol-1  : CD(i) = CD(i) /pToLeft * (1 - CD(iCol)) : Next i   'last column only
      End If
   End If
 
   Tracking = 0
End Sub
 
'gbs_01023
'Date: 03-10-2012


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