Date: 02-16-2022
Return to Index
created by gbSnippets
'Compilable Example: (Jose Includes)
#Compiler PBWin 9, PBWin 10
#Compile EXE
#Dim All
%Unicode=1
#Include "Win32API.inc"
#Include "CommCtrl.inc"
%IDC_ListView = 400
Global hDlg, hListView,hListViewH,hConsole As Dword, OrigLVProc, OrigLVHProc As Long
Global CD() As Single, 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(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 Long) As 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, Msg, wParam, lParam)
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
Local x,y,w,h,wTotal,iResult 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 : Next x
Local adj,pRem,cMin As Single, i As Long
cMin = cm/w
For i = 1 To UBound(CD)
If CD(i) <= cMin Then
CD(i) = cMin : adj = adj + cMin
Else
pRem = pRem + CD(i)
End If
Next i 'total of non-cMin
For i = 1 To UBound(CD)
If CD(i) > cMin Then CD(i) = CD(i)/pRem * (1 - adj)
Next i 'resize non-cMin
DisplayStuff
End Sub
Function GetW() As Long
Local i,iResult,wTotal As Long
For i = 1 To UBound(CD)
ListView Get Column hDlg, %IDC_ListView, i To iResult
wTotal = wTotal + iResult
Next i
Function = wTotal
End Function
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$
'ListView Set Column hDlg, %IDC_ListView, 1, 300
'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
'? "cMin " + Format$(cMin,"00.0000") + " pToLeft " + Str$(pToLeft) + " pToRight Old " + Str$(pToRightOld) + $CrLf + "CD() values: " + Format$(CD(1)," 0.0000 ") + Format$(CD(2)," 0.0000 ") + Format$(CD(3)," 0.0000 ") + Format$(CD(4)," 0.0000 ")
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_01022
'Date: 03-10-2012
http://www.garybeene.com/sw/gbsnippets.htm