Programming Tool Box/SIMS_2.iso/code/system/bug_de/buggy.frm

Visual Basic Form | 1995-01-10 | 11.4 KB | 267 lines

VERSION 2.00
Begin Form frmBuggy
   Caption         =   "Buggy Form"
   ClientHeight    =   4392
   ClientLeft      =   864
   ClientTop       =   1536
   ClientWidth     =   6060
   Height          =   4812
   Left            =   816
   LinkTopic       =   "Form1"
   ScaleHeight     =   4392
   ScaleWidth      =   6060
   Top             =   1164
   Width           =   6156
   Begin ListBox lstChanges
      Height          =   1368
      Left            =   1800
      TabIndex        =   6
      Top             =   2820
      Width           =   2892
   End
   Begin Frame Frame1
      Caption         =   "Memory and Resources"
      Height          =   1272
      Left            =   600
      TabIndex        =   3
      Top             =   1080
      Width           =   5172
      Begin Label lblResources
         Caption         =   "lblResources"
         Height          =   372
         Left            =   240
         TabIndex        =   0
         Top             =   780
         Width           =   4812
      End
      Begin Label lblMemory
         Caption         =   "lblMemory"
         Height          =   312
         Left            =   240
         TabIndex        =   1
         Top             =   360
         Width           =   4812
      End
   End
   Begin Label Label2
      Caption         =   "Memory changes in Form_Resize:"
      Height          =   252
      Left            =   1800
      TabIndex        =   5
      Top             =   2520
      Width           =   3012
   End
   Begin Label Label1
      Alignment       =   2  'Center
      BorderStyle     =   1  'Fixed Single
      Caption         =   "Resize me and watch the memory go!"
      Height          =   372
      Left            =   840
      TabIndex        =   4
      Top             =   120
      Width           =   4320
   End
   Begin Label lblMode
      Alignment       =   2  'Center
      BorderStyle     =   1  'Fixed Single
      Caption         =   "lblMode"
      Height          =   252
      Left            =   600
      TabIndex        =   2
      Top             =   600
      Width           =   5052
   End
' Buggy.frm
' Purpose:
' Sample program to demonstrate a memory leak when we
' use Controls(i).Parent.ScaleHeight to get the form/frame size
' in order to proportionally move controls on a form.
' If you keep resizing it, you'll get an "out of memory" error.
' Date:         Author:
' 01/10/94      Elliott Whitticar ([e-mail])
Option Explicit
'=============================================
' Module Level Variable Declaration Section
'=============================================
Dim CtlDelta() As SizeStruct    ' Stores size and location of controls
Dim mlFreeSpace As Long         ' Free memory at end of loop in Form_Resize
Dim mlOldSpace As Long          ' Free memory at start of loop in Form_Resize
Sub Form_Load ()
' Description:
'   This code to get the relative position of all the controls
'   on the form is from the "Elastic Controls Resize Proportionally"
'   article by Bill Wilkey in the August/September issue of
'   "Visual Basic Programmer's Journal."
    Dim i As Integer                ' For-variable
    'NOTE: For Screen, Form, and Printer objects the Width
    'And Height properties are always measured in TWIPS.
    'For the (non-MDI) Form and Printer objects the internal
    'client area coordinate system can be changed to other
    'scalings. For simplicity you may want to leave the
    'coordinate system set to the VB default of TWIPS.
    'However, some API routines require Pixels so you'll need
    'to do conversion.
    ' Begin UI Initialization
    ' Perform any desired startup sizing of the
    ' form here, before processing coordinates.
    WindowState = NORMAL
    ' Set desired scale mode here. Use the SCALEMODE property
    ' for pre-defined scalings, use the
    ' SCALETop,Left,Width,Height properties directly or the
    ' SCALE method to define a custom coordinate system.
    ' ScaleMode = TWIPS
    ' Size the control dimension proportion array
    ReDim CtlDelta(0 To Controls.Count - 1)
    ' Loop through each control on the form and capture its
    ' dimensions as a percentage of the scalable dimensions of
    ' the form. (won't work for the line control)
    For i = 0 To Controls.Count - 1
        If TypeOf Controls(i) Is Line Then
            CtlDelta(i).Top = Controls(i).Y1 / Controls(i).Parent.ScaleHeight
            CtlDelta(i).Left = Controls(i).X1 / Controls(i).Parent.ScaleWidth
            CtlDelta(i).Width = Controls(i).X2 / Controls(i).Parent.ScaleWidth
            CtlDelta(i).Height = Controls(i).Y2 / Controls(i).Parent.ScaleHeight
        Else
            CtlDelta(i).Top = Controls(i).Top / Controls(i).Parent.ScaleHeight
            CtlDelta(i).Left = Controls(i).Left / Controls(i).Parent.ScaleWidth
            CtlDelta(i).Width = Controls(i).Width / Controls(i).Parent.ScaleWidth
            CtlDelta(i).Height = Controls(i).Height / Controls(i).Parent.ScaleHeight
        End If
    Next
