Главная страница Случайная страница
Разделы сайта
АвтомобилиАстрономияБиологияГеографияДом и садДругие языкиДругоеИнформатикаИсторияКультураЛитератураЛогикаМатематикаМедицинаМеталлургияМеханикаОбразованиеОхрана трудаПедагогикаПолитикаПравоПсихологияРелигияРиторикаСоциологияСпортСтроительствоТехнологияТуризмФизикаФилософияФинансыХимияЧерчениеЭкологияЭкономикаЭлектроника
Смена вида кнопки при наведении и отведении курсора на VB6
|
|
Всякий раз наводя курсор на кнопку " Пуск" в Windows 7 вы видели как она менялась. И вы наверно думали: а как реолизовать такой эффект в VB6? Давайте попробуем
Код:
Private Sub Image1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)Image1.Picture = LoadPicture(" C: Безымянный.bmp") ' при наведении курсора на имейдж в него загрузится картинка End SubНу теперь запускаем. Чтож мы видим? Навели курсор - картинка в имейдже измнилась. Но ведь она должна изменятся обратно при отведении курсора. Но почему-то MuseMove этого не поддерживает. Тогда придётся втянуть в это дело форму. Наведением курсора на форму мы будем имитировать отведение курсора от имейджа.
Вот код вместе с первым примером.
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)Image1.Picture = LoadPicture(" C: Безымянный1.bmp") ' при наведении курсора на форму в имейдж загрузится картинка которая была раньше End Sub Private Sub Image1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)Image1.Picture = LoadPicture(" C: Безымянный.bmp") ' при наведении курсора на имейдж в него загрузится картинка End Sub
Супер калькулятор с одним текстовым полем
Всем привет.
В этом уроке сделаем Калькулятор с одним теккстовым полем за пару минут
нам понадобится добавить контрол " Microsoft Script Control 1.0", Кнопка и тестбокс и Script Control назовём его SC1
Script Control - это для запусков скриптов. Мы используем функцию Eval - в аргумент код например " 2+4*2", результат Ответ эт тоже самое что в программирование " x=2+4*2"
код в 3и строчки (можно вообще в одну строку написать)
Option Explicit
Private Sub Command1_Click()
Text1 = Text1 & " = " & SC1.Eval(Text1) ' отправлем ему код, он нам результат
End Sub
Запрет ввода букв в поле ввода.
Private Sub Text1_KeyPress(KeyAscii As Integer) 'Отлавливаем ввод
If (IsNumeric(Chr(KeyAscii)) = False) And (KeyAscii < > 8) Then
If KeyAscii = 44 Then 'запятая
KeyAscii = 46 'меняем запятую на точку, т.к. VB не любит запятые в Float.
Else
KeyAscii = 0
End If
End If
End Sub
Показывает заряд батареи на ноутбуках
Option Explicit
'API
Private Declare Function GetSystemPowerStatus Lib " kernel32" _
(lpSystemPowerStatus As SYSTEM_POWER_STATUS) _
As Long
Private Type SYSTEM_POWER_STATUS
ACLineStatus As Byte
BatteryFlag As Byte
BatteryLifePercent As Byte
Reserved1 As Byte
BatteryLifeTime As Long
BatteryFullLifeTime As Long
End Type
Dim sysInfo As SYSTEM_POWER_STATUS
Private Sub Form_Load()
Timer1.Interval = (100) 'Устанавливаем интервал таймера в 100 милисикунд
End Sub
Private Sub Timer1_Timer() 'каждые 100 милмсикунд обновляется проверка заряда аккамулятора
Call GetSystemPowerStatus(sysInfo)
Me.Caption = (sysInfo.BatteryLifePercent & " %")
Label1.Caption = (sysInfo.BatteryLifePercent & " %")
If sysInfo.ACLineStatus = (0) Then
Label2.Caption = (" Зарядка отключена")
Else
Label2.Caption = (" Зарядка подключена")
End If
End Sub
демонстрирующий извлечение расширения файла из пути к нему.
function LastDelim(s: string): integer; // получаем последнюю точку в путиvar i, j, len: integer; begin result: =length(s); while result > 0 do if (s[result]< > #0) and (s[result]< > '.') then dec(result) else exit; end; function ExtractExt(const path: string): string; // копируем расширениеvar s, tmp: string; i: integer; begin result: =''; i: =lastdelim(path); if (i > 0) and (path[i]= '.') then result: =copy(path, i, maxint); end; procedure TForm1.Button1Click(Sender: TObject); var s: string; begin s: ='C: \some folder\123.exe'; showmessage(extractext(s)); end;На бейсике можно попробовать сделать так:
str= " C: \some folder\other folders.more.more.folders.\123.exe" for i=len(str) to 1 step -1 if mid(str, i, 1)= "." then ext=mid(str, i, len(str)) exit for end ifnextлибо на худой конец вызвать метод GetFile объекта Scripting:
set fso=createobject(" Scripting.FileSystemObject")msgbox fso.getfile(" Имя существующего файла.расширение")Поиск файлов
Public Const MAX_PATH = 260 Public Const INVALID_HANDLE_VALUE = -1 Public Const FILE_ATTRIBUTE_DIRECTORY = & H10 Public Type WIN32_FIND_DATA dwFileAttributes As Long ftCreationTime As Currency ftLastAccessTime As Currency ftLastWriteTime As Currency nFileSizeHigh As Long nFileSizeLow As Long dwReserved0 As Long dwReserved1 As Long cFileName As String * MAX_PATH cAlternate As String * 14End Type Public Declare Function FindFirstFile Lib " kernel32" Alias " FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As LongPublic Declare Function FindNextFile Lib " kernel32" Alias " FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As LongPublic Declare Function lstrcpyn Lib " kernel32" Alias " lstrcpynA" (ByVal lpString1 As String, ByVal lpString2 As String, ByVal iMaxLength As Long) As LongPublic Declare Function FindClose Lib " kernel32" (ByVal hFindFile As Long) As LongPublic Declare Function GetFileAttributes Lib " kernel32" Alias " GetFileAttributesA" (ByVal lpFileName As String) As Long Public Function TrimStr(OriginalStr As String) As String If InStr(1, OriginalStr, Chr(0)) > 0 Then TrimStr = Left(OriginalStr, InStr(1, OriginalStr, Chr(0)) - 1) Exit Function End If TrimStr = OriginalStrEnd Function Public Function FindFiles(path As String, ByRef col As Collection)Dim WD As WIN32_FIND_DATADim hfile As LongDim fname As StringIf Right(path, 1) < > " " Then path = path & " " hfile = FindFirstFile(path & " *.*", WD) ' данная API функция ищет первый попавшийся файл.If hfile < > INVALID_HANDLE_VALUE Then Do fname = TrimStr(WD.cFileName)' некоторые API любят добавлять к возвращаемому значению (строка) нулевой символ - chr(0). 'Его нужно удалять из конца строки, в противном случае функции для сравнения строк будут возвращать неверный результат. If (fname < > ".") And (fname < > "..") Then If (WD.dwFileAttributes And vbDirectory) = vbDirectory Then Call FindFiles(path & fname, col) ' рекурсивный поиск. Функция вызывает сама себя, пока не обойдет все подкаталоги. Else col.Add path & fname End If End If DoEvents Loop While FindNextFile(hfile, WD) < > False ' продолжаем цикл до тех пор, пока не будет найден последний файл в данной директории. FindClose (hfile)End IfEnd FunctionКод формы:
Запрет ввода букв в поле ввода.
Private Sub Text1_KeyPress(KeyAscii As Integer) 'Отлавливаем ввод If (IsNumeric(Chr(KeyAscii)) = False) And (KeyAscii < > 8) Then If KeyAscii = 44 Then 'запятая KeyAscii = 46 'меняем запятую на точку, т.к. VB не любит запятые в Float. Else KeyAscii = 0 End If End IfEnd Sub
Как узнать полный путь к своему исполняемому модулю
Option Explicit ' защита от случайных переменных. Можно убрать, по желанию.
Private Declare Function GetModuleFileName Lib " kernel32" Alias " GetModuleFileNameA" (ByVal hModule As Long, ByVal lpFileName As String, ByVal nSize As Long) As Long ' Декларируем API функцию, которая позволяет узнать имя по хендлу модуля(по умолчанию, чтобы узнать для своего, нужно передать 0).
Public Function GetExeName() As String
Dim buff As String 'Строковый буфер, который функция заполнит именем файла.
Dim bufflen As Long ' Длина буфера
bufflen = 300
buff = String(bufflen, 0) ' по-хорошему, буфер нужно передавать заполненным; заполняем нулевыми символами chr(0)
GetExeName = Left(buff, GetModuleFileName(0, buff, bufflen)) ' вызываем функцию и закидываем результат на стек.
End Function
Private Sub Command1_Click()
MsgBox GetExeName
End Sub
Visual Basic работа со строками
Ты наверное мечтал когда-то установить размер надписи, поменять цвет... Теперь твоя мечта сбылась! Сейчас мы будем делать с надписью все, что захотим. Входим в VB, кликаем на Standart EXE. На форму помещаем 4 кнопки, 1 метку, и наверное хорош. У 1-ой кнопки свойство Caption должно быть равным " Шрифт", у 2-ой кнопки свойство Caption будет равным " Цвет", у 3-ей " Фон", у 4-ой " Фон Формы". У тебя должно получиться что-то вроде этого:
Теперь код:
Private Sub Command1_Click()Label1.FontSize = 26 'при нажатии на кнопку 1 у метки будет размер равным 26 End Sub Private Sub Command2_Click()Label1.ForeColor = vbRed 'при нажатии на кнопку 2 цвет текста будет красным End Sub Private Sub Command3_Click()Label1.BackColor = vbBlack 'при нажатии на кнопку 3 цвет фона метки будет черным End Sub Private Sub Command4_Click()Form1.BackColor = vbWhite 'при нажатии на кнопку 4 цвет фона формы будет белым End Sub Private Sub Form_Load()Label1.FontSize = 12 'при загрузке программы у метки будет размер равным 12 Label1.Caption = " Операции с текстом" 'при загрузке программы текст метки будет " Операции с текстом" Form1.Caption = " Формач" 'при загрузке программы текст формы будет " Формач" End SubС кнопками мы уже разобрались, а вот как сделать чтоб действие выполнялось сразу после загрузке формы, мы еще не знаем. А надо кликнуть 2 раза по форме, и появится такой код:
Private Sub Form_Load() End Sub
Visual Basic калькулятор
Теперь код:
Private Sub Command1_Click()Text1.Text = " " 'при нажатии на кнопку CE, у двух текстовых полей свойство Caption будет равным " ", а 3-его будет равным 0 Text2.Text = " " Text3.Text = " 0" End Sub Private Sub Command2_Click() 'при нажатии на кнопку *, 1 текстовое поле будет умножено на второе, и это будет равно 3-ему Text3.Text = Val(Text1.Text) * Val(Text2.Text) End Sub Private Sub Command3_Click() 'при нажатии на кнопку /, 1 текстовое поле будет разделенно на второе, и это будет равно 3-ему If Val(Text2.Text) < > 0 then Text3.Text = Val(Text1.Text) / Val(Text2.Text) Else Text3.text= " Ошибка: На нуль делить нельзя" End Sub Private Sub Command4_Click() 'при нажатии на кнопку +, 1 текстовое поле будет прибавлено ко второму, и это будет равно 3-ему Text3.Text = Val(Text1.Text) + Val(Text2.Text) End Sub Private Sub Command5_Click() 'при нажатии на кнопку --, 1-ое текстовое поле будет отнято от второго, и это будет равно 3-ему Text3.Text = Val(Text1.Text) - Val(Text2.Text) End Sub Private Sub Form_Load()Form1.Caption = " Калькулятор 2003" 'при загрузке формы, ее заголовок будет " Калькулятор 2003" End Sub
Функции Vsual Basic
В этом шаге ты узнаешь несколько функций, которые тебе понадобятся на первых этапах программирования.
- VAL(строка) - Эта функция тебе уже знакома, как я уже и говорил она нужна для преобразования символа из " строки" в " число".
- Fix Это функция обрезает у дробного числа дробную часть, и получается целое число. Например, было число 12.123456, станет 12
- Rnd - Эта функция генерирует случайные числа. Например, в игре сапер, бомбы появляются каждый раз по разному, это благодаря этой функции.
Например:
Private Sub Command1_Click()Text1.Text = Rnd ' В текстовое поле выводится всегда разное число End SubЕсли ты был внимателен, то ты заметил, что при запуске программы, числа генерируются такие же как при предыдущем и следующем запуске. Чтобы этого избежать, в Form_Load помести слово Randomize.
Чтобы ограничить эту функцию надо записать так: Rnd * 5, и тогда здесь будут генерироваться числа от 0 до 5, но чтоб он не выдавал дробные числа, поставим функцию Fix: Fix(Rnd*5).Эта функция нам тоже пригодится для игры.
4-5. Asc(Строка) Эта функция нужна для перевода символов в код ASCII, а код аски нам очень пригодиться очень скоро, сейчас я поясню почему, а потому, что во всех языках программирования, код аски нужен для доступа к клаве, но об этом потом. А функция Chr(число) делает все наоборот, она переводит из аски в символы. И поскольку эти функции очень важны, я дам тебе
Задание:
Тебе надо сделать программу, которая переводила любой вписанный символ в код аски, и обратно. Для этого тебе понадобится два текстовых поля, 2 кнопки со свойством Caption равным: У первой Asc, у второй Chr. Да, чуть не забыл, если мы заговорили о текстовых полях, то я хотел бы тебе сказать, что для текстового поля есть одно свойство, оно нужно для ограничения вводимых символов, это свойство называется MaxLength(Его так назвал злой дядька Билл Гейц), так вот тебе надо выделить Текстовое поле, и в окне свойств найти свойство MaxLength, по умолчанию стоит 0, но вместо него можно ввести любое число, и это число будет устанавливать ограничения вводимых символов (т.е. если ты введешь 3, то в текстовое поле нельзя будет ввести больше 3 символов). После того, как ты сделаешь эту программу, тебе надо ее отложить подальше, до лучших времен(когда будем работать с клавиатурой, она нам очень пригодится).
Исходник программы можешь скачать отсюда
6. Unload Объект - Эта функция нужна для выхода. Например, чтобы выйти из программы надо написать Unload Me, или Unload Form1(также можно написать End)
7. MsgBox - Эта функция нужна для создания сообщений(ну.. знаешь.. 98 виндовс постоянно ругается, это почти тоже самое). Короче посмотри ниже, и ты все поймешь:
Теперь я тебе немного расскажу, как надо делать такие сообщения. Посмотри на код, и сам поймешь.
MsgBox " Любой текст", ЧитКод1+ЧитКод2, " Заголовок"Где любой текст - это наверное понятно (у меня: " Вот эта ошибка...")
Читкод1+ЧитКод2 - это значение, посмотри ниже в таблице (у меня 20, 16+4)
Заголовок - думаю тоже понятно (у меня: " И не забудь....")
Теперь Примеры, только примеры:
MsgBox " Здоровеньки булы", 53, " < =Здесь я вписал 53, т. к. 48 + 5 = 53"Ну что понял (а)? Отлично! А как обращаться к кнопкам, которые находятся в сообщении(Да - Нет, ОК - Отмена...), я расскажу потом.
8. InputBox Я опять сразу объяснять не буду, а покажу как это выглядит, чтоб ты был (а) в курсе дела.
Код:
Dim str As String 'Объявляем переменную str, как строковую Private Sub Form_Load() 'При загрузке формы: str = InputBox(" Как тебя зовут", " Опрос", " Падре") 'Будет появляться опрос: Text1.Text = str 'Текстовое поле будет равно тому значению, которое ты введешь (у нас Падре): End Sub
Операторы Visual Basic
|
|