From 9354576bc4696fc1ebfa2394468a4a40aa114df1 Mon Sep 17 00:00:00 2001 From: joyfullservice Date: Tue, 16 May 2023 13:18:55 -0500 Subject: [PATCH] Dynamically scale columns on resize Now that the conflict resolution form is now resizable, we can automatically scale the column widths to proportionately increase or decrease based on the size of the form. This way you can make the form wider to see more of the file names. Additionally, you can specify the names of some controls that you don't want to size because expanding them provides no value to the user since all the content is already displayed. --- .../forms/frmVCSConflict.bas | 20 ++++- .../forms/frmVCSConflictList.bas | 14 +-- .../modules/modFunctions.bas | 87 +++++++++++++++++++ .../modules/modUnitTesting.bas | 15 ++++ 4 files changed, 128 insertions(+), 8 deletions(-) diff --git a/Version Control.accda.src/forms/frmVCSConflict.bas b/Version Control.accda.src/forms/frmVCSConflict.bas index 9f554fd4..3124bffc 100644 --- a/Version Control.accda.src/forms/frmVCSConflict.bas +++ b/Version Control.accda.src/forms/frmVCSConflict.bas @@ -19,13 +19,14 @@ Begin Form ItemSuffix =47 Left =20761 Top =2250 - Right =31261 + Right =-29055 Bottom =13995 RecSrcDt = Begin 0x79e78b777268e540 End Caption ="MSAccessVCS" DatasheetFontName ="Calibri" + OnResize ="[Event Procedure]" OnLoad ="[Event Procedure]" AllowDatasheetView =0 FilterOnLoad =0 @@ -830,6 +831,7 @@ Attribute VB_Exposed = False Option Compare Database Option Explicit + '--------------------------------------------------------------------------------------- ' Procedure : cmdCancel_Click ' Author : Adam Waller @@ -899,6 +901,22 @@ Private Sub Form_Load() ' Change to resizable form MakeDialogResizable Me + ' Set initial column size + Form_Resize + +End Sub + + +'--------------------------------------------------------------------------------------- +' Procedure : Form_Resize +' Author : Adam Waller +' Date : 5/16/2023 +' Purpose : Adjust column widths on subform. +'--------------------------------------------------------------------------------------- +' +Private Sub Form_Resize() + ScaleColumns Me.sfrmConflictList.Form, , _ + Array("txtObjectDate", "txtFileDate", "txtDiff") End Sub diff --git a/Version Control.accda.src/forms/frmVCSConflictList.bas b/Version Control.accda.src/forms/frmVCSConflictList.bas index 30e45f57..eade4595 100644 --- a/Version Control.accda.src/forms/frmVCSConflictList.bas +++ b/Version Control.accda.src/forms/frmVCSConflictList.bas @@ -16,10 +16,10 @@ Begin Form Width =5040 DatasheetFontHeight =11 ItemSuffix =31 - Left =885 - Top =3030 - Right =12495 - Bottom =7860 + Left =435 + Top =2250 + Right =12315 + Bottom =7335 RecSrcDt = Begin 0x9bf1b7f2f3a6e540 End @@ -108,7 +108,7 @@ Begin Form Top =360 Width =2625 Height =360 - ColumnWidth =1710 + ColumnWidth =1729 LeftMargin =44 TopMargin =22 RightMargin =44 @@ -160,7 +160,7 @@ Begin Form Top =900 Width =2625 Height =360 - ColumnWidth =2595 + ColumnWidth =2617 TabIndex =1 LeftMargin =44 TopMargin =22 @@ -396,7 +396,7 @@ Begin Form Top =2520 Width =2625 Height =360 - ColumnWidth =1305 + ColumnWidth =1310 TabIndex =4 Name ="cboResolution" ControlSource ="Resolution" diff --git a/Version Control.accda.src/modules/modFunctions.bas b/Version Control.accda.src/modules/modFunctions.bas index 57d486fd..f9376d4f 100644 --- a/Version Control.accda.src/modules/modFunctions.bas +++ b/Version Control.accda.src/modules/modFunctions.bas @@ -688,6 +688,43 @@ Public Function Nz2(varValue, Optional varIfNull) As Variant End Function +'--------------------------------------------------------------------------------------- +' Procedure : InArray +' Author : Adam Waller +' Date : 5/16/2023 +' Purpose : Returns true if the matching value is found in the array. +'--------------------------------------------------------------------------------------- +' +Public Function InArray(varArray, varValue, Optional intCompare As VbCompareMethod = vbBinaryCompare) As Boolean + + Dim varItem As Variant + Dim lngCnt As Long + + ' Guard clauses + If Not IsArray(varArray) Then Exit Function + If IsEmptyArray(varArray) Then Exit Function + + ' Loop through array items, looking for a match + For lngCnt = LBound(varArray) To UBound(varArray) + If TypeName(varValue) = "String" Then + ' Use specified compare method + If StrComp(varArray(lngCnt), varValue, intCompare) = 0 Then + InArray = True + Exit For + End If + Else + ' Compare non-string value + If varValue = varArray(lngCnt) Then + ' Found exact match + InArray = True + Exit For + End If + End If + Next lngCnt + +End Function + + '--------------------------------------------------------------------------------------- ' Procedure : AddToArray ' Author : Adam Waller @@ -890,3 +927,53 @@ Public Sub MakeDialogResizable(frmMe As Form) End Sub + +'--------------------------------------------------------------------------------------- +' Procedure : ScaleColumns +' Author : Adam Waller +' Date : 5/16/2023 +' Purpose : Size the datasheet columns evenly to fill the available width, minus an +' : allotment for the width of the vertical scroll bar. +'--------------------------------------------------------------------------------------- +' +Public Sub ScaleColumns(frmDatasheet As Form, Optional lngScrollWidthTwips As Long = 600, _ + Optional varFixedControlNameArray As Variant) + + Dim lngTotal As Long + Dim lngCurrent As Long + Dim lngSizeable As Long + Dim lngFixed As Long + Dim dblRatio As Double + Dim ctl As Control + Dim colResize As Collection + + lngTotal = frmDatasheet.InsideWidth - lngScrollWidthTwips + Set colResize = New Collection + + ' Loop through the columns twice, once to get the current widths, then to set them. + For Each ctl In frmDatasheet.Controls + Select Case ctl.ControlType + Case acTextBox, acComboBox + If ctl.Visible Then + lngCurrent = lngCurrent + ctl.ColumnWidth + If Not InArray(varFixedControlNameArray, ctl.Name, vbTextCompare) Then + lngSizeable = lngSizeable + ctl.ColumnWidth + colResize.Add ctl + End If + End If + End Select + Next ctl + + ' Exit if we have no sizable controls + If lngSizeable = 0 Then Exit Sub + + ' Get ratio for new sizes (Scales resizable controls proportionately) + lngFixed = lngCurrent - lngSizeable + dblRatio = (lngTotal - lngFixed) / lngSizeable + + ' Resize each control + For Each ctl In colResize + ctl.ColumnWidth = ctl.ColumnWidth * dblRatio + Next ctl + +End Sub diff --git a/Version Control.accda.src/modules/modUnitTesting.bas b/Version Control.accda.src/modules/modUnitTesting.bas index 26b7b471..0d568825 100644 --- a/Version Control.accda.src/modules/modUnitTesting.bas +++ b/Version Control.accda.src/modules/modUnitTesting.bas @@ -352,3 +352,18 @@ Public Sub TestGitRepositoryRoot() End With End Sub + + +'@TestMethod("InArray") +Public Sub TestInArray() + Dim varArray As Variant + varArray = Array("a", "b", "c", 1, 2, 3, #1/1/2000#) + Debug.Assert InArray(varArray, "b") + Debug.Assert Not InArray(varArray, "B") + Debug.Assert InArray(varArray, "B", vbTextCompare) + Debug.Assert InArray(varArray, 2) + Debug.Assert InArray(varArray, #1/1/2000#) + Debug.Assert Not InArray(varArray, Null) + Debug.Assert Not InArray(Null, "b") + Debug.Assert Not InArray(Array(), "b") +End Sub