Меркулов Юрий Александрович : другие произведения.

Наверно Windows сошли с ума или Мой Бэсик2

Самиздат: [Регистрация] [Найти] [Рейтинги] [Обсуждения] [Новинки] [Обзоры] [Помощь|Техвопросы]
Ссылки:
Школа кожевенного мастерства: сумки, ремни своими руками
 Ваша оценка:

  Мой Бэсик, часть 2
  “Наверно Виндоус сошли с ума”
  
  
  
  
  
  
  Необходимое предисловие читателям моего сайта, сайта “Проза Ру”, “Самиздат”, “фАбрика” и всех прочих глубокоуважаемых ресурсов:
  
  Безусловно, нижеследующий текст не относится к разряду классической литературы. Но чувства и страсти, пережитые мной в ПРОЦЕССЕ, заставили меня в этом усомниться.
  Конечно, полностью и легко понятным мой роман будет только квалифицированным программистам или людям ПЕРЕЖИВШИМ уже подобное, но ведь предполагается же, что читатель ВЛАДЕЕТ тем языком, на котором написано литературное произведение?
  
  
  
  ЧАСТЬ ВТОРАЯ
  
  
  
  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
  
  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"
  
  Sizes(1) = 10
  Sizes(2) = 20
  Sizes(3) = 30
  Sizes(4) = 40
  Sizes(5) = 50
  Sizes(6) = 60
  Sizes(7) = 70
  Sizes(8) = 80
  Sizes(9) = 90
  
  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"
  
  Sizes(1) = 10
  Sizes(2) = 15
  Sizes(3) = 20
  Sizes(4) = 25
  Sizes(5) = 30
  Sizes(6) = 35
  Sizes(7) = 40
  Sizes(8) = 45
  Sizes(9) = 50
  
  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"
  
  Sizes(1) = 10
  Sizes(2) = 15
  Sizes(3) = 20
  Sizes(4) = 25
  Sizes(5) = 30
  Sizes(6) = 35
  Sizes(7) = 40
  Sizes(8) = 45
  Sizes(9) = 50
  
  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
  
  
 Ваша оценка:

Связаться с программистом сайта.

Новые книги авторов СИ, вышедшие из печати:
О.Болдырева "Крадуш. Чужие души" М.Николаев "Вторжение на Землю"

Как попасть в этoт список

Кожевенное мастерство | Сайт "Художники" | Доска об'явлений "Книги"