Часть 1/Часть 2/Часть 3/Часть 4/Часть 5/Часть 6/Часть 7/Часть 8/ Часть 9/Часть 10/Часть 11/Часть 12/Часть 13/Часть 14/Часть 15/Часть 16 /Часть 17 /Часть 18
У Билл Гейца, когда он делал Винд, не хватило ума сделать круглые формы, а юзерам всего мира надоели квадратные окна, и они требуют круглые формы, и мы, программеры всего мира, должны удовлетворять потребности юзеров, т.к. все свои программы, мы делаем для них(ну и для ламеров вирусы...). И вот мы сейчас, с помощью спец. АПИ функции это исправим, для начала сделаем круглое окно, а потом ты сам будешь делать другие окна. Войди в VB, и впиши код:
'Декларируем АПИ:
Private Declare Function CreateEllipticRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
Private Sub Form_Load() 'При запуске формы, делаем ее круглой:
SetWindowRgn hWnd, CreateEllipticRgn(80, 0, 300, 200), True 'Цифры в скобках означают что - то типо координат, например, изменив первую цифру(80), окно сузится, или расширится
End Sub
Теперь форма круглая! НО помойму, выглядит она не эффектно, и продвинутому юзеру может не понравиться(а простой юзер целыми днями будет на неё любоваться:-))), попробуй немного изменить координаты, короче в Form_Load впиши:
SetWindowRgn hWnd, CreateEllipticRgn(0, 0, 600, 450), True
Ну как? Помойму продвинутому юзеру понравиться! Поэкспериментируй с координатами, и мож у тебя получится супер окно.
Исходник -
Здесь
Окно с плавным переходом цвета очень эффектная штука, и она украшает наши программы. Для начало зальем форму с верху вниз, этот эффект очень часто используют в программах типо Setup. У свойство AutoRedraw надо установить равным True(это чтоб при расширении окна эффект оставался). Код:
Private Sub Form_Resize() 'Событие Resize нужно для того, чтоб при изменении размера формы, выполнялось какое - то действие
Dim X As Integer 'Объявляем переменную - счётчик
For X = 0 To Height 'Запускаем цикл, который повторяться столько раз какой высотой форма
Line (0, X)-(Width, X), X / (Height / 255) ''рисуем линию от верха и до самого низа формы цвет линии постоянно меняется
Next
End Sub
При использовании такого эффекта форма будет медленнее грузиться.
Исходник -
Здесь
Здесь смысл такой же, так что я не буду по два раза объяснять, вот код:(и не забудь AutoRedraw = True)
Private Sub Form_Resize()
For X = 0 To Width
Line (X, 0)-(X, Height), X / (Width / 255)
Next
End Sub
Здесь
Этот способ намного эффективнеe - заливается быстрее. Цвет – синий. Код:
Private Sub Form_load()
AutoRedraw = False
End Sub
Private Sub Form_Paint()
'Объявление переменных
Dim lY As Long
Dim lScaleHeight As Long
Dim lScaleWidth As Long
ScaleMode = vbPixels 'Единицу измерения устанавливаем равной пикселу
lScaleHeight = ScaleHeight 'Получаем кол-во пикселов по высоте
lScaleWidth = ScaleWidth 'Получаем кол-во пикселов по ширине
DrawStyle = vbInvisible 'Устанавливаем стиль заливки и рисования
FillStyle = vbFSSolid
For lY = 0 To lScaleHeight 'Запускаем цикл закраски
'Закрашиваем
FillColor = RGB(0, 0, 255 - (lY * 255) \ lScaleHeight)
Line (-1, lY - 1)-(lScaleWidth, lY + 1), , B
Next lY
End Sub
Здесь Исходник
В предыдущих шагах мы украшали форму, и в этом шаге я решил продолжить эту тему. В этом шаге ты научишься модно выходить из программы. Войди в VB(Standart EXE) и впиши код:
Private Sub Form_Unload(Cancel As Integer) 'При выходе из программы:
Form1.WindowState = 1 'При выходе делается эффект сворачивания, если вместо 1 поставить 2 - то будет эффект разворачивания, а если 0 - то что - то типо мерцания.
End Sub
Для создания такого окна используется функция API SetWindowPos из библиотеки user32.dll.
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long,
ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Const HWND_TOPMOST = -1
Private Const HWND_NOTOPMOST = -2
Private Const SWP_NOMOVE = &H2
Private Const SWP_NOSIZE = &H1
Private Const SWP_NOACTIVATE = &H10
Private Const SWP_SHOWWINDOW = &H40
Private Const FLAGS = SWP_NOMOVE Or SWP_NOSIZE
Private Sub Form_Load()
Call SetWindowPos(Me.hwnd, HWND_TOPMOST, 0, 0, 0, 0, FLAGS)
End Sub
Для заливки окна на форму запульни объект Image, и в Поинте нарисуй квадрат, если из тебя художник ни какой, то скачай исходник, и от туда возьми мой квадрат. Теперь впиши код:
Private Sub Form_Load() 'Ставим Image в самое начало формы:
Image1.Left = 0
Image1.Top = 0
End Sub
Private Sub Form_Paint() 'Это событие помойму тоже самое что и Resize
'Объявляем переменные
Dim X As Integer, Y As Integer
Dim ImgW As Integer
Dim ImgH As Integer
Dim FrmW As Integer
Dim FrmH As Integer
'Использование Image1 в PaintPicture methods:
ImgW = Image1.Width
ImgH = Image1.Height
FrmW = Form1.Width
FrmH = Form1.Height
'Залить целую форму:
For X = 0 To FrmW Step ImgW
For Y = 0 To FrmH Step ImgH
PaintPicture Image1, X, Y
Next Y
Next X
End Sub
Здесь Исходник
Иногда надо сделать такую программу, чтоб ее можно было перетащить за любое место, например, месяца 3 назад, я сделал Календарь, и там кстати эта АПИ тоже используется. Исходник программы(календарь) можешь скачать с padre.narod.ru, и если ты туда зайдешь, не поленись, нажми на сиреневый банер Porta, и мне немного бабла отвалятся(2 цента), хоть это мало, но мне хватит(если ты хочешь поддержать отечественного производителя(т.е. Меня), то кликай по банеру 1 раз в месяц). Ну что - то я заговорился, войди в VB, и впиши код:
Const WM_NCLBUTTONDOWN = &HA1
Const HTCAPTION = 2
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function ReleaseCapture Lib "user32" () As Long
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Call ReleaseCapture
Call SendMessage(Me.hWnd, WM_NCLBUTTONDOWN, HTCAPTION, 0&)
End Sub
Здесь Исходник
TrayBar находиться около часиков, с другой стороны от Пуска(короче как говорят БоТанЫ на ПАНЕЛИ ИНДЕКАЦИИ), вот оно:
. Ну что впечатляет? Естественно!!! И теперь наша миссия добавить туда свою ИКОНКУ. Ведь дохрена программ, которые туда так и наровятся закинуть свою иконку, и теперь наша очередь! Открой VB, на форму кинь 3 кнопки(У Первой Caption="Добавить", у 2 - ой = "Изменить", у 3 - ей = "Удалить"), и создай МоДулЬ. Теперь впиши в нем(В МоДулЕ) код:
Public Declare Function Shell_NotifyIcon Lib "shell32" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, pnid As NOTIFYICONDATA) As Boolean
'Константы для добавления, удаления и модификации вашей икноки:
Public Const NIM_ADD = 0
Public Const NIM_MODIFY = 1
Public Const NIM_DELETE = 2
'Константы ответственные за события происходящие внутри границ иконки, расположенной в Traybar:
Public Const WM_MOUSEMOVE = &H200
Public Const NIF_MESSAGE = 1
Public Const NIF_ICON = 2
Public Const NIF_TIP = 4
'Константы ответственные за события поведения мышки происходящие внутри границ иконки,
' расположенной в Traybar:
':
Public Const WM_LBUTTONDOWN = &H201
Public Const WM_LBUTTONUP = &H202
Public Const WM_LBUTTONDBLCLK = &H203
'Для правой клавиши мышки:
Public Const WM_RBUTTONDOWN = &H204
Public Const WM_RBUTTONUP = &H205
Public Const WM_RBUTTONDBLCLK = &H206
'Для средней клавиши мышки:
Public Const WM_MBUTTONDOWN = &H207
Public Const WM_MBUTTONUP = &H208
Public Const WM_MBUTTONDBLCLK = &H209
'Объявляем переменную определяемую пользователем:
Type NOTIFYICONDATA
cbSize As Long
hWnd As Long
uID As Long
uFlags As Long
uCallbackMessage As Long
hIcon As Long
szTip As String * 64
End Type
Теперь переключись на форму, и в ней(ФОРМЕ) впиши код:
'На форме в разделе General объявляем переменную определенную как тип пользователя:
Dim nid As NOTIFYICONDATA
Private Sub Command1_Click()
' Добавить иконку формы в Traybar
nid.cbSize = Len(nid)
nid.hWnd = Form1.hWnd
nid.uID = vbNull
nid.uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
nid.uCallbackMessage = WM_MOUSEMOVE
nid.hIcon = Form1.Icon
'При наведении курсора на Иконку, выдвинется текст: "И не забудь зайти на http://padre.narod.ru/":
nid.szTip = "И не забудь зайти на http://padre.narod.ru/" & vbNullChar
Shell_NotifyIcon NIM_ADD, nid
End Sub
Private Sub Command2_Click()
nid.hIcon = Form1.Icon
nid.szTip = "New Icon" & vbNullChar
Shell_NotifyIcon NIM_MODIFY, nid
End Sub
Private Sub Command3_Click()
Shell_NotifyIcon NIM_DELETE, nid
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
'Объявляем переменные:
Dim msg As Long
Dim sFilter As String
msg = X / Screen.TwipsPerPixelX
Select Case msg
Case WM_LBUTTONDOWN
'Сюда ты можешь вставить код, который захочешь:
MsgBox "Нажата левая кнопка мыши(Нажата)"
Case WM_LBUTTONUP
'Сюда ты можешь вставить код, который захочешь:
MsgBox "Нажата левая кнопка мыши(Отжата)"
Case WM_LBUTTONDBLCLK
'Сюда ты можешь вставить код, который захочешь:
MsgBox "Ты кликнул 2 раза по ИКОНКЕ(Левой кнопкой)"
Case WM_RBUTTONDOWN
'Сюда ты можешь вставить код, который захочешь:
'Обычно это PopupMenu:
MsgBox "Нажата правая кнопка мыши(Нажата)"
Case WM_RBUTTONUP
'Сюда ты можешь вставить код, который захочешь:
MsgBox "Нажата левая кнопка мыши(Отжата)"
Case WM_RBUTTONDBLCLK
'Сюда ты можешь вставить код, который захочешь:
MsgBox "Ты кликнул 2 раза по ИКОНКЕ(Правой кнопкой)"
End Select
End Sub
Теперь добавь еще одну форму, и поменяй у нее иконку(свойство Icon), запусти программу, и нажми на кнопку Изменить, иконка должна измениться.
Здесь Исходник
Сделай программу, чтобы при ее запуске иконка помещалась в TrayBar, и при ее нажатии(иконки) левой кнопкой, выдвигалось PopupMenu.
автор учебника: Падре
Дата создания: 6 Мая 2003 года
Место под Банеры |
![]() |