Часть 1/Часть 2/Часть 3/Часть 4/Часть 5/Часть 6/Часть 7/Часть 8/ Часть 9/Часть 10/Часть 11/Часть 12/Часть 13/Часть 14/Часть 15
У Билл Гейца, когда он делал Винд, не хватило ума сделать круглые
формы, а юзерам всего мира надоели квадратные окна, и они требуют круглые формы,
и мы, программеры всего мира, должны удовлетворять потребности юзеров, т.к. все
свои проги, мы делаем для них(ну и для ламеров вирусы...). И вот мы сейчас, с
помощью спец. АПИ функции это исправим, для начала сделаем круглое окно, а потом
ты сам будешь делать другие окна. Войди в 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 назад, я сделал Календарь, и там кстати эта АПИ
тоже используется. Исходник проги(календарь) можешь скачать с vbstreets.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
'При наведении курсора на Иконку, выдвинется
текст: "И не забудь зайти на VBStreets.Narod.RU":
nid.szTip = "И не
забудь зайти на VBStreets.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
года
Место под Банеры |
![]() |