Динамическое создание формы и управляющих элементов
Материал из GedeminWiki
(Различия между версиями)
SYSDBA (обсуждение | вклад) (Создана новая страница размером <source lang="vb"> Option Explicit Function gsIncFileSize_CreateControl(ByRef Dlg, ClassName, CompName, _ Left, Top, Width, Height) ...) |
SYSDBA (обсуждение | вклад) |
||
| (не показаны 4 промежуточные версии 1 участника) | |||
| Строка 1: | Строка 1: | ||
| + | Формы и управляющие элементы могут создаваться динамически, непосредственно из скрипта. Ниже приведен исходный код процедуры '''gsIncFileSize''' и вспомогательной функции '''gsIncFileSize_CreateControl'''. | ||
| − | <source lang=" | + | При вызове '''gsIncFileSize''' на экране отобразится диалоговое окно для ввода имени файла и нового размера. По нажатию на кнопку '''Ок''', если задано имя существующего файла и его размер меньше указанного числа, то в конец файла будут дописаны произвольные данные. |
| + | |||
| + | ==== Исходный код ==== | ||
| + | |||
| + | <source lang="vbnet"> | ||
Option Explicit | Option Explicit | ||
| Строка 30: | Строка 35: | ||
Set DlgWindow = Designer.CreateObject(Application, "TForm", "dlgAskFileSize") | Set DlgWindow = Designer.CreateObject(Application, "TForm", "dlgAskFileSize") | ||
| − | DlgWindow.Caption = " | + | DlgWindow.Caption = "Увеличение размера файла" |
DlgWindow.BorderStyle = bsDialog | DlgWindow.BorderStyle = bsDialog | ||
DlgWindow.Position = poScreenCenter | DlgWindow.Position = poScreenCenter | ||
| Строка 38: | Строка 43: | ||
Set lblFileName = gsIncFileSize_CreateControl(DlgWindow, "TLabel", "lblFileName", _ | Set lblFileName = gsIncFileSize_CreateControl(DlgWindow, "TLabel", "lblFileName", _ | ||
8, 8, 200, 0) | 8, 8, 200, 0) | ||
| − | lblFileName.Caption = " | + | lblFileName.Caption = "Укажите имя файла:" |
Set edFileName = gsIncFileSize_CreateControl(DlgWindow, "TEdit", "edFileName", _ | Set edFileName = gsIncFileSize_CreateControl(DlgWindow, "TEdit", "edFileName", _ | ||
| Строка 46: | Строка 51: | ||
Set lblNewSize = gsIncFileSize_CreateControl(DlgWindow, "TLabel", "lblNewSize", _ | Set lblNewSize = gsIncFileSize_CreateControl(DlgWindow, "TLabel", "lblNewSize", _ | ||
8, 54, 200, 0) | 8, 54, 200, 0) | ||
| − | lblNewSize.Caption = " | + | lblNewSize.Caption = "Укажите новый размер в байтах:" |
Set edNewSize = gsIncFileSize_CreateControl(DlgWindow, "TEdit", "edNewSize", _ | Set edNewSize = gsIncFileSize_CreateControl(DlgWindow, "TEdit", "edNewSize", _ | ||
| Строка 66: | Строка 71: | ||
If (DlgWindow.ShowModal = mrOk) And (Trim(edFileName.Text) > "") Then | If (DlgWindow.ShowModal = mrOk) And (Trim(edFileName.Text) > "") Then | ||
If Not IsNumeric(Trim(edNewSize.Text)) Then | If Not IsNumeric(Trim(edNewSize.Text)) Then | ||
| − | Application.MessageBox " | + | Application.MessageBox "Размер файла должен быть целочисленным значением большим нуля!", "Ошибка", 0 |
Else | Else | ||
Dim FileName, NewSize, FStream | Dim FileName, NewSize, FStream | ||
| Строка 77: | Строка 82: | ||
If Err.Number <> 0 Then | If Err.Number <> 0 Then | ||
| − | Application.MessageBox " | + | Application.MessageBox "Ошибка при открытии файла: " & Err.Description, "Ошибка", 0 |
On Error GoTo 0 | On Error GoTo 0 | ||
Else | Else | ||
| Строка 89: | Строка 94: | ||
If Err.Number <> 0 Then | If Err.Number <> 0 Then | ||
| − | Application.MessageBox Err.Description, " | + | Application.MessageBox Err.Description, "Ошибка", 0 |
End If | End If | ||
On Error GoTo 0 | On Error GoTo 0 | ||
| Строка 97: | Строка 102: | ||
End Sub | End Sub | ||
</source> | </source> | ||
| + | |||
| + | [[Category:Учебный курс]] | ||
Текущая версия на 17:44, 16 июля 2009
Формы и управляющие элементы могут создаваться динамически, непосредственно из скрипта. Ниже приведен исходный код процедуры 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