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

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

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

==== Исходный код ====

<source lang="vbnet">
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
</source>

[[Category:Учебный курс]]