Необходимое предисловие читателям моего сайта, сайта “Проза Ру”, “Самиздат”, “фАбрика” и всех прочих глубокоуважаемых ресурсов:
Безусловно, нижеследующий текст не относится к разряду классической литературы. Но чувства и страсти, пережитые мной в ПРОЦЕССЕ, заставили меня в этом усомниться.
Конечно, полностью и легко понятным мой роман будет только квалифицированным программистам или людям ПЕРЕЖИВШИМ уже подобное, но ведь предполагается же, что читатель ВЛАДЕЕТ тем языком, на котором написано литературное произведение?
ЧАСТЬ ВТОРАЯ
24 05 02
Сказать по совести переменные типа дата дают мне покоя не.
Нет бы рыть массивы - рою даты...
Option Explicit
Public d1 As Date, d2 As Date, d3
Private Sub Command1_Click()
d1 = Text1.Text
d2 = Date
If Not IsDate(Text1.Text) Then
MsgBox "dfsdfsf"
Exit Sub
Else
MsgBox " Лет тебе: " & Year(d2 - d1) - 1900 & ", месяцев: " & Month(d2 - d1) & _
", дней: " & Day(d2 - d1)
MsgBox "На дворе уже: " & Date
d3 = ((Year(d2 - d1) - 1900) * 365) + (Month(d2 - d1) * 30) + (Day(d2 - d1))
MsgBox " Тобою прожито: " & d3 & " дней, " & vbCrLf & " что означает " _
& d3 * 24 & " часов, " & vbCrLf & _
" которые, между прочим, состояли из " & d3 * 24 * 60 & " минут " & vbCrLf & _
" или же " & d3 * 24 * 60 * 60 & " секунд "
MsgBox " На что, скажи, ушла" & vbCrLf & "ТАКАЯ ПРОРВА" & vbCrLf & "времени?"
Text1.Text = ""
End If
End Sub
Казалось бы - чего надо? А не работает...
понял с трудом, что присваивать переменной значение можно было только после его проверки на корректность.
Option Explicit
Public d1 As Date, d2 As Date, d3
Private Sub Command1_Click()
d2 = Date
If Not IsDate(Text1.Text) Then
MsgBox "dfsdfsf"
Exit Sub
Else
d1 = Text1.Text
MsgBox " Лет тебе: " & Year(d2 - d1) - 1900 & ", месяцев: " & Month(d2 - d1) & _
", дней: " & Day(d2 - d1)
Пытаюсь автоматически переводить фокус на кнопку счета, если заполнение полное и правильное. На ввод даты правильно должен перескакивать фокус. Однако это происходит уже на первой цифре после слэша. Почему?
Как задать границы, разрядность, вид в котором будет отображаться результат - например разделять тысячи точкой
Private Sub Text1_Change()
C1.Visible = True
If IsDate(Text1.Text) Then
C1.SetFocus
Else: Exit Sub
End If
End Sub
Else
d1 = Text1.Text
C1.Caption = "Попробуйте быть честнее!"
If Year(d2 - d1) > 99 Or Year(d2 - d1) < 6 Then
MsgBox "Пытаетесь шутить?"
Text1.Text = ""
Выводы из семичасового безумия следующие:
Проверь переменную. Если она неправильная переменная, сбросить в бокс и EndSub если правильная тогда ее ПРИСВОИТЬ и уже после этого проверять по кругу сбрасывая ошибки в EndSub. Круг таков:
If then Exit sub else if then exit sub
....
Option Explicit
Public d1 As Date, d2 As Date, d3, b, a, f
Private Sub C1_Click()
d2 = Date
C1.Visible = False
If Not IsDate(Text1.Text) Then
MsgBox "Пожалуйста, обратите внимание: первые две цифры - номер месяца." & vbCrLf & _
"вторые две - число." & "Четыре последних - год полностью." & vbCrLf & vbCrLf & _
"Разделяйте числа косой черточкой: /" & vbCrLf & _
"Должно получиться примерно так: 08/20/1970" & vbCrLf & _
"Попробуйте еще разок!"
L1.Caption = "Введите пожалуйста дату своего рождения так:"
Exit Sub
Else
d1 = Text1.Text
If Year(d2 - d1) - 1900 > 99 Or Year(d2 - d1) < 5 Then
MsgBox "99"
Exit Sub
Else
MsgBox " Лет тебе: " & Year(d2 - d1) - 1900 & ", месяцев: " & Month(d2 - d1) & _
", дней: " & Day(d2 - d1)
MsgBox "На дворе уже: " & Date
d3 = ((Year(d2 - d1) - 1900) * 365) + (Month(d2 - d1) * 30) + (Day(d2 - d1))
MsgBox " Тобою прожито: " & d3 & " дней, " & vbCrLf & " что означает " _
& d3 * 24 & " часов, " & vbCrLf & _
" которые, между прочим, состояли из " & d3 * 24 * 60 & " минут " & vbCrLf & _
" или же " & d3 * 24 * 60 * 60 & " секунд "
MsgBox " На что, скажи, ушла" & vbCrLf & "ТАКАЯ ПРОРВА" & vbCrLf & "времени?"
Text1.Text = ""
End If
End If
End Sub
Private Sub Text1_Change()
C1.Visible = True
L1.Caption = "две цифры - месяц, две - число, четыре - год"
End Sub
Долго не мог рискнуть поставить два оператора End If рядом, организовав как бы цикл в цикле. Сделав это отрезал полкилограмма кода.
Суть проблемы состояла как всегда в обработчике ошибок. Я пытался добиться одного ответа на неверный формальный ввод и другого ответа на фактически неверный. Ой, это было тяжко, едва не бросил все ошибки в одно окошко. Но вспомнив, как это неприятно на разные ошибки получать одинаковые ответы, довел, добил, дожал...
Последний штрих - разные сообщение на ввод слишком старой или слишком юной даты...
Private Sub C1_Click()
d2 = Date
C1.Visible = False
If Not IsDate(Text1.Text) Then
MsgBox "Пожалуйста, обратите внимание: первые две цифры - номер месяца." & vbCrLf & _
"вторые две - число." & "Четыре последних - год полностью." & vbCrLf & vbCrLf & _
"Разделяйте числа косой черточкой: /" & vbCrLf & _
"Должно получиться примерно так: 08/20/1970" & vbCrLf & _
"Попробуйте еще разок!"
L1.Caption = "Введите пожалуйста дату своего рождения так:"
Exit Sub
Else
d1 = Text1.Text
If Year(d2 - d1) - 1900 > 99 Then
MsgBox "99"
Exit Sub
Else
d1 = Text1.Text
If Year(d2 - d1) - 1900 < 5 Then
MsgBox "00"
Exit Sub
Else
MsgBox " Лет тебе: " & Year(d2 - d1) - 1900 & ", месяцев: " & Month(d2 - d1) & _
", дней: " & Day(d2 - d1)
MsgBox "На дворе уже: " & Date
d3 = ((Year(d2 - d1) - 1900) * 365) + (Month(d2 - d1) * 30) + (Day(d2 - d1))
MsgBox " Тобою прожито: " & d3 & " дней, " & vbCrLf & " что означает " _
& d3 * 24 & " часов, " & vbCrLf & _
" которые, между прочим, состояли из " & d3 * 24 * 60 & " минут " & vbCrLf & _
" или же " & d3 * 24 * 60 * 60 & " секунд "
MsgBox " На что, скажи, ушла" & vbCrLf & "ТАКАЯ ПРОРВА" & vbCrLf & "времени?"
Text1.Text = ""
End If
End If
End If
End Sub
Private Sub Text1_Change()
C1.Visible = True
L1.Caption = "две цифры - месяц, две - число, четыре - год"
End Sub
Это меня добило. Создаю экзешник и забываю о переменных типа Дата.
Ныряю в массивы. Ну вот разве что пару опозновательных знаков...
Option Explicit
Public d1 As Date, d2 As Date, d3, b, a, f
Private Sub C1_Click()
d2 = Date
C1.Visible = False
If Not IsDate(Text1.Text) Then
MsgBox "Пожалуйста, обратите внимание: первые две цифры - номер месяца." & vbCrLf & _
"вторые две - число." & "Четыре последних - год полностью." & vbCrLf & vbCrLf & _
"Разделяйте числа косой черточкой: /" & vbCrLf & _
"Должно получиться примерно так: 08/20/1970" & vbCrLf & _
"Попробуйте еще разок!"
L1.Caption = "Введите пожалуйста дату своего рождения так:"
Exit Sub
Else
d1 = Text1.Text
If Year(d2 - d1) - 1900 > 99 Then
MsgBox "Дедуля, ты как здесь?"
Exit Sub
Else
d1 = Text1.Text
If Year(d2 - d1) - 1900 <= 0 Then
MsgBox "Вот когда родишься, тогда и приходи!"
Exit Sub
Else
MsgBox " Лет тебе: " & Year(d2 - d1) - 1900 & ", месяцев: " & Month(d2 - d1) & _
", дней: " & Day(d2 - d1)
MsgBox "На дворе уже: " & Date
d3 = ((Year(d2 - d1) - 1900) * 365) + (Month(d2 - d1) * 30) + (Day(d2 - d1))
MsgBox " Тобою прожито: " & d3 & " дней, " & vbCrLf & " что означает " _
& d3 * 24 & " часов, " & vbCrLf & _
" которые, между прочим, состояли из " & d3 * 24 * 60 & " минут " & vbCrLf & _
" или же " & d3 * 24 * 60 * 60 & " секунд "
MsgBox "На что, скажи, ушла" & vbCrLf & " ТАКАЯ ПРОРВА" & vbCrLf & " времени?"
Text1.Text = ""
End If
End If
End If
End Sub
Private Sub Text1_Change()
C1.Visible = True
L1.Caption = " две цифры - месяц, две - число, четыре - год"
End Sub
Убиваюсь дальше, но вот приходит письмо, а в нем - откровения от Учителя Љ1:
(начало цитаты из Учителя)
Скорее всего на свои
вопросы ты уже успел найти ответы, но я надеюсь тебе будет интересно
прочитать и правильный вариант, хотя и чуть позже, чем хотелось бы ;-))
У тебя сейчас два основных момента, которые нужно улучшать. Первый -
понятие типа переменной. Что такое переменная? Это именованная область
памяти. Память хранит байты. Над байтами можно производить бесконечное
множество операций. Это плохо. Представь, мы в какой-то байт записали
символ, а потом умножили его на три. Получается ерунда. Мы должны как-то
ограничить набор допустимых операций над нашим байтом. Для этого мы
приписываем каждой переменной тип. Если переменная имеет тип String, то
мы можем только производить с ней строковые операции и не можем ее
складывать или умножать. Если переменная имеет тип Date, то мы можем
узнавать у нее год или месяц, но не можем искать в ней подстроку или
считать количество символов. Короче это как размерность в физике. Есть
такие учебные строгие языки программирования, где на этом история и
заканчивается. Но на практике нам нужно часто преобразовывать типы.
Например, преобразовать три Integer (год, месяц, день) в дату. Или
преобразовать число в строчку для того, чтобы показать ее пользователю.
В кривых языках вроде Visual Basic или JavaScript преобразование
происходит неявно. Т.е. ты просто пишешь v = "abc" & 123 и получаешь в
переменной v строчку "abc123". При этом число 123 (занимающее два байта)
было втихомолку преобразовано в строчку "123", занимающую семь байтов, а
потом полученная строчка добавлена в конец "abc". Кривость языка
заключается в том, что не все преобразования возможны, и никогда не
знаешь, будет ли преобразовано и насколько хорошо будет преобразовано. К
счастью в языках есть явные функции конвертации с одного типа в другой,
которые я и рекомендую использовать. В VB все еще усложняется типом
Variant. Это тип времени выполнения, т.е. пока программа не запущена,
тип переменной не известен. Когда переменной присваивается первое
значение, рядышком с ней записывается и тип этого значения. Это
позволяет Variant-у не складывать коров с яблоками.
Твоя запись
Public d1 as Date
...
d1 = Text1.Text
вызывает сомнения. Тут ты строчку присваиваешь дате. Судя по всему оно
там внутре как-то преобразовывается и работает нормально, но лучше
сделать явное преобразование при помощи функции DateValue.
Второй момент, который нужно улучшать - качество письма. Существует
прописная истина - программа пишется не для компьютера, а для человека,
который ее читает (для того, чтобы понять, найти ошибку или добавить еще
функцию). Нет формальных правил, чтобы писать ясные и красивые
программы. Тут нужен опыт, определенные способности и желание
развиваться. Хотя многие программисты всю жизнь остаются на
"графоманском" уровне и вполне себе успешно работают и зарабатывают на
этом... Правда их же первыми и "уходят" при очередном сокращении из-за
кризиса.
Как бы я писал твою процедуру C1_Click().
1. Имя процедуры неинформативно. Непонятно, что она делает и для чего
нужна. Назовем ее так:
Private Sub selbstSchlaegerClick()
End Sub
2. Что она должна делать? Проверить ввод, и если это дата, то
сформировать сообщение. Именно так и запишем!
Private Sub selbstSchlaegerClick()
If checkIfDate(Text1.Text) Then
sageEtwas(DateValue(Text1.Text))
End If
End Sub
Обрати внимание, я еще не знаю, КАК будут реализованы функции
checkIfDate и sageEtwas. Мне достаточно знать ЧТО они будут делать. А
остальное - детали, которыми не стоит на данном этапе забивать голову.
Гораздо важнее подумать, а понятные ли имена я дал моим функциям? Вроде
да.
На этом наша первая процедура закончена. Можно откинуться на спинку
кресла и сделать глоток чего-нибудь вкусненького.
3. К сожалению функция checkIfDate и процедура sageEtwas() еще не
написаны. Пишем:
Private Function checkIfDate(var) as Boolean
checkIfDate = IsDate(var)
End Function
Хм. Получилось тривиальная функция, которая сама ничего не делает, и
только передает управление IsDate. Вот если бы не было встроенной
готовой функции (например, мы вводили бы телефон), наша функция
пригодилась бы. А так мы ее выбрасываем, возвращаемся к первой процедуре
и вписываем прямо туда:
Private Sub selbstSchlaegerClick()
If IsDate(Text1.Text) Then
sageEtwas(DateValue(Text1.Text))
End If
End Sub
Готовность вычеркнуть часть своей работы и вернуться к начальным
позициям важна. Ты это тоже хорошо понимаешь.
4. Пишем следующую часть:
Private Sub SageEtwas (datum as Date)
sageAlter(datum)
sageHeute
sageTageGelebt(datum)
schlageBenutzer
End Sub
Опять здесь мы использовали принцип programming by intent,
программирование из намерения. Мы НАМЕРЕВАЕМСЯ сказать ему возраст,
сегодняшнее число, сколько он прожил и какой он нехороший. Вот мы и
записываем на чистом немецком ;-) наше намерение в программу. Чтобы
читателю было ясно и понятно, что делает процедура SageEtwas. Можно
отхлебнуть еще и перечитать уже написанный код.
5. Нам осталось сделать еще четыре части. Пишем сначала самую простую:
Private Sub schlageBenutzer
MsgBox "На что, скажи, ушла" & vbCrLf & _
" ТАКАЯ ПРОРВА" & vbCrLf & _
" времени?"
End Sub
6. Потом чуть сложнее:
Private Sub sageHeute
MsgBox "На дворе уже: " & Date
End Sub
Тут я поленился и не стал преобразовывать явно Date в строку. Но если я
хочу представлять дату в определенном формате, мне нужно отыскать
соответствующую функцию в документации.
7. Переходим к вычислению:
Private Sub sageAlter(datum as Date)
Dim differenz as Date
differenz = Date - datum
MsgBox " Лет тебе: " & Year(differenz) - 1900 & _
", месяцев: " & Month(differenz) & _
", дней: " & Day(differenz)
End Sub
8. Наконец, сколько дней прожили. Есть такая полезная функция DateDiff:
Private Sub sageTageGelebt(datum as Date)
MsgBox " Тобою прожито: " & DateDiff("d", datum, Date) & "
дней, " & vbCrLf & _
" что означает " & DateDiff("h", datum, Date) & "
часов, " & vbCrLf & _
" которые, между прочим, состояли из " & _
DateDiff("n", datum, Date) & " минут " &
vbCrLf & _
" или же " & DateDiff("s", datum, Date) & "
секунд "
End Sub
9. Запускаем программу и видим, что она уже кое как работает. Теперь
начинаем добавлять бантики - реакцию на неверный ввод пользователя. Для
начала переписываем первую процедуру так:
Private Sub selbstSchlaegerClick()
If IsDate(Text1.Text) Then
sageEtwas(DateValue(Text1.Text))
Else
sageDatumFormat
End If
End Sub
и пишем
Private Sub sageDatumFormat
MsgBox "Пожалуйста, обратите внимание: первые две цифры - номер
месяца." & vbCrLf & _
"вторые две - число." & "Четыре последних - год полностью." &
vbCrLf & vbCrLf & "Попробуйте еще разок!"
End Sub
Пассаж о косой черточке я выкинул, потому что это не так. Можно вводить
дату любым способом, хоть Май 4, 2001 или 1960-24-5.
10. Добавляем проверку на возраст в функцию sageEtwas:
Private Sub SageEtwas (datum as Date)
If DateDiff("yyyy", datum, Date) > 99 Then
MsgBox "Дедуля, ты как здесь?"
Exit Sub
End If
If DateDiff("s", datum, Date) <= 0 Then
MsgBox "Вот когда родишься, тогда и приходи!"
Exit Sub
End If
sageAlter(datum)
sageHeute
sageTageGelebt(datum)
schlageBenutzer
End Sub
11. Остальные специи - по вкусу.
Что в итоге у меня получилось. Вместо одной процедуры стало семь. Но
сложность программы при этом снизилась, так как каждая отдельная
процедура сделана настолько просто, насколько это вообще возможно,
поэтому понимается (или я надеюсь, что понимается ;-) влет. Но самое
важное - улучшилась такая характеристика программы, как
модифицируемость. Добавить новую функцию стало проще. Представим, мы
хотим добавить другое поведение программы в том случае, если
пользователь - женщина. В старом варианте нужно было бы "вплетать" его в
плетенку из ифов и елсов, рискуя поставить end if не туда или лишний
раз. В новом варианте у нас есть набор кубиков - sage то или се. Мы
добавим еще кубиков, специфичных для женщины, и используем часть старых.
Сейчас такие параметры программы тебя не очень волнуют, но с ростом
размера программы они будут все важнее и важнее, а заботится об этом
нужно с самого начала. (конец цитаты из Учителя)
20 числа...
...Ушел далеко. Прочитал десяток раз все, что касается массивов и семейств вплоть до определения пользователем типа функции, возвращающей значение типа определенного пользователем. Это было очень приятно, поскольку я обнаружил глубокий смысл и великолепной красоты и отточенности логику происходящего. Очарование продолжается. однако нужно вернуться и посадив знания в почву, прорастить, собрать, скушать урожай и извлечь при перевании максимум полезных витаминов и микроэлементов...
Сначала константы. Хм. Подвешиваю машину в два пинка:
Private Sub Check1_Click()
Check1.Value = 1
Check2.Value = vbGrayed
End Sub
Private Sub Check2_Click()
Check2.Value = 1
Check1.Value = Grayed
End Sub
Увы, не понял смысла констант vbChecked, und Grayed. Warum ist es Eifach, wenn man statt dessen 1,2,0 benutzen kann?
Wofuer braucht man solche lange Namen? Um nicht zu andern?
OK vbChecked bedeutet: kein Anderungen beim clicken: Check2. beibt immer als die Konstant gesagt hat. Alles Klaer.
тьфу, только что обнаружил, что клавиатуру не переключил - набрал абракадабру, но уж переписывать не стану...
Начинаю медленно массировать...
Первый работающий код жирнее создателя:
Не хочет видеть публичные массивы. Наверное это связано с программой вокруг
Private Sub LohneListPrint_Click()
Dim Name(15) As Variant
Dim Lohne(15) As Variant
Name1 = n1.Text
Lohne1 = l1.Text
Name2 = n2.Text
Lohne2 = l2.Text
Name3 = n3.Text
Lohne3 = l3.Text
Name4 = n4.Text
Lohne4 = l4.Text
Name5 = n5.Text
Lohne5 = l5.Text
LohneList = UBound(Lohne)
MsgBox LohneList
End Sub
Private Sub PrintList_Click()
Dim Name(15) As Variant
Dim Lohne(15) As Variant
Name1 = n1.Text
Lohne1 = l1.Text
Name2 = n2.Text
Lohne2 = l2.Text
Name3 = n3.Text
Lohne3 = l3.Text
Name4 = n4.Text
Lohne4 = l4.Text
Name5 = n5.Text
Lohne5 = l5.Text
NameList = UBound(Name)
MsgBox NameList
End Sub
Получается, массив можно декларировать только внутри модуля. Это тебе не переменная...
Не работает и это:
Private Sub Gehoerung_Click()
Dim Name1(10)
Dim Lohne2(20)
Dim Name(UBound(Name1()) + 1)
Dim Lohne(UBound(Lohne2()) + 2)
Хочу на лету переопределить количество элементов в массиве, хотя наверное это проше задать как переменную?
нет, нельзя объявить массив с неизвестным пока количеством элементов:
Option Explici
Option Base 1
Dim lohnezahl, namezahl
Private Sub Gehoerung_Click()
namezahl = ZName.Text
Dim Name(namezahl)
On Error GoTo Error1
lohnezahl = LHohe.Text
Dim Lohne(lohnezahl)
Не хочет однозначно...
Option Explicit
Public w As Integer
Dim min, max
Private Sub Text1_Change()
w = Text1.Text
Dim massiv(w)
End Sub
Private Sub Command1_Click()
min = LBound(massiv)
max = UBound(massiv)
MsgBox min & max
End Sub
Ну типично: сначала убъем полдня настраивая устройство, и только потом почитаем инструкцию. Надо было объявить массив неопределенный, и только потом через переменную давать ему количество. Противно даже...
Сердце успокоилось на этом опыте:
Option Explicit
Option Base 1
Public w As Integer
Dim massiv()
Dim min, max
Private Sub Command1_Click()
w = Text1.Text
ReDim massiv(w)
MsgBox LBound(massiv())
MsgBox UBound(massiv())
End Sub
Private Sub Command2_Click()
w = Text1.Text
ReDim massiv(10 To 20)
MsgBox LBound(massiv())
MsgBox UBound(massiv())
End Sub
Ничего не трогаю, иду дальше...
BalSawing As Currency
BalChecking As Currency
End Type
Dim Balance As CustBalance
Function GetCustBalance(ID As Long) As CustBalance
Dim tBalance As CustBalance
tBalance.BalChecking = CCur(1000 + 4000 * Rnd())
tBalance.BalSawing = CCur(1000 + 4000 * Rnd())
GetCustBalance = tBalance
End Function
Private Sub List1_Click()
Dim Balance As CustBalance
Balance = GetCustBalance(1)
Print Balance.BalChecking
Print Balance.BalSawing
End Sub
Явно неудачный день. Зачем нужно GetCustBalance = tBalance - убей не понимаю!
К тому же эта хрень не работает говорит что нельзяв привате портить то что публик...
Шас грохну эту строчку и просто пойду дальше, к примерам...
Во блин! Оказывается иф - зен можно и без элзе использовать!
27/05/02
Пропавших дней много, их очень много.
Бился головой о массивную стену. Точнее - о стену массивов. Сами по себе они ничего еще, но когда их возвращает функция... Самое трудное было понять нафига же все это нужно? Как применить?
Самое противное - не могу заполнить элементы массива как советуют:
Dim a ()
a(1) =2
a(2) = 3 ...
Но ведь именно так в книге! Наверное все дело в месте: модуль или фишка с приват -саб - публик...
Форма:
Sub AddNames(ParamArray Names())
For Each x In Names
List1.AddItem x
Next x
End Sub
Private Sub Command2_Click()
AddNames "sdsd", "sdfsdfdfs", "sdfsdfff", "dsffsdfsdf"
End Sub
Модуль:
Option Explicit
Public Names(0 To 100)
Public x
Все труднее двигаться по инструкции - она содержит все больше и больше неточностей. Если это учебный метод - то он работает: тысяча подходов и вес взят.... Очень нравится мне это дело: funktion(ParamArray massiv()) сладенько, так и просится в начинку пирога...
Private Sub Command4_Click()
position = 1
Do While position > 0
position = InStr(position + 1, Text2.Text, " ")
words = words + 1
Loop
MsgBox "пробелов в тексте: " & words
End Sub
так посчитал пробелы в тексте...
Забавляясь с операторами, приобретаю опыт...м Только вот забыл как гоу ту оформляется... Не прыгает почему то при ошибке. Ну, да это пока неважно...
Private Sub Command1_Click()
List1.AddItem "Salupa"
a = Val(Text2.Text)
If a <= 0 Then
MsgBox "Fehler!"
Exit Sub
Else
Do While a < 123
a = a + 1
Print 1
Loop
MsgBox "123, Fertig!"
Text2.Text = ""
End If
End Sub
Sub AddNames(ParamArray Names())
For Each x In Names
List1.AddItem x
Next x
End Sub
Private Sub Command2_Click()
Form2.Show
End Sub
Private Sub Command3_Click()
Select Case Weekday(Date)
Case 1
massage = "Haaaa!"
Case 2
massage = "Долбанный вторник!"
Case Else
massage = "Fig snaet chto sa den!"
End Select
MsgBox massage
End Sub
Private Sub Command4_Click()
position = 1
Do While position > 0
position = InStr(position + 1, Text2.Text, " ")
words = words + 1
Loop
MsgBox "пробелов в тексте: " & words
End Sub
29 05 02
Давно искалось - нашлось: мусолим время
Private Sub Form_Load()
Dim LTime
LTime = Timer()
While Timer() - LTime < 3
Wend
End Sub
объявляем переменную равную сейчас, потом ждем пока разница с новым значением таймера не составит три секунды. класс!
Љ
Как связываются и общаются между собой обмениваясь данными две и более форм - это было либо слишком просто или я ничего не понял...
Option Explicit
Private Sub Command2_Click()
Form2.Show Form2Modal.Value
End Sub
Private Sub LoadForm2_Click()
If LoadForm2.Caption = "Load Form2" Then
Load Form2
LoadForm2.Caption = "Unload Form"
Else
Unload Form2
LoadForm2.Caption = "Load Form2"
End If
End Sub
Выбивает из сил огромное количество опечаток или может быть неточностей. Что стоило печатать тексты примеров непосредственно из окна кодов, а не пририсовывать их позже? Вот в жирной строчке (выше) стояла например точка, пытавшаяся видимо внушить бэсику, что у него есть еще одна функция... радует, что на обнаружение ушел уже не день, а час... Пройдена уже 1/6 часть объема, но надеюсь не сведений...
Что остается тайной - так это ActiveControl.Parent.Caption и тд. Никак нейдет обмен...
Запишем в загадки?
Строчка Form2.Show Form2Modal.Value ocобенно хороша. Чую, что именно такой простоты будет мне не хватать в дальнейшем: не могу я допустить бесконтрольного состояния переменных, опираясь на их тры и фальсы! Ненадежно это! Кстати, у чекбокса три, а не два состояния. Кто помешает ему стать серым грауэдом и повесить все нафиг?
Љ
слава Богу, теперь я смогу создать свой собственный текстовый редактор! Конец моим страданиям и разочарованиям и снова наступает хорошая погода когда тебе или ему когда ну все равно кому подарят в день рождения горшок без меда!
Однако как странно: нельзя “верхнему” уровню меню назначить хоткей иной, чем это принято в виндах... Какой-то элемент несвободы появился однако... Уппс! Извиняюсь! Можно оказывается... Только не с контролом а с альтом...
Устанавливаешь апмперсант перед символом и он автоматически подчеркиваясь работает потом с альтом как хоткей.
Руки просятся к перу, но я учусь дальше... И еще до обеда выясняю, что клавиши доступа и хоткей это совсем не одно и то же...
Делая в меню видимое невидимым и наоборот не нужно прямо прописывать изменение состояния, достаточно просто
имякнопки.visible = Not имякнопки.visible
любое из существующих сосотояний перевернется на обратное.
Option Explicit
Private Sub Command1_Click()
FileOpen.Caption = "Close"
End Sub
Private Sub FileOpen_Click()
FileOpen.Caption = "Open"
End Sub
Private Sub NLongMenu_Click()
If NLongMenu.Caption = "Schort Menu" Then
NLongMenu.Caption = "Long Menu"
Else
NLongMenu.Caption = "Schort Menu"
End If
FileExit.Visible = Not FileExit.Visible
Erotik.Visible = Not Erotik.Visible
End Sub
Нужно только добавить, что изначально то кнопки видимые, поэтому первая реакция - укорачивание меню способом обратного значения.
Изъяснение Љ...
Это стало не просто опасно, это просто угрожает моему физическому здоровью!
Посмотрите, что мне предлагалось сделать, определив в меню Run Time Menu команду как массив RunTimeOption
c индексом ноль...
Option Explicit
Dim RTMenu
Private Sub AddCommand_Click()
RTMenu = RTMenu + 1
If RTMenu = 1 Then
RunTimeOptions().Caption = "Run Time Options"
Load RunTimeOptions(RTMenu)
RunTimeOptions(RTMenu).Caption = "Option # " & RTMenu
End Sub
Я не шучу! Это точно то, что предлагалось сделать! Каких только ругательств я не наслушался за эту тысячу попыток запустить это г... Зато проштудировал заново массивы, узнал что у них тоже Каптион бывает,
Вот сколько ужасных для моего здоровья ДЫРОК я обнаружил и выделил жирным вставленное:
Option Explicit
Dim RTMenu
Private Sub AddCommand_Click()
RTMenu = RTMenu + 1
If RTMenu = 1 Then
RunTimeOptions(RTMenu).Caption = "Run Time Options"
Else Load RunTimeOptions(RTMenu)
RunTimeOptions(RTMenu).Caption = "Option # " & RTMenu
End If
End Sub
Оператор ИФ предлагался как бесконечный, неизвестный массив должен был быть от ничего переименован
операторы шли один за другим исключая смысл предыдущего...
Другая кнопка тоже смешная:
...
Private Sub Delete_Click()
If RTMenu = 0 Then
MsgBox "Menu is Empty"
Exit Sub
End IF
Unload RunTimeOptions(RTMenu)
RTMenu = RTMenu - 1
End Sub
Инвалидски заработала после:
Private Sub Delete_Click()
If RTMenu = 0 Then
MsgBox "Menu is Empty"
Exit Sub
Else Unload RunTimeOptions(RTMenu)
RTMenu = RTMenu - 1
End IF
End Sub
Выпадала ошибка, если удалялось больше чем было введено. Не стоит и говорить о такой мелочи, что пункт меню добавлялся не в выпадающее меню, а в верхний его уровень, в строку наряду с файл, эдит и так далее. Выглядело это смешно и казалось, что виндоус сошел с ума...
Поставив большую заплатку в виде изящного While - Wend я произвел на свет
правильную, драгоценную, усовершенствованную, а главное - работающую версию кода...
Option Explicit
Dim RTMenu
Private Sub AddCommand_Click()
RTMenu = RTMenu + 1
If RTMenu = 1 Then
RunTimeOptions(RTMenu).Caption = "Run Time Options"
Else
Load RunTimeOptions(RTMenu)
RunTimeOptions(RTMenu).Caption = "Option # " & RTMenu
End If
End Sub
Private Sub Delete_Click()
If RTMenu = 1 Then
MsgBox "Menu is Empty"
Else
While RTMenu > 1
Unload RunTimeOptions(RTMenu)
RTMenu = RTMenu - 1
Wend
End If
End Sub
Как часто возникает ощущение, что передо мной задача, которую я не в силах преодолеть...
Как часто я бываю по-настоящему счастлив, когда решаю ее. Один из методов счастья...
Вы заметили - я сказал “методов!”
Љ
...Глупо оставлять на панели меню, которое выскакивает попап при нажатии на форме правой мыши. Ну я и сделал его исчезающим... Интересно, а можно попапы делать на внутренних строчках меню, а не привязывать их к форме?
Option Explicit
Private Sub Form_MouseUp(Button As Integer, Schift As Integer, X As Single, Y As Single)
If Button = vbRightButton Then
EditMenu.Visible = Not EditMenu.Visible
PopupMenu EditMenu
Else: EditMenu.Visible = True
End If
End Sub
300502
Љ
Теоретически “просверлив” пару гранитных камней пытаюсь высверленную пыль превратить в плодородную почву.
Первый же опыт неудачен:
Private Sub Command1_Click()
Dim Captions(10) As String
Dim Sizes(10) As Integer
Dim i As Integer
For i = 1 To 8
Load Labels(i)
Load TextBoxes(i)
Labels(i).Top = Labels(i - 1).Top + 1.5 * Labels(0).Height
Labels(i).Left = Labels(0).Left
TextBoxes(i).Top = TextBoxes(i - 1).Top + 1.5 * TextBoxes(i).Height
TextBoxes(i).Left = TextBoxes(0).Left
TextBoxes(i).Width = Sizes(i) * TextWidth("A")
Labels(i).Caption = Captions(i)
Labels(i).Visible = True
TextBoxes(i).Visible = True
Next
End Sub
уверен в наличии ошибок. Ныряю полдня в... В общем, как в Турции, где тепло...
В результате:
Уверенность не оправдалась. Ошибок нет, кроме разве того, что заголовок должен был стоять непосредственно перед текст боксом, что было очевидно сразу.
Программа модифицирует форму, создавая столько полей для ввода и такой длинны, как это требуется новым, неизвестным или если хотите, свежеполученным элементом массива.
Немного эксперимента и...
Все понятно: заголовок объявлен как массив. При появлении нового элемента создается новый элемент массива ТекстБокс, располагаемый ниже предыдущего, но вровень с нулевым.
Выяснилось: при чтении учебника лучше всего использовать классическую музыку без слов.
При написании кода - лучше всего идет джаз: провоцирует на выбрасывание к чертовой матери раздувшихся вложенных процедур и поиску изядщных и рискованных решений, то есть - импровизации.
При дебагге - нет ничего лучше полной тишины. только в тишине семья и соседи смогут оценить все богатство и разнообразие твоей устной речи...
Итак, включаю джаз.
Option Explicit
Private Sub Command1_Click()
Dim Sizes(0 To 100) As Integer
Dim Captions(0 To 100) As String
Captions(1) = "Derika Serra "
Captions(2) = " Serrika Derra "
Captions(3) = " Durika Suerro Derika "
Captions(4) = " Dedurro Erro Suerro"
Captions(5) = " Subdurro Underro"
Captions(6) = "Unddurro Suberra"
Captions(7) = " Sounderro Subdurro"
Captions(8) = "Erro Duderro Dudurro"
For i = 1 To 6
Load Labels(i)
Load TextBoxes(i)
Labels(i).Top = Labels(i - 1).Top + 1.5 * Labels(0).Height
Labels(i).Left = Labels(0).Left
TextBoxes(i).Top = TextBoxes(i - 1).Top + 1.5 * TextBoxes(i).Height
TextBoxes(i).Left = TextBoxes(i - 1).Left
TextBoxes(i).Width = Sizes(i) * TextWidth("A")
Labels(i).Caption = Captions(i)
Labels(i).Visible = True
TextBoxes(i).Visible = True
Next
End Sub
Private Sub Command2_Click()
For i = 0 To 6
TextBoxes(i).Text = " "
Command1.Visible = Not Command1.Visible
Labels(i).Visible = False
TextBoxes(i).Visible = False
Text2.Text = " "
Next
End Sub
Это то, что было. Прозаическое поле, не слишком-то интерактивно, ведь размерность массива определена заранее - так какого лядова утверждать, что поле формируется по запросу, по обстоятельствам? Защиты никакой - виснет даже у умного дурака, что уж говорить о моей жен... Ой, что это я?
От скуки и разочарования приложил к коду примочку, заполняющую поля снизу вверх, переводящую фокус и вытирающую за собой.
А название кнопки я посвящаю своему дорогому Учителю.
Private Sub EinzufuegenNeueItemInDerListFolgenreienUmSpaeteAllesKlarWaere_Click()
If i = 0 Or b >= 6 Or i = 6 Then
MsgBox "Unkorrekt!"
Exit Sub
Else
TextBoxes(i - 1 - b) = Text2.Text
b = b + 1
Print b ‘это чисто для контроля наращивания, ничего более...
Text2.SetFocus
Text2.Text = ""
Command1.Visible = False
End If
End Sub
Weil - Wend работать отказывается, тогда как ифы справляются замечательно.
Пытался передимать аррэй Опа! Размерность массива переопределить то есть, но то ли модуль:
Public k As Integer
Public Sizes() As Integer
Public Captions(0 To 100) As String
Public TextBoxes(0 To 100) As Variant
Public b As Integer
помешал, то ли нет, ан говорит поздно, определен уже он и никакие пресервы не
придимают его уж.
Часто гавкался на тему уже загруженного элемента массива. ну и что что уже загружен? Моя просьба загрузить его не более чем желание быть уверенным, что он уже загружен - ну так и не надо ругаться! Кому плохо от уверенности?
Почему бы не разрешить объявлять переменные и функции внутри саба как угодно и сколько угодно раз и просто удалять потом ненужные повторы? А я бы был уверен, что все детальки мной описаны и конкретизированы...
В предыдущем примере мне пришлось несчастную БЕ аж в модуль заглобалить...
Порылся в оглавлении - очень уже хотелось найти генератор случайных чисел, ведь без него никакой игры не придумаешь... Если только сам с собой в крестики-нолики...
А чтобы моему Учителю было за меня не стыдно, я присобачил к коду еще и маленький индикатор наполнения.
Он кажется, что-то говорил по этому поводу в контексте “сложно”:
При каждом нажатии Einzufugen кое - что происходит...
Option Explicit
Private Sub Command1_Click()
Dim Sizes(0 To 100) As Integer
Dim Captions(0 To 100) As String
Captions(1) = "Derika Serra "
Captions(2) = " Serrika Derra "
Captions(3) = " Durika Suerro Derika "
Captions(4) = " Dedurro Erro Suerro"
Captions(5) = " Subdurro Underro"
Captions(6) = "Unddurro Suberra"
Captions(7) = " Sounderro Subdurro"
Captions(8) = "Erro Duderro Dudurro"
For i = 1 To 6
Load Labels(i)
Load TextBoxes(i)
Labels(i).Top = Labels(i - 1).Top + 1.5 * Labels(0).Height
Labels(i).Left = Labels(0).Left
TextBoxes(i).Top = TextBoxes(i - 1).Top + 1.5 * TextBoxes(i).Height
TextBoxes(i).Left = TextBoxes(i - 1).Left
TextBoxes(i).Width = Sizes(i) * TextWidth("A")
Labels(i).Caption = Captions(i)
Labels(i).Visible = True
TextBoxes(i).Visible = True
Next
End Sub
Private Sub Command2_Click()
For i = 0 To 6
TextBoxes(i).Text = " "
Command1.Visible = Not Command1.Visible
Labels(i).Visible = False
TextBoxes(i).Visible = False
Text2.Text = " "
MsgBox "Das ist nur ein Modul, deswegen exiestieren die Andere Wariation nicht !"
Me.Refresh
Me.Hide
Exit Sub
Next
End Sub
Private Sub EinzufuegenNeueItemInDerListFolgenreienUmSpaeteAllesKlarWaere_Click()
If i = 0 Or b >= 6 Or i = 6 Then
MsgBox "Unkorrekt!"
Exit Sub
Else
TextBoxes(i - 1 - b) = Text2.Text
b = b + 1
Print b
Frame1.Visible = True
Select Case b 'Indikator in Betrieb
Case 1
pic1.Visible = Not pic1.Visible
Case 2
Pic2.Visible = Not Pic2.Visible
Case 3
Pic3.Visible = Not Pic3.Visible
Case 4
Pic4.Visible = Not Pic4.Visible
Case 5
Pic5.Visible = Not Pic5.Visible
Case 6
Pic6.Visible = Not Pic6.Visible
Frame1.Caption = "Alles klar, Danke!"
End Select
Text2.SetFocus
Text2.Text = ""
Command1.Visible = False
End If
End Sub
при модуле:
Option Explicit
Public i As Integer
Public k As Integer
Public Sizes() As Integer
Public Captions(0 To 100) As String
Public TextBoxes(0 To 100) As Variant
Public b As Integer
...А чтобы ему все же стало стыдно, признаюсь, что заставить картинки PicInd1 und PicInd2 cамостоятельно попеременно появляться на форме как движущийся указатель мне не удалось. Максимум результата - реакция на левую кнопку на форме. Вот как стыдно.
Практические решения требуют времени и сил. А впереди, между прочим не только драг, но и дроп!
Жертвую, учитывая что раздел анимации и рисования еще грядет.
Љ
Первый удар в лоб бэсик отразил молчаливо...
Option Explicit
Private Sub Text1_DrugDrop(Source As Control, X As Single, Y As Single)
Source.Caption = Text1.Text
End Sub