ЧАСТЬ ТРЕТЬЯ
...Новая тема - и уже не удивляют старые проблемы. Вот что было:
Private Sub Picture1_DragOver(Source As Control, X As Single, Y As Single, State As Integer)
If State = 0 Then Picture1.BackColor = vbRed
If State = 2 Then Picture1.BackColor = vbBlue
Picture1.BackColor = vbGreen
End If
End Sub
Как вам понравится два иф подряд? Компилятору не нравится. Ему нравится мой вариант:
Private Sub Picture1_DragOver(Source As Control, X As Single, Y As Single, State As Integer)
If State = 0 Then
Picture1.BackColor = vbRed
ElseIf State = 2 Then
Picture1.BackColor = vbBlue
Form1.Caption = "Tr-r-r-r-r-r-r-r-r!!!"
ElseIf State = 1 Then
Picture1.BackColor = vbGreen
Form1.Caption = "HAHAHAHAHAHHA!"
End If
End Sub
Все с DragDrop DragOwer просто и понятно. Стало быть - гениально.
Я вот подумал: зная только несколько возможностей программирования мне уже так сильно захотелось переделать винды, а может быть и вовсе... Нет, это пожалуй рано...
В итоге моя программка реагирует на перетаскивание кнопки "потаскуха" и бросание ее почти на все, и определенное количество раз...
Option Explicit
Dim a
Private Sub Command2_Click()
Picture1.BackColor = vbBlack
End Sub
Private Sub Command3_Click()
If Picture1.BackColor = vbBlack Then
MsgBox "Black, Jast Du it!"
ElseIf Picture1.BackColor = vbGreen Then
MsgBox "Na ya, Green..."
ElseIf Picture1.BackColor = vbYellow Then
MsgBox "OOPS! Yellow..."
Else
Form1.BackColor = vbGreen
MsgBox "Spat pora, usnul Bichok!"
End If
End Sub
Private Sub Command3_DragDrop(Source As Control, X As Single, Y As Single)
"Dim a объявлять переменную внутри саб - огромная ошибка! она должна быть _
объявлена в модуле или в форме, поскольку иначе она обнуляется: _
при каждом клике она объявляется заново как ноль!
a = a + 1
If a = 1 Then
Form1.BackColor = vbRed
Form1.Caption = "На кнопочку упало!"
ElseIf a = 2 Then
Form1.Caption = "Я говорю: на кнопочку что-то упало!"
ElseIf a = 3 Then
Form1.Caption = "Упало ведь на кнопочку что-то!"
Else
Form1.Caption = "Надоело, отключаюсь!"
a = 0
End If
End Sub
Private Sub Form_DragDrop(Source As Control, X As Single, Y As Single)
Picture1.BackColor = vbYellow
Text1.Text = "Uebalas Knoposka!"
End Sub
Private Sub Picture1_DragDrop(Source As Control, X As Single, Y As Single)
Picture1.BackColor = vbBlack
Form1.Caption = "POPA-a-a-a-a-a-AAAL!"
End Sub
Private Sub Picture1_DragOver(Source As Control, X As Single, Y As Single, State As Integer)
If State = 0 Then
Picture1.BackColor = vbRed
ElseIf State = 2 Then
Picture1.BackColor = vbBlue
Form1.Caption = "Tr-r-r-r-r-r-r-r-r!!!"
ElseIf State = 1 Then
Picture1.BackColor = vbGreen
Form1.Caption = "HAHAHAHAHAHHA!"
End If
End Sub
Private Sub Timer1_Timer()
t = Timer()
If t - Timer() > 3 Then
Form1.BackColor = vbYellow
Print "HWATIT RABOTAT"
Print Timer()
End Sub
Да, я шалю, так что же? Кто запретит умелому хирургу крутить-вертеть-подбрасывать от скуки скальпель над офтальмологическим пациентом?
Идея игрушки-потаскушки возникнув какое то время повладела мной и снова забилась в глубины подсознания:
надо учиться, а не трудиться!
Кстати, при пересылке по почте проги ломаются может быть из-за того, что сервер их видит как коды, как вирусы и грохает на лету? Сжать в зип - может помочь? Переименовать в картинку, например?
Попробую оба способа...
А с драгомдропомовер все ясно. Покрутил и выкрутил следующее...
Option Explicit
Dim a
Private Sub Command1_KeyPres(KeyCode As Integer, Shift As Integer)
MsgBox "Dali,Dali!"
End Sub
Private Sub Command2_Click()
Picture1.BackColor = vbBlack
End Sub
Private Sub Command3_Click()
If Picture1.BackColor = vbBlack Then
MsgBox "Black, Jast Du it!"
ElseIf Picture1.BackColor = vbGreen Then
MsgBox "Na ya, Green..."
ElseIf Picture1.BackColor = vbYellow Then
MsgBox "OOPS! Yellow..."
Else
Form1.BackColor = vbGreen
MsgBox "Spat pora, usnul Bichok!"
End If
End Sub
Private Sub Command3_DragDrop(Source As Control, X As Single, Y As Single)
"Dim a объявлять переменную внутри саб - огромная ошибка! она должна быть _
объявлена в модуле или в форме, поскольку иначе она обнуляется: _
при каждом клике она объявляется заново как ноль!
a = a + 1
If a = 1 Then
Form1.BackColor = vbRed
Form1.Caption = "На кнопочку упало!"
ElseIf a = 2 Then
Form1.Caption = "Я говорю: на кнопочку что-то упало!"
ElseIf a = 3 Then
Form1.Caption = "Упало ведь на кнопочку что-то!"
Else
Form1.Caption = "Надоело, отключаюсь!"
a = 0
End If
End Sub
Private Sub Form_DragDrop(Source As Control, X As Single, Y As Single)
Picture1.BackColor = vbYellow
Text1.Text = "Uebalas Knoposka!"
End Sub
Private Sub Form_Load()
Label2.Visible = Not Label2.Visible
End Sub
Вот так, без штрафных очков, но с ощущением провала в том месте где функция называясь выполняется и может не изменяя значения переменной возвратить массив, состоящий из массивов, данные которых определены пользователем, переходим на следующий уровень...
Вопрос: нужно ли приучать себя бить большие буквы если вижуал все равно корректирует автоматически? Может это пригодиться в других языках?
№
обнаружил способ солиднизирования программ: теперь к экзешнику я буду прилагать пару картинок...
Вот все, что готово к пяти часам вечера:
Option Explicit
Dim ImgName As String, f
" Label1.DragDrop
Private Sub Label1_DragDrop(Source As Control, X As Single, Y As Single)
If TypeOf Source Is TextBox Then
Label1.Caption = Source.Text
End If
End Sub
" das Bild DragDrop
Private Sub Picture1_DragDrop(Source As Control, X As Single, Y As Single)
If TypeOf Source Is TextBox Then
ImgName = Source.Text
Else
ImgName = Source.Caption
End If
On Error GoTo Noimage
Picture1.Picture = LoadPicture(ImgName)
Exit Sub
Noimage:
FehlerRater
End Sub
" TextBox DragDrop
Private Sub Text1_DragDrop(Source As Control, X As Single, Y As Single)
If TypeOf Source Is Label Then
Text1.Text = Source.Caption
End If
End Sub
"Вот ведь было как просто написать свою функцию и отправлять на нее _
программульку, ежели чего не так... Прав был Учитель - сначала наставь действий, _
а потом каждое действие преврати в функцию, выполняющую то _
что тебе нужно. Впрочем, может он и сейчас еще прав... Вот моя...
"просто функция Решатель ошибок.
Private Sub FehlerRater()
Picture1.Picture = LoadPicture(Label3.Caption)
MsgBox "Fehler!"
End Sub
"надеюсь все заметили как я ловко ее порешил? создал лабель3 дал ему каптион в виде _
пути к картинке, а потом выключил ему визибельность! _
Заметил, что если положить картинки рядом с экзешником, _
что все работает оч хор.
№
В процессе создания нижеследующего думал: есть ли функция, проверяющая четность и нечетность числового значения переменной? Типа IsChetnoje() Print "Chetnoe"
Будь она окажись - и я решу проблему анимирования кнопок на форме... Хотя чую, что есть возможность решить ее вложив цикл в цикл...
А! Чуть не забыл! Я же из формы в форму все таскать научился и при том происхождение указывать и некорректный и повторный переносы запрещать биииибикая...
! Вопрос программисту: Представьте: на экзамене вам задача: как можно быстрее создать и продемонстрировать экзаменатору форму с кнопкой, по клику которой запускается и проигрывается данный музыкальный файл.
Ну, что, кинулись проигрыватели подключать и активы эксать?
Сдаетесь? Может еще подумаете? Ну-ну-ну?
Ладно уж:
Private Sub Click_()
Beep
End Sub
А теперь пойдите в настройки виндоус и установите в качестве beep требуемый файл. Демонстрация пройдет успешно, что и требовалось в задаче...
"DropForm1 Code
Option Explicit
Private Sub Form_Load()
DropForm2.Show
DropForm2.Move DropForm1.Left + DropForm1.Width + 500, _
DropForm1.Top
DropForm3.Show
DropForm3.Move DropForm1.Left + DropForm1.Width + 500, _
DropForm1.Top + DropForm2.Height
End Sub
"DropForm2.Code
Option Explicit
Private Sub List1_DragDrop(Source As Control, X As Single, Y As Single)
If Source.Caption = "LEER" Then
Beep
Exit Sub
End If
If Source.Tag = "State" Then
List1.AddItem Source.Caption & " (" & Source.Parent.Name & ")"
Source.Caption = "LEER"
Else
Beep
MsgBox "This List accept states only!"
End If
End Sub
"DRopForm3.Code
Option Explicit
Private Sub List1_DragDrop(Source As Control, X As Single, Y As Single)
If Source.Caption = "LEER" Then
Beep
Exit Sub
End If
If Source.Tag = "city" Then
List1.AddItem Source.Caption & " (" & Source.Parent.Name & ")"
Source.Caption = "LEER"
Else
Beep
MsgBox "This List accept citys only!"
End If
End Sub
№
Экспериментирую с драгидропом, гордясь тем, что следующая глава - уже Актив
Заработало уродливо вот что:
Private Sub Blue_MouseDown(Button As Integer, Shift As Integer, _
X As Single, Y As Single)
If Shift = 1 Then
Green.SetFocus
Print ActiveControl.Name
ActiveControl.DragMode = 1
Print ActiveControl.DragMode
Else
Print GGGGGg
"Drapalka
End If
End Sub
"Private Sub Green_Click()
"Print ActiveControl.Name
"End Sub
Private Sub Text2_DragOver(Source As Control, X As Single, Y As Single, State As Integer)
If State = 1 & ActiveControl.Name = Green Then
Text2.BackColor = vbGreen
Else
Text2.BackColor = vbBlue
End If
End Sub
Забавное происшествие!
При создании формы затащил элемент Текст1..... за пределы видимости формы, за ее границы! Ну и как настоящий профессионал интерфейсостроения, этого конечно же не заметил... Спокойненько слепил второй такой же, обработал его события и... Все было неплохо, пока не захотелось приписать пару примочек вручную...
Когда компилятор сказал мне, что Text1.BackColor = vbBlue выполнить невозможно ввиду отсутствия такового, мне захотелось перезагрузиться...
Однако догадался поискать в списке компонентов и обнаружил, что да.
очередные полдня безумства и вот результат:
Option Explicit
" Blue Taste
Private Sub Blue_MouseDown(Button As Integer, Shift As Integer, _
X As Single, Y As Single)
Form2.Show
If Shift = 1 Then
Green.SetFocus
Drapalka
Form2.Text1 = ActiveControl.Name
If ActiveControl.Name = Green Then
Text1.BackColor = vbGreen
Else: Text1.BackColor = vbBlack
End If
Form2.Text1 = ActiveControl.Name & ActiveControl.DragMode
If ActiveControl.DragMode = 1 Then
Text1.Text = "Taste GREEN ist mobil!"
Else: Text1.Text = "Nur Cklicken auf die Taste GREEN!"
End If
Else
Form2.Text1 = "Nasmite Shift!"
End If
End Sub
" Green Taste
Private Sub Green_MouseDown(Button As Integer, Shift As Integer, _
X As Single, Y As Single)
If Shift = 1 Then
Blue.SetFocus
Drapalka
Form2.Text1 = ActiveControl.Name & ActiveControl.DragMode
Else
Form2.Text1 = "Geht Nicht!"
End If
End Sub
" Text1 DragOver
Private Sub Text1_DragOver(Source As Control, X As Single, Y As Single, State As Integer)
If ActiveControl.Name = Green Then
Text1.BackColor = vbGreen
ElseIf ActiveControl.Name = Blue Then
Text1.BackColor = vbBlue
Else: Text1.BackColor = vbBlue
End If
End Sub
" Funktion Drapalka
Private Sub Drapalka()
"после сотни экспериментов с = Not и даже с минусами, не удалось создать _
функцию переворачивающую драгмод лучше чем этот примитив:
If ActiveControl.DragMode = 1 Then
ActiveControl.DragMode = 0
Else
ActiveControl.DragMode = 1
End If
End Sub
Кнопки переключают друг другу дропмоде при удерживаемом шифте. С цветами правда я вконец запутался, но почему-то мне на это наплевать...
Опыт №
Ой как интересненько! Перетаскивание элемента списка... Я то думал, что для этого будет индекс массива или флаг использован, а они вишь невидимый DragLabel придумали размеры которого моментально на выделение натягиваются и его содержать начинает... Интересненько как!
Итак, дано:
Option Explicit
"
Private Sub Command1_Click()
FileList.AddItem (Text1.Text)
Text1.Text = "Einzufuegen mich? "
Text1.SetFocus
End Sub
Private Sub Filelist_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim DY As Integer
DY = TextHeight("B")
"was "A"? высота пункта списка, говорят...
"DragLabel.Move bedeutet переместить на следующие координаты?)
DragLabel.Move FileList.Left, FileList.Top + Y - DY / 2, _
FileList.Width, DY
"Дали новые вычисленные координаты и разрешили тащиться
Print DragLabel.Name & DragLabel.Caption
DragLabel.Drag
End Sub
Private Sub Ziel_DragDrop _
(Source As Control, X As Single, Y As Single)
If ListDrop.ActiveControl.Name = "FileList" Then
Ziel.AddItem DragLabel.Caption
End If
End Sub
Да, это работает, если отображаемым в списке элементом сделать информацию - указание его местоположение драйв и имя файла.
Что можно извлечь из Лабель, кроме заранее установленных параметров типа имя и Каптион? Ни черта!
А ведь просто хотелось увидеть в новом списке перетащенных пунктов... А что же получается, я тянул рамку с координатами?
В книжке - вот подлость, самая важная строчка выглядит так: Ziel.AddItem Dir1.Path & " / " & FileList.FileName
и ни слова об этом в пояснения. Типа = посмотрите, что это возможно и убедитесь, что не для вас... Впрочем такие методы мне уже встречались, позднее все выяснялось, но... Неприятно. Вот, к примеру, стоит в его версии Драйвер Бокс используются во весь рост его свойства и способности, но ни слова КАК . Ну что ты тут поделаешь с этими великими программистами? Только терпеть. А стерпев, идти, ползти дальше, записав себе в пассив еще одно штрафное очко...
Дозрел до возражения: А почему бы не складывать коров с яблоками, если они оба - переменные типа String?
02 06 2002
...А все-таки как хорошо учиться по книжке! Прелесть просто! Будь у меня живой преподаватель, так я его наверное убил бы уже, сжег и пепел съел.
За четыре дня - полкилограмма кофе. Глаза видят только тоненькую полоску программного кода, а ощущение от них как от двух имплантированных баскетбольных мячей: крупные и шершавые...
А что в итоге? В итоге - простейший до стыдного искалко-смотрельшик “Зухер 0.01”...
Option Explicit
Public n, p
Public Patt, Matt
Private Sub AddNeuSelect_Click()
Select Case (n)
Case 0
n = n + 1
Perestroika
Patt = File1.Pattern
Case 1
File1.Pattern = Patt
Label1.Caption = "Ceйчас мы видим только файлы типа: " & Patt
End Select
End Sub
Private Sub Combo1_Change()
File1.Pattern = Combo1.Text
Anzeige
End Sub
Private Sub Command1_Click()
Select Case (p)
Case 0
p = p + 1
Perestroika
Matt = File1.Pattern
Case 1
File1.Pattern = Matt
Label1.Caption = "Ceйчас мы видим только файлы типа: " & Matt
End Select
Anzeige
End Sub
Private Sub Help_Click()
MsgBox "Нажимая на одну из кнопку" & " *Видеть только*, " & "вы исключаете из списка файлов все прочие типы." & vbCrLf & _
"Набрав в поле со стрелочкой тип интересующего вас файла," _
& vbCrLf & "нажмите одну из кнопок *Добавить новое* " & vbCrLf & "После этого она работает как кнопка *Видеть только...* " & vbCrLf & _
"Нажатие кнопки *Все заново* сбрасывает значение кнопок *Добавить новое* "
End Sub
Private Sub JUG_Click()
MsgBox " Juergen Graefenstein" & vbCrLf & _
"www.merculov.narod.ru" & vbCrLf & " merculov@narod.ru"
End Sub
Private Sub Label2_Click()
MsgBox "Это бесплатная, зато очень слабая версия" & vbCrLf & " Зухер 0.01" & vbCrLf & " Продолжение следует!"
End Sub
" Nur Doc
Private Sub nurDocShow_Click()
File1.Pattern = "*.doc"
Anzeige
End Sub
" NUR TEXT
Private Sub NurTextShow_Click()
File1.Pattern = "*.txt"
Anzeige
End Sub
" Alle File Show
Private Sub AlleFilwShow_Click()
File1.Pattern = "*.*"
Label1.Caption = "Ceйчас мы видим ВСЕ файлы"
End Sub
" Reset All
Private Sub ResetAll_Click()
n = 0
p = 0
AddNeuSelect.Caption = "Первый Кноп свободен!"
Command1.Caption = "Второй Кноп свободен!"
Anzeige
End Sub
" DriverBox
Private Sub Drive1_Change()
On Error GoTo DriverKaputt
Dir1.Path = Drive1.Drive
Exit Sub
DriverKaputt:
MsgBox "Нет такого диска!"
End Sub
" DirBox
Private Sub Dir1_Change()
File1.Path = Dir1.Path
End Sub
" Funktions
Private Sub Perestroika()
File1.Pattern = Combo1.Text
ActiveControl.Caption = "Видеть только: " & Combo1.Text
Anzeige
End Sub
" Anzeige
Private Sub Anzeige()
Label1.Caption = "Ceйчас мы видим только файлы типа: " & File1.Pattern
End Sub
Чувствую - все можно было бы сделать иначе. Побольше универсальных обработчиков. Вместо надуманных переменных наверняка можно было бы поставить флаг или индекс взять или даже использовать не кнопку, а что-то другое, реагирующее на клик... Подход прямой и уродливый, но просто нет сил. Вставлять драги и дропы буду уже в следующую версию.
Хочу сделать НЕуниверсальный текстовый редактор, сочетающий функции проводника, поисковика, счетчика и сравнивателя, но обладающий только теми функциями, которые ему определит пользователь... Это чисто эгоистическое желание старого графомана, задолбавшегося с этими док, тхт как виндоус, как просто текст и так далее...
Открыл - увидел только то, что нужно - тут же в окошечке оно открылось и просмотрелось, с другим окошечком сравнились редакции и - пошли на переработочку, не долбясь с переключателями языка. Он там ОДИН будет!
Половина девятого. Давлю на кнопку “создать Экзешник” и вспоминаю, что Комбобокс моего Зухера не наполняется в процессе работы, а стирает все... Впрочем, а для чего тогда существует Апдэйт? Шлю всем...
Опыт № продолжается
Создаю апдэйт для зухера не отходя от кассы.
Добавил автозапись в чекбокс, поленясь даже создать отдельную функцию. А нафига?
Но ето мелочь. Прибавив к зухеру листбокс, в который можно скидывать выделенные файлы, убей Бог не могу понять как это у меня заработало!
Чесслово не могу понять как натягивающийся сверху чулок в виде DrugLabel1 может потом передавать имя файла.. файллисту?
Чего стоит эта строчка:
If Sucher.ActiveControl.Name = "ZielList" Then
ZielList.RemoveItem ZielList.ListIndex
Я удаляю элемент списка - читай массива - с индексом, равным ListIndex! Чушь!
А главное - при чем тут DragLabel1?
Постыдно “списав” часть программного кода, воспользовавшись тем самым чужими практически мозгами, я выдал вторую версию зухера, однако еще без возможности сохранить файл. ОЙ! Так это же настоящая Демо-версия!
Сам того не зная я ее нарисовал. Теперь можно попросить перечислять деньги. Нет, ну Виндоус же покупают!
Option Explicit
Public n, p, otobrasenie, Ansicht
Public Patt, Matt
Private Sub AddNeuSelect_Click()
Combo1.AddItem Combo1.Text
Select Case (n)
Case 0
n = n + 1
Perestroika
Patt = File1.Pattern
Case 1
File1.Pattern = Patt
Label1.Caption = "Ceйчас мы видим только файлы типа: " & Patt
End Select
End Sub
Private Sub Combo1_Change()
File1.Pattern = Combo1.Text
Anzeige
End Sub
Private Sub Command1_Click()
Combo1.AddItem Combo1.Text
Select Case (p)
Case 0
p = p + 1
Perestroika
Matt = File1.Pattern
Case 1
File1.Pattern = Matt
Label1.Caption = "Ceйчас мы видим только файлы типа: " & Matt
End Select
Anzeige
End Sub
" FileList Drag Drop
Private Sub File1_DragDrop(Source As Control, X As Single, Y As Single)
If Sucher.ActiveControl.Name = "ZielList" Then
ZielList.RemoveItem ZielList.ListIndex
End If
End Sub
" FileList MoeseDown
Private Sub File1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim DY As Integer
DY = TextHeight("A")
DragLabel1.Move File1.Left, File1.Top + Y - DY / 2, _
File1.Width, DY
DragLabel1.Drag
End Sub
" HELP MENU
Private Sub Help_Click()
MsgBox " Нажимая на одну из кнопку " & " *Видеть только*, " & "вы исключаете из списка файлов все прочие типы." & vbCrLf & _
"Набрав в поле со стрелочкой тип интересующего вас файла," _
& vbCrLf & "нажмите одну из кнопок *Добавить новое* " & vbCrLf & "После этого она работает как кнопка *Видеть только...* " & vbCrLf & _
"Нажатие кнопки *Все заново* сбрасывает значение кнопок *Добавить новое* " & _
" В версии " "Зухер 0.02" Вы можете свободно копировать - "перетаскивать" мышкой файлы в правый список, удалять их " & _
" и также "вытаскивать" файлы из списка. " & vbCrLf & " Поставьте "галочку" , если хотите видеть адрес и местоположение файла полностью"
End Sub
" INFO -Help
Private Sub JUG_Click()
MsgBox " Juergen Graefenstein" & vbCrLf & _
"www.merculov.narod.ru" & vbCrLf & " merculov@narod.ru"
End Sub
Private Sub Label2_Click()
MsgBox "Это бесплатная, зато все еще очень слабая версия" & vbCrLf & " Зухер 0.02" & vbCrLf & " Продолжение следует!"
End Sub
" Nur Doc
Private Sub nurDocShow_Click()
File1.Pattern = "*.doc"
Anzeige
End Sub
" NUR Text
Private Sub NurTextShow_Click()
File1.Pattern = "*.txt"
Anzeige
End Sub
" Alle File Show
Private Sub AlleFilwShow_Click()
File1.Pattern = "*.*"
Label1.Caption = "Ceйчас мы видим ВСЕ файлы"
End Sub
" Reset All
Private Sub ResetAll_Click()
n = 0
p = 0
AddNeuSelect.Caption = "Первый Кноп свободен!"
Command1.Caption = "Второй Кноп свободен!"
Anzeige
End Sub
" ZielList
Private Sub ZielList_DragDrop(Source As Control, X As Single, Y As Single)
Ansicht = Check1.Value
Print Check1.Value
If Sucher.ActiveControl.Name = "File1" And Ansicht = 1 Then
ZielList.AddItem Dir1.Path & File1.FileName
Else: NepolnoeOtobrasenie
End If
End Sub
" DriverBox
Private Sub Drive1_Change()
On Error GoTo DriverKaputt
Dir1.Path = Drive1.Drive
Exit Sub
DriverKaputt:
MsgBox "Нет такого диска!"
End Sub
" DirBox
Private Sub Dir1_Change()
File1.Path = Dir1.Path
End Sub
" Funktions
Private Sub Perestroika()
File1.Pattern = Combo1.Text
ActiveControl.Caption = "Видеть только: " & Combo1.Text
Anzeige
End Sub
" Anzeige
Private Sub Anzeige()
Label1.Caption = "Ceйчас мы видим только файлы типа: " & File1.Pattern
End Sub
Private Sub ZielList_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim DY As Integer
DY = TextHeight("B")
DragLabel1.Move ZielList.Left, ZielList.Top + Y - _
DY / 2, ZielList.Width, DY
DragLabel1.Drag
End Sub
Private Sub NepolnoeOtobrasenie()
ZielList.AddItem File1.FileName
End Sub
Не знаю зачем, не знаю почему, сделал Зырилку. Конечно пользоваться ей невозможно по причине непомещаемости картинки в правильную величину, но для тех, у кого ничего нет кроме фотошопы - сойдет, думаю.
Писал, думая о Австралийском друге... Он камеру купил, теперь фото шлет. Да каждое по 200 килобайт!
Я уже десять получил... Надо срочно писать программку - сокращалку! Это в моих же интересах!
Надо заметить, что Select Case не сработал на месте нынешнего If Then. получилось громоздко.
трудно было добиться правильного понимания загрузчиком пути - один слеш, два слеша. пришлось приклеивать функцию.
Странно, но оператор Load Text1.Text = LoadText(FileName)
А что такое лоад текст спрашивает у меня компилятор, а я и не знаю что ему ответить...
Но по точно такому же принципу грузятся картинки!
Увлекшись, я потерял - вернее выбросил две интересные распознавалки клавиш, которыми можно было бы выбрасывать файлы из списка или наоборот, вносить в какой-либо другой список... Пока нет функции сохранить - бирюлькаться с этим не стоит.
Похоже, настал логический предел запоминания. Много раз приходится возвращаться к началу, удостовериваться и проверять заново. Забываются простейшие вещи, зато массивы, сука, помнятся!
Завтра даст Бог - приступаю мучить тексты. А на сим - конец третей части.
Option Explicit
Public a, b, c, d, e, f, g, h, n, m, k, imgName, KorenLi, Zeichen, File1
Private Sub IchWill_Click()
n = n + 1
If n = 1 Then
Zeichen = "*.BMP"
Trans
Else
Zeichen = "*.JPG"
Trans
n = 0
End If
End Sub
Private Sub Drive1_Change()
On Error GoTo DriverKaputt
FileList.Pattern = Zeichen
Dir1.Path = Drive1.Drive
Exit Sub
DriverKaputt:
MsgBox "Нет такого диска!"
End Sub
Private Sub Dir1_Change()
FileList.Pattern = Zeichen
FileList.Path = Dir1.Path
End Sub
Private Sub FileList_Click()
If Dir1.Path = "c:\" Or Dir1.Path = "d:\" Or Dir1.Path = "e:\" Or Dir1.Path = "f:\" _
Or Dir1.Path = "g:\" Or Dir1.Path = "h:\" Or Dir1.Path = "a:\" Then
d = d + 1
imgName = Dir1.Path & FileList.FileName
ZielList.AddItem "№" & d & " " & Dir1.Path & " \ " & FileList.FileName
Picture1.Picture = LoadPicture(imgName)
Else
d = d + 1
ZielList.AddItem "№" & d & FileList.FileName
imgName = Dir1.Path & "\" & FileList.FileName
Picture1.Picture = LoadPicture(imgName)
End If
End Sub
Private Sub Form_Load()
FileList.Pattern = "*.jpg*"
End Sub
Private Sub Jug_Click()
MsgBox " Juergen Graefenstein" & vbCrLf & _
"www.merculov.narod.ru" & vbCrLf & " merculov@narod.ru"
End Sub
Private Sub Label2_Click()
MsgBox "Это бесплатная, зато очень слабая версия" & vbCrLf & " Анзищьт 0.02" & vbCrLf & " Продолжение следует!"
End Sub
"Funktion KurzWeg
Private Sub KurzWeg()
imgName = Dir1.Path & FileList.FileName
Picture1.Picture = LoadPicture(imgName)
End Sub
" Funktion Trans
Private Sub Trans()
IchWill.Caption = "Вижу" & Zeichen
FileList.Pattern = Zeichen
End Sub
Private Sub ооо_Click()
MsgBox "Кликая по оранжевой кнопке, выбираем вариант " & " файлов для просмотра." & vbCrLf & _
"Папки открываются двойным щелчком." & vbCrLf & _
"Ведется история просмотра." & vbCrLf & _
"Ничего нельзя удалить или случайно перенести." & vbCrLf & _
"Мы просто смотрим." & vbCrLf & _
"...A Вы чего-то другого хотели от бесплатной версии?"
End Sub