End Sub
Sub Form_Resize ()
'Description:   Proportionally resize and move controls based on
'               relative positions in CtlDelta() array.
'Arguments:     N/A
'Return:        N/A
'-----------------------------------------------------------------
'Date        Developer           Comments
'01/10/95    E. Whitticar        Initial creation
'*****************************************************************
    '=============================================
    'Local Constant/Variable Declaration Section
    '=============================================
    Dim i As Integer                ' For-variable
    Dim lfParHeight As Single       ' ScaleHeight of parent control
    Dim lfParWidth As Single        ' ScaleWidth of parent control
    Dim lfLeft As Single            ' Left coordinate
    Dim lfTop As Single             ' Top coordinate
    Dim lfWidth As Single           ' Width
    Dim lfHeight As Single          ' Height
    ' Don't bother if we're just an icon
    If WindowState = MINIMIZED Then Exit Sub
    ' This will go faster if the form is not visible
    Me.Hide
    ' Save the amount of free memory before
    ' using Controls(i).Parent.ScaleWidth
    mlOldSpace = GetFreeSpace(0)       ' Original Free Memory
    ' Loop through each control on the form and reset the dimensions
    ' as a percentage of the scalable dimensions of the form.
    For i = 0 To Controls.Count - 1
        ' Get ScaleHeight and ScaleWidth of parent control or form
        lfParHeight = Controls(i).Parent.ScaleHeight
        lfParWidth = Controls(i).Parent.ScaleWidth
        If TypeOf Controls(i) Is Line Then
            Controls(i).Y1 = lfParHeight * CtlDelta(i).Top
            Controls(i).X1 = lfParWidth * CtlDelta(i).Left
            Controls(i).X2 = lfParWidth * CtlDelta(i).Width
            Controls(i).Y2 = lfParHeight * CtlDelta(i).Height

        ElseIf TypeOf Controls(i) Is Menu Then
            ' Skip it
        ElseIf TypeOf Controls(i) Is Timer Then
            ' Skip it
        Else
            ' Get all the size and postion properties
            lfTop = lfParHeight * CtlDelta(i).Top
            lfLeft = lfParWidth * CtlDelta(i).Left
            lfWidth = lfParWidth * CtlDelta(i).Width
            lfHeight = lfParHeight * CtlDelta(i).Height

            If TypeOf Controls(i) Is TextBox Then
                ' Set all but the height, unless it's multiline
                If Controls(i).MultiLine = True Then
                    Controls(i).Move lfLeft, lfTop, lfWidth, lfHeight
                Else
                    Controls(i).Move lfLeft, lfTop, lfWidth
                End If

            ElseIf TypeOf Controls(i) Is Label Then
                ' Set only the position, don't change dimensions
                Controls(i).Move lfLeft, lfTop

            ElseIf TypeOf Controls(i) Is CommandButton Then
                ' Set only the position, don't change dimensions
                Controls(i).Move lfLeft, lfTop

            ElseIf TypeOf Controls(i) Is ComboBox Then
                ' Set all but the height, unless it's style 1
                If Controls(i).Style = 1 Then
                    Controls(i).Move lfLeft, lfTop, lfWidth, lfHeight
                Else
                    Controls(i).Move lfLeft, lfTop, lfWidth
                End If

            ElseIf TypeOf Controls(i) Is HScrollBar Then
                ' Set all but the height
                Controls(i).Move lfLeft, lfTop, lfWidth
            ElseIf TypeOf Controls(i) Is VScrollBar Then
                ' Set all but the width
                Controls(i).Move lfLeft, lfTop
                Controls(i).Height = lfParHeight * CtlDelta(i).Height
' **********
' Put special code for any controls you're using here.
            ' ElseIf TypeOf Controls(i) Is SSPanel Then
            '     ' If it doesn't automatically align to the top or bottom, move it.
            '     If Controls(i).Align = 0 Then
            '         Controls(i).Move lfLeft, lfTop, lfWidth, lfHeight
            '     Else
            '         ' Skip it -- it aligns itself automatically
            '     End If
            ' ElseIf TypeOf Controls(i) Is MhDateInput Then
            '     ' Set all but the height
            '     Controls(i).Move lfLeft, lfTop, lfWidth
            ' ElseIf TypeOf Controls(i) Is MaskEdBox Then
            '     ' Set all but the height
            '     Controls(i).Move lfLeft, lfTop, lfWidth
' **********
            Else
                ' For any other control, move it.
                Controls(i).Move lfLeft, lfTop, lfWidth, lfHeight
            End If
        End If
    Next
    mlFreeSpace = GetFreeSpace(0)       ' Free Memory
    ' Perform any desired custom sizing/updates
    ' of the controls here.
    ' Restore visibility to the form
    Me.Show
    ShowResources
End Sub
Sub ShowResources ()
' Description:  Displays mode, memory and resources
    ' Local variables
    Dim llWinFlags As Long      ' Returned from GetWinFlags()
    Dim llVerNum As Long        ' Returned from GetVersion(): DOS and Windows Version Nos.
    Dim lsVersion As String     ' Windows version string
    Dim lsFreeSpace As String   ' KB of free memory (formatted)
    Dim lwVerWord As Integer    ' Low word of version
    ' Set the label captions to indicate the windows mode and free memory
    llVerNum = GetVersion()
    lwVerWord = CInt(llVerNum And &HFFFF&)
    lsVersion = "Windows " & CStr(lwVerWord And &HFF) & "." & CStr(lwVerWord \ 256)
    llWinFlags = GetWinFlags()
    If llWinFlags And WF_ENHANCED Then
        lblMode.Caption = lsVersion & ", 386-enhanced mode"
    ElseIf llWinFlags And WF_PMODE Then
        lblMode.Caption = lsVersion & ", protected mode"
    Else
        lblMode.Caption = lsVersion & ", standard mode"
    End If
    lsFreeSpace = Format$(mlFreeSpace, "###,###,###")
    lblMemory.Caption = "Free Memory:       " & lsFreeSpace & " Bytes"
    lblResources.Caption = "Free Resources:  " & GetFreeSystemResources(GFSR_SYSTEMRESOURCES) & "% (system); " & GetFreeSystemResources(GFSR_GDIRESOURCES) & "% (GDI); " & GetFreeSystemResources(GFSR_USERRESOURCES) & "% (user)"
    lstChanges.AddItem CStr(mlFreeSpace - mlOldSpace)
    lstChanges.ListIndex = lstChanges.ListCount - 1
End Sub