Visual Basic vaprosche
3 отговора
107 прегледа
Re: Visual Basic vaprosche
Ti mai si pochitatel na METALLICA a :))??
Tova tekstche doly ne e li ot CREEPING DEATH ?? :)))))
Kakto i da e. Imam reshenie na tvoia problem, ama e fail i shte triabva da ti go pratia po e-maila - az sam go pisal - tova e VB User Control (source code). Mnogo lesen za izpolzvane. Ako go iskash pishi mi na [email protected] i az shte ti otgovoria, kato go prikacha kam saobshtenieto.
Ako ne ti se zanimava s men pogledni fynkciata Shell_NotifyIconA v shell32.dll
Ako pak ne ti se izprashta pismo eto ti sadarjanieto na faila (GGTrayIcon.ctl):
E - shte ti pokaje niakoia i dryga greshka, zashtoto niamash faila GGTrayIcon.ctx ama ne e fatalno. AAaa - i da me izvinish za komentarite - na sam mnogo dobar po angliski :))))
VERSION 5.00
Begin VB.UserControl GGTrayIcon
BackColor = &H8000000C&
ClientHeight = 330
ClientLeft = 0
ClientTop = 0
ClientWidth = 1530
InvisibleAtRuntime= -1 'True
Picture = "GGTrayIcon.ctx":0000
ScaleHeight = 22
ScaleMode = 3 'Pixel
ScaleWidth = 102
ToolboxBitmap = "GGTrayIcon.ctx":01DC
End
Attribute VB_Name = "GGTrayIcon"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
Private 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
Private Const NIM_ADD = &H0
Private Const NIM_DELETE = &H2
Private Const NIM_MODIFY = &H1
Private Const NIF_MESSAGE = &H1
Private Const NIF_ICON = &H2
Private Const NIF_TIP = &H4
Private Const NIF_DOALL = NIF_MESSAGE Or NIF_ICON Or NIF_TIP
Private Const WM_MOUSEMOVE = &H200
Private Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long
'Event Declarations:
Event MouseMove(Shift As Integer)
Event MouseLeftDown(Shift As Integer)
Event MouseLeftUp(Shift As Integer)
Event MouseLeftDblClick(Shift As Integer)
Event MouseRightDown(Shift As Integer)
Event MouseRightUp(Shift As Integer)
Event MouseRightDblClick(Shift As Integer)
'Default Property Values:
Const m_def_ToolTip = ""
'Property Variables:
Dim m_ToolTip As String
Public Sub AboutBox()
Attribute AboutBox.VB_UserMemId = -552
MsgBox "GGTrayIcon user control - Georgi Yordanov Ganchev - [email protected] - [линк]", vbInformation, "About GGTrayIcon user control..."
End Sub
Public Function ModifyTrayIcon(New_hIcon As Picture) As Long
ModifyTrayIcon = TrayIcon(New_hIcon, m_ToolTip, NIM_MODIFY)
End Function
Public Function PlaceTrayIcon(hIcon As Picture) As Long
PlaceTrayIcon = TrayIcon(hIcon, m_ToolTip, NIM_ADD)
End Function
Public Function DeleteTrayIcon() As Long
DeleteTrayIcon = TrayIcon(UserControl.Picture, "", NIM_DELETE)
End Function
Private Function TrayIcon(hIcon As Picture, strToolTip As String, lngNIMAction As Long) As Long
Dim typeNOTIFYICONDATA As NOTIFYICONDATA
'Set NOTIFYICONDATA structure size
typeNOTIFYICONDATA.cbSize = Len(typeNOTIFYICONDATA)
'Set icon
typeNOTIFYICONDATA.hIcon = hIcon
'Set window which will receive uCallbackMessage
typeNOTIFYICONDATA.hwnd = UserControl.hwnd
'Set null terminated tooltip
typeNOTIFYICONDATA.szTip = strToolTip & Chr$(0)
'Set message to receive, when mouse is over rectangle of tray icon
'Will receive MouseMove message
typeNOTIFYICONDATA.uCallbackMessage = WM_MOUSEMOVE
'Update icon, tooltip and message
typeNOTIFYICONDATA.uFlags = NIF_DOALL
'Set icon ID
'The ID may increase every time when PlaceTrayIcon is called
'But then is hard to determine which icon receives MouseMove message
'For that we will use only 1 icon for user control
'For multiply icons on tray make GGTrayIcon control array
typeNOTIFYICONDATA.uID = 1&
'Call API
TrayIcon = Shell_NotifyIcon(lngNIMAction, typeNOTIFYICONDATA)
End Function
Private Sub UserControl_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
Select Case x
Case 512
RaiseEvent MouseMove(Shift)
Case 513
RaiseEvent MouseLeftDown(Shift)
Case 514
RaiseEvent MouseLeftUp(Shift)
Case 515
RaiseEvent MouseLeftDblClick(Shift)
Case 516
RaiseEvent MouseRightDown(Shift)
Case 517
RaiseEvent MouseRightUp(Shift)
Case 518
RaiseEvent MouseRightDblClick(Shift)
End Select
End Sub
Private Sub UserControl_Resize()
UserControl.Size 1530, 330
End Sub
Private Sub UserControl_Terminate()
TrayIcon UserControl.Picture, "", NIM_DELETE
End Sub
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=13,0,0,
Public Property Get ToolTip() As String
ToolTip = m_ToolTip
End Property
Public Property Let ToolTip(ByVal New_ToolTip As String)
m_ToolTip = New_ToolTip
Dim typeNOTIFYICONDATA As NOTIFYICONDATA
'Set NOTIFYICONDATA structure size
typeNOTIFYICONDATA.cbSize = Len(typeNOTIFYICONDATA)
'Set icon
'typeNOTIFYICONDATA.hIcon = hIcon
'Set window which will receive uCallbackMessage
typeNOTIFYICONDATA.hwnd = UserControl.hwnd
'Set null terminated tooltip
typeNOTIFYICONDATA.szTip = m_ToolTip & Chr$(0)
'Set message to receive, when mouse is over rectangle of tray icon
'Will receive MouseMove message
typeNOTIFYICONDATA.uCallbackMessage = WM_MOUSEMOVE
'Update icon, tooltip and message
typeNOTIFYICONDATA.uFlags = NIF_TIP
'Set icon ID
'The ID may increase every time when PlaceTrayIcon is called
'But then is hard to determine which icon receives MouseMove message
'For that we will use only 1 icon for user control
'For multiply icons on tray make GGTrayIcon control array
typeNOTIFYICONDATA.uID = 1&
'Call API
Shell_NotifyIcon NIM_MODIFY, typeNOTIFYICONDATA
PropertyChanged "ToolTip"
End Property
'Initialize Properties for User Control
Private Sub UserControl_InitProperties()
m_ToolTip = m_def_ToolTip
End Sub
'Load property values from storage
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
m_ToolTip = PropBag.ReadProperty("ToolTip", m_def_ToolTip)
End Sub
'Write property values to storage
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
Call PropBag.WriteProperty("ToolTip", m_ToolTip, m_def_ToolTip)
End Sub
Tozi gornia tekst napravo go kopirash ot tyka, otvariash edin Notepad i go "paste" tam. Zapisvash faila kato GGTrayIcon.ctl i posle mojesh da si go dobavish v niakoi proekt. Shte ti se poiavi v "COMPONENTS PALETTE". Ot tam si go vzemash i si go slagash na formata. Pogledni my metodite i svoistvata (properties ama v koda, ne v prozoreca koito pokazva properties) i vednaga shte razberesh kak da go izpolzvash.
Tova tekstche doly ne e li ot CREEPING DEATH ?? :)))))
Kakto i da e. Imam reshenie na tvoia problem, ama e fail i shte triabva da ti go pratia po e-maila - az sam go pisal - tova e VB User Control (source code). Mnogo lesen za izpolzvane. Ako go iskash pishi mi na [email protected] i az shte ti otgovoria, kato go prikacha kam saobshtenieto.
Ako ne ti se zanimava s men pogledni fynkciata Shell_NotifyIconA v shell32.dll
Ako pak ne ti se izprashta pismo eto ti sadarjanieto na faila (GGTrayIcon.ctl):
E - shte ti pokaje niakoia i dryga greshka, zashtoto niamash faila GGTrayIcon.ctx ama ne e fatalno. AAaa - i da me izvinish za komentarite - na sam mnogo dobar po angliski :))))
VERSION 5.00
Begin VB.UserControl GGTrayIcon
BackColor = &H8000000C&
ClientHeight = 330
ClientLeft = 0
ClientTop = 0
ClientWidth = 1530
InvisibleAtRuntime= -1 'True
Picture = "GGTrayIcon.ctx":0000
ScaleHeight = 22
ScaleMode = 3 'Pixel
ScaleWidth = 102
ToolboxBitmap = "GGTrayIcon.ctx":01DC
End
Attribute VB_Name = "GGTrayIcon"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
Private 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
Private Const NIM_ADD = &H0
Private Const NIM_DELETE = &H2
Private Const NIM_MODIFY = &H1
Private Const NIF_MESSAGE = &H1
Private Const NIF_ICON = &H2
Private Const NIF_TIP = &H4
Private Const NIF_DOALL = NIF_MESSAGE Or NIF_ICON Or NIF_TIP
Private Const WM_MOUSEMOVE = &H200
Private Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long
'Event Declarations:
Event MouseMove(Shift As Integer)
Event MouseLeftDown(Shift As Integer)
Event MouseLeftUp(Shift As Integer)
Event MouseLeftDblClick(Shift As Integer)
Event MouseRightDown(Shift As Integer)
Event MouseRightUp(Shift As Integer)
Event MouseRightDblClick(Shift As Integer)
'Default Property Values:
Const m_def_ToolTip = ""
'Property Variables:
Dim m_ToolTip As String
Public Sub AboutBox()
Attribute AboutBox.VB_UserMemId = -552
MsgBox "GGTrayIcon user control - Georgi Yordanov Ganchev - [email protected] - [линк]", vbInformation, "About GGTrayIcon user control..."
End Sub
Public Function ModifyTrayIcon(New_hIcon As Picture) As Long
ModifyTrayIcon = TrayIcon(New_hIcon, m_ToolTip, NIM_MODIFY)
End Function
Public Function PlaceTrayIcon(hIcon As Picture) As Long
PlaceTrayIcon = TrayIcon(hIcon, m_ToolTip, NIM_ADD)
End Function
Public Function DeleteTrayIcon() As Long
DeleteTrayIcon = TrayIcon(UserControl.Picture, "", NIM_DELETE)
End Function
Private Function TrayIcon(hIcon As Picture, strToolTip As String, lngNIMAction As Long) As Long
Dim typeNOTIFYICONDATA As NOTIFYICONDATA
'Set NOTIFYICONDATA structure size
typeNOTIFYICONDATA.cbSize = Len(typeNOTIFYICONDATA)
'Set icon
typeNOTIFYICONDATA.hIcon = hIcon
'Set window which will receive uCallbackMessage
typeNOTIFYICONDATA.hwnd = UserControl.hwnd
'Set null terminated tooltip
typeNOTIFYICONDATA.szTip = strToolTip & Chr$(0)
'Set message to receive, when mouse is over rectangle of tray icon
'Will receive MouseMove message
typeNOTIFYICONDATA.uCallbackMessage = WM_MOUSEMOVE
'Update icon, tooltip and message
typeNOTIFYICONDATA.uFlags = NIF_DOALL
'Set icon ID
'The ID may increase every time when PlaceTrayIcon is called
'But then is hard to determine which icon receives MouseMove message
'For that we will use only 1 icon for user control
'For multiply icons on tray make GGTrayIcon control array
typeNOTIFYICONDATA.uID = 1&
'Call API
TrayIcon = Shell_NotifyIcon(lngNIMAction, typeNOTIFYICONDATA)
End Function
Private Sub UserControl_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
Select Case x
Case 512
RaiseEvent MouseMove(Shift)
Case 513
RaiseEvent MouseLeftDown(Shift)
Case 514
RaiseEvent MouseLeftUp(Shift)
Case 515
RaiseEvent MouseLeftDblClick(Shift)
Case 516
RaiseEvent MouseRightDown(Shift)
Case 517
RaiseEvent MouseRightUp(Shift)
Case 518
RaiseEvent MouseRightDblClick(Shift)
End Select
End Sub
Private Sub UserControl_Resize()
UserControl.Size 1530, 330
End Sub
Private Sub UserControl_Terminate()
TrayIcon UserControl.Picture, "", NIM_DELETE
End Sub
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=13,0,0,
Public Property Get ToolTip() As String
ToolTip = m_ToolTip
End Property
Public Property Let ToolTip(ByVal New_ToolTip As String)
m_ToolTip = New_ToolTip
Dim typeNOTIFYICONDATA As NOTIFYICONDATA
'Set NOTIFYICONDATA structure size
typeNOTIFYICONDATA.cbSize = Len(typeNOTIFYICONDATA)
'Set icon
'typeNOTIFYICONDATA.hIcon = hIcon
'Set window which will receive uCallbackMessage
typeNOTIFYICONDATA.hwnd = UserControl.hwnd
'Set null terminated tooltip
typeNOTIFYICONDATA.szTip = m_ToolTip & Chr$(0)
'Set message to receive, when mouse is over rectangle of tray icon
'Will receive MouseMove message
typeNOTIFYICONDATA.uCallbackMessage = WM_MOUSEMOVE
'Update icon, tooltip and message
typeNOTIFYICONDATA.uFlags = NIF_TIP
'Set icon ID
'The ID may increase every time when PlaceTrayIcon is called
'But then is hard to determine which icon receives MouseMove message
'For that we will use only 1 icon for user control
'For multiply icons on tray make GGTrayIcon control array
typeNOTIFYICONDATA.uID = 1&
'Call API
Shell_NotifyIcon NIM_MODIFY, typeNOTIFYICONDATA
PropertyChanged "ToolTip"
End Property
'Initialize Properties for User Control
Private Sub UserControl_InitProperties()
m_ToolTip = m_def_ToolTip
End Sub
'Load property values from storage
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
m_ToolTip = PropBag.ReadProperty("ToolTip", m_def_ToolTip)
End Sub
'Write property values to storage
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
Call PropBag.WriteProperty("ToolTip", m_ToolTip, m_def_ToolTip)
End Sub
Tozi gornia tekst napravo go kopirash ot tyka, otvariash edin Notepad i go "paste" tam. Zapisvash faila kato GGTrayIcon.ctl i posle mojesh da si go dobavish v niakoi proekt. Shte ti se poiavi v "COMPONENTS PALETTE". Ot tam si go vzemash i si go slagash na formata. Pogledni my metodite i svoistvata (properties ama v koda, ne v prozoreca koito pokazva properties) i vednaga shte razberesh kak da go izpolzvash.
10x man
Хах да:) Голям фен съм на Metallica:)
Mnoo ti blagodarq za sourca ama mnoo mnoo mnoo
Shte ti se revanshiram nqkoi pyt za neshto! obeshtaam:))))
End of passion play, crumbling away
I'm your source of self-destruction
Veins that pump with fear, sucking darkest clear
Leading on your deaths construction
Mnoo ti blagodarq za sourca ama mnoo mnoo mnoo
Shte ti se revanshiram nqkoi pyt za neshto! obeshtaam:))))
End of passion play, crumbling away
I'm your source of self-destruction
Veins that pump with fear, sucking darkest clear
Leading on your deaths construction
Re: 10x man
Xex - i az sam (biah de) goliam fen na METALLICA.
Sega sam samo goliam (na 27 godini) bez da sam fen Xexexe :))))))))))))))))))))))))
Ama sa mnogo iaki de - predi mojeh da napisha vsichki tekstove ot '83 '84 '86 i '88 na angliiski bez greshka, che i naizyst gi znaeh ama veche odartiah za tezi raboti i ne pomnia nishtichko :))))))))
Probva li source coda deto ti izpratih ? Imash li niakakvi problemi s nego ?
Ako ti triabva primerna programa, koiato izpolzva GGTrayIcon pishi mi na GogoX@Lycos.com da ti ia izpratia.
Умният обича да се учи.
Глупавият - да поучава.
Sega sam samo goliam (na 27 godini) bez da sam fen Xexexe :))))))))))))))))))))))))
Ama sa mnogo iaki de - predi mojeh da napisha vsichki tekstove ot '83 '84 '86 i '88 na angliiski bez greshka, che i naizyst gi znaeh ama veche odartiah za tezi raboti i ne pomnia nishtichko :))))))))
Probva li source coda deto ti izpratih ? Imash li niakakvi problemi s nego ?
Ako ti triabva primerna programa, koiato izpolzva GGTrayIcon pishi mi na GogoX@Lycos.com da ti ia izpratia.
Умният обича да се учи.
Глупавият - да поучава.