Results 1 to 4 of 4
  1. #1

    Thread Starter
    Registered User
    Join Date
    May 2018

    Unhappy Rectangle shapes Resize

    I am trying to resize the Rectangle Shape1 with the Below Function
    VB.Net Code:
    1. Public Class Resizer
    2.     '----------------------------------------------------------
    3.     ' ControlInfo
    4.     ' Structure of original state of all processed controls
    5.     '----------------------------------------------------------
    6.     Private Structure ControlInfo
    7.         Public name As String
    8.         Public parentName As String
    9.         Public leftOffsetPercent As Double
    10.         Public topOffsetPercent As Double
    11.         Public heightPercent As Double
    12.         Public originalHeight As Integer
    13.         Public originalWidth As Integer
    14.         Public widthPercent As Double
    15.         Public originalFontSize As Single
    16.     End Structure
    18.     '-------------------------------------------------------------------------
    19.     ' ctrlDict
    20.     ' Dictionary of (control name, control info) for all processed controls
    21.     '-------------------------------------------------------------------------
    22.     Private ctrlDict As Dictionary(Of String, ControlInfo) = New Dictionary(Of String, ControlInfo)
    24.     '----------------------------------------------------------------------------------------
    25.     ' FindAllControls
    26.     ' Recursive function to process all controls contained in the initially passed
    27.     ' control container and store it in the Control dictionary
    28.     '----------------------------------------------------------------------------------------
    29.     Public Sub FindAllControls(ByVal thisCtrl As Control)
    31.         '-- If the current control has a parent, store all original relative position
    32.         '-- and size information in the dictionary.
    33.         '-- Recursively call FindAllControls for each control contained in the
    34.         '-- current Control
    35.         For Each ctl As Control In thisCtrl.Controls
    36.             Try
    37.                 If Not IsNothing(ctl.Parent) Then
    38.                     Dim parentHeight = ctl.Parent.Height
    39.                     Dim parentWidth = ctl.Parent.Width
    41.                     Dim c As New ControlInfo
    42.                     c.name = ctl.Name
    43.                     c.parentName = ctl.Parent.Name
    44.                     c.topOffsetPercent = Convert.ToDouble(ctl.Top) / Convert.ToDouble(parentHeight)
    45.                     c.leftOffsetPercent = Convert.ToDouble(ctl.Left) / Convert.ToDouble(parentWidth)
    46.                     c.heightPercent = Convert.ToDouble(ctl.Height) / Convert.ToDouble(parentHeight)
    47.                     c.widthPercent = Convert.ToDouble(ctl.Width) / Convert.ToDouble(parentWidth)
    48.                     c.originalFontSize = ctl.Font.Size
    49.                     c.originalHeight = ctl.Height
    50.                     c.originalWidth = ctl.Width
    51.                     ctrlDict.Add(c.name, c)
    52.                 End If
    54.             Catch ex As Exception
    55.                 Debug.Print(ex.Message)
    56.             End Try
    58.             If ctl.Controls.Count > 0 Then
    59.                 FindAllControls(ctl)
    60.             End If
    62.         Next '-- For Each
    64.     End Sub
    66.     '----------------------------------------------------------------------------------------
    67.     ' ResizeAllControls
    68.     ' Recursive function to resize and reposition all controls contained in the Control
    69.     ' dictionary
    70.     '----------------------------------------------------------------------------------------
    71.     Public Sub ResizeAllControls(ByVal thisCtrl As Control)
    73.         Dim fontRatioW As Single
    74.         Dim fontRatioH As Single
    75.         Dim fontRatio As Single
    76.         Dim f As Font
    78.         '-- Resize and reposition all controls in the passed control
    79.         For Each ctl As Control In thisCtrl.Controls
    80.             Try
    81.                 If Not IsNothing(ctl.Parent) Then
    82.                     Dim parentHeight = ctl.Parent.Height
    83.                     Dim parentWidth = ctl.Parent.Width
    85.                     Dim c As New ControlInfo
    87.                     Dim ret As Boolean = False
    88.                     Try
    89.                         '-- Get the current control's info from the control info dictionary
    90.                         ret = ctrlDict.TryGetValue(ctl.Name, c)
    92.                         '-- If found, adjust the current control based on control relative
    93.                         '-- size and position information stored in the dictionary
    94.                         If (ret) Then
    95.                             ctl.SetBounds(Int(parentWidth * c.leftOffsetPercent), Int(parentHeight * c.topOffsetPercent),
    96.                                             Int(parentWidth * c.widthPercent), Int(parentHeight * c.heightPercent))
    98.                             f = ctl.Font
    99.                             fontRatioW = Int(parentWidth * c.widthPercent) / c.originalWidth
    100.                             fontRatioH = Int(parentHeight * c.heightPercent) / c.originalHeight
    102.                             fontRatio = (fontRatioW + fontRatioH) / 2 '-- average change in control Height and Width
    103.                             ctl.Font = New Font(f.FontFamily,
    104.                             c.originalFontSize * fontRatio, f.Style)
    106.                         End If
    107.                     Catch
    108.                     End Try
    109.                 End If
    110.             Catch ex As Exception
    111.             End Try
    113.             '-- Recursive call for controls contained in the current control
    114.             If ctl.Controls.Count > 0 Then
    115.                 ResizeAllControls(ctl)
    116.             End If
    118.         Next '-- For Each
    119.     End Sub
    121. End Class

    The issue is The other Componets like Textbox, Label and GroupBox is Resizing when maximized the Screen , but the RectangleShape is not working and it remains in the same size , kindly help me with this issue
    Last edited by si_the_geek; May 16th, 2018 at 06:41 AM. Reason: added Code tags

  2. #2
    Sinecure devotee
    Join Date
    Aug 2013
    Southern Tier NY

    Re: Rectangle shapes Resize

    I never use shape controls myself, as they aren't really controls anyway and were added to allow porting of old VB6 programs which used shape controls (which were not "real" controls there either, but fell in the class of "lightweight" controls, otherwise known as windowless controls).

    Since the shape controls are windowless, they have to be drawn in a container type object which provides a context for managing all the "shape controls" added to the form. Since I don't use them, I don't recall the details about how you might access that container and iterate through the shapes and make adjustments. I'm taking off for work so don't have time to research it, but if you do some more looking on shape controls and how they work you may find the information needed, or someone else may stop by who has worked with them on a lower level.

  3. #3
    Super Moderator Shaggy Hiker's Avatar
    Join Date
    Aug 2002

    Re: Rectangle shapes Resize

    I don't use shape controls either, but largely because they are painful for no real gain. Therefore, one option is to stop using Shape controls, because there are better ways to accomplish whatever you are using them for, but those won't be controls, either. I only see you dealing with controls, not with shapes. If a Shape doesn't derive from Control, that won't work, and I don't remember how the shapes work.

    I see you have an empty catch block. You really should get rid of that whole Try...Catch construct from the method. That code shouldn't throw exceptions, so if any exceptions are thrown, they are bugs that need to be fixed. By simply swallowing the exceptions, you'll never know whether the code works, and if it fails, you certainly won't have any idea why.
    My usual boring signature: Nothing

  4. #4
    Sinecure devotee
    Join Date
    Aug 2013
    Southern Tier NY

    Re: Rectangle shapes Resize

    I would start out simple.
    Put a single button on the form and a single rectangle shape on the form.
    In the button call your FindAllControls method and ResizeAllControls method.
    Put a breakpoint in the FindAllControls method and see what controls it finds.
    If all you have is the button and a rectangle shape on the form, it should find the button and a ShapeContainer.

    I assume with the given code the shape container is probably resized by your code since it is seen as a control, but then again it could be automatically resized to fill its parent, I don't know. That is something you would have to investigate.
    In any case, in your resize routine, you will no doubt need to add code specifically that when it sees a ShapeContainer it goes into its own local loop to iterate through the ShapeCollection of the Container to resize all the shapes. Again, you will need to research whether you can use your existing percentages and parentWidth settings, or since the controls are no doubt relative to the Container, you could probably use the percentages, but set the bounds relative to the ShapeContainer.

    Anyway, that is your fun to investigate, I haven't the time.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts


Click Here to Expand Forum to Full Width

We have made updates to our Privacy Policy to reflect the implementation of the General Data Protection Regulation.