Динамическое создание формы и управляющих элементов
Материал из GedeminWiki
(Различия между версиями)
SYSDBA (обсуждение | вклад) (Создана новая страница размером <source lang="vb"> Option Explicit Function gsIncFileSize_CreateControl(ByRef Dlg, ClassName, CompName, _ Left, Top, Width, Height) ...) |
SYSDBA (обсуждение | вклад) |
||
| Строка 1: | Строка 1: | ||
| − | |||
<source lang="vb"> | <source lang="vb"> | ||
Option Explicit | Option Explicit | ||
| Строка 30: | Строка 29: | ||
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: | Строка 37: | ||
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: | Строка 45: | ||
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: | Строка 65: | ||
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: | Строка 76: | ||
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: | Строка 88: | ||
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 | ||
| Строка 95: | Строка 94: | ||
Designer.DestroyObject(DlgWindow) | Designer.DestroyObject(DlgWindow) | ||
| − | End Sub | + | End Sub</source> |
| − | </source> | + | |
Версия 17:35, 16 июля 2009
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