Динамическое создание формы и управляющих элементов

Формы и управляющие элементы могут создаваться динамически, непосредственно из скрипта. Ниже приведен исходный код процедуры gsIncFileSize и вспомогательной функции gsIncFileSize_CreateControl.

При вызове gsIncFileSize на экране отобразится диалоговое окно для ввода имени файла и нового размера. По нажатию на кнопку Ок, если задано имя существующего файла и его размер меньше указанного числа, то в конец файла будут дописаны произвольные данные.

Исходный код

Option Explicit
 
Function gsIncFileSize_CreateControl(ByRef Dlg, ClassName, CompName, _
  Left, Top, Width, Height)
 
  Dim C
  Set C = Designer.CreateObject(Dlg, ClassName, CompName)
  C.Parent = Dlg
  C.Left = Left
  C.Top = Top
  If Width > 0 Then C.Width = Width
  If Height > 0 Then C.Height = Height
 
  Set gsIncFileSize_CreateControl = C
 
End Function
 
Sub gsIncFileSize
 
  Const bsDialog        = 3
  Const poScreenCenter  = 4
  Const mrOk            = 1
  Const mrCancel        = 2
  Const fmOpenReadWrite = 2
  Const soFromEnd       = 2
 
  Dim DlgWindow, lblFileName, edFileName, lblNewSize, edNewSize, btnOk, btnCancel
 
  Set DlgWindow = Designer.CreateObject(Application, "TForm", "dlgAskFileSize")
  DlgWindow.Caption     = "Увеличение размера файла"
  DlgWindow.BorderStyle = bsDialog
  DlgWindow.Position    = poScreenCenter
  DlgWindow.Width       = 280
  DlgWindow.Height      = 132
 
  Set lblFileName = gsIncFileSize_CreateControl(DlgWindow, "TLabel", "lblFileName", _
    8, 8, 200, 0)
  lblFileName.Caption = "Укажите имя файла:"
 
  Set edFileName = gsIncFileSize_CreateControl(DlgWindow, "TEdit", "edFileName", _
    8, 24, 260, 0)
  edFileName.Text = ""
 
  Set lblNewSize = gsIncFileSize_CreateControl(DlgWindow, "TLabel", "lblNewSize", _
    8, 54, 200, 0)
  lblNewSize.Caption = "Укажите новый размер в байтах:"
 
  Set edNewSize = gsIncFileSize_CreateControl(DlgWindow, "TEdit", "edNewSize", _
    188, 50, 80, 0)
  edNewSize.Text = "0"
 
  Set btnOk = gsIncFileSize_CreateControl(DlgWindow, "TButton", "btnOk", _
    108, 78, 76, 21)
  btnOk.Caption     = "Ok"
  btnOk.ModalResult = mrOk
  btnOk.Default     = True
 
  Set btnCancel = gsIncFileSize_CreateControl(DlgWindow, "TButton", "btnCancel", _
    192, 78, 76, 21)
  btnCancel.Caption = "Cancel"
  btnCancel.ModalResult = mrCancel
  btnCancel.Cancel  = True
 
  If (DlgWindow.ShowModal = mrOk) And (Trim(edFileName.Text) > "") Then
    If Not IsNumeric(Trim(edNewSize.Text)) Then
      Application.MessageBox "Размер файла должен быть целочисленным значением большим нуля!", "Ошибка", 0
    Else
      Dim FileName, NewSize, FStream
 
      FileName = Trim(edFileName.Text)
      NewSize  = CLng(Trim(edNewSize.Text))
 
      On Error Resume Next
      Set FStream = Designer.CreateObject(Array(FileName, fmOpenReadWrite), "TFileStream", "")
 
      If Err.Number <> 0 Then
        Application.MessageBox "Ошибка при открытии файла: " & Err.Description, "Ошибка", 0
        On Error GoTo 0
      Else
        FStream.Seek 0, soFromEnd
        While FStream.Size < NewSize
          FStream.WriteStr Chr(Int((255 - 32 + 1) * Rnd + 32)), 1
        WEnd
        Designer.DestroyObject(FStream)
      End If
    End If
 
    If Err.Number <> 0 Then
      Application.MessageBox Err.Description, "Ошибка", 0
    End If
    On Error GoTo 0
  End If
 
  Designer.DestroyObject(DlgWindow)
End Sub