VB语言
2009年11月07日
浏览器
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
Label2.ForeColor = vbBlack
End Sub
Private Sub Label2_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
Label2.ForeColor = vbRed
End Sub
Private Sub Label2_Click()
Shell "explorer http://www.finallylly.ys168.com"
End Sub
Private Sub Timer1_Timer()
If Label2.ForeColor = vbRed Then
Label2.ForeColor = vbBlack
End If
End Sub
Private Sub Form_Load()
Combo1.Top = Label1.Height
Combo1.Left = 0
WebBrowser1.Top = Combo1.Top + Combo1.Height
WebBrowser1.Left = 0
Form_Resize
StatusBar1.Style = sbrSimple
ProgressBar1.ZOrder
End Sub
Private Sub Form_Resize()
On Error GoTo a
Combo1.Width = Form1.Width - 100
WebBrowser1.Width = Combo1.Width
WebBrowser1.Height = Form1.Height - Combo1.Height - 1000
ProgressBar1.Top = Me.Height - StatusBar1.Height - 330
ProgressBar1.Left = 0.25 * StatusBar1.Width
ProgressBar1.Width = 0.75 * Me.Width - 250
a:
End Sub
Private Sub Combo1_Click()
WebBrowser1.Navigate Combo1.Text
End Sub
Private Sub Combo1_KeyDown(KeyCode As Integer, Shift As Integer)
Dim I As Long
Dim existed As Boolean
If KeyCode = 13 Then
WebBrowser1.Navigate Combo1.Text
For I = 0 To Combo1.ListCount - 1
If Combo1.List(I) = Combo1.Text Then
existed = True
Exit For
Else
existed = False
End If
Next
If Not existed Then
Combo1.AddItem (Combo1.Text)
End If
End If
End Sub
Private Sub WebBrowser1_TitleChange(ByVal Text As String)
Combo1.Text = WebBrowser1.LocationURL
End Sub
----------------------------------------------------------------------------------------------
播放器
Private Sub Command1_Click()
WindowsMediaPlayer1.URL = ""
End Sub
Private Sub Command2_Click()
WindowsMediaPlayer1.URL = Text1.Text
End Sub
Private Sub Command3_Click()
Dim Path As String
Path = Environ("SystemRoot") '路径
Call Shell(Path & "\system32\notepad.exe C:\Documents and Settings\Administrator\桌面\1.txt") 'fd
End Sub
Private Sub fileopen_Click()
Dim Mediafile As String
CommonDialog1.ShowOpen
Mediafile = CommonDialog1.FileName
MediaPlayer1.FileName = Mediafile
MediaPlayer1.displaysize = mpdefaultsize
Form2.Height = MediaPlayer1.Height + 800
Form2.Width = MediaPlayer1.Width + 120
End Sub
Private Sub F_Load()
MediaPlayer1.Move 0, 0
MediaPlayer1.Width = Form2.ScaleWidth
MediaPlayer1.Height = Form2.ScaleHeight
CommonDialog1.Filter = "影像资料(*.avl;*.mpg)|*.avi;*mpg"
End Sub
Private Sub WindowsMediaPlayer1_OpenStateChange(ByVal NewState As Long)
End Sub
Private Sub 点击访问作者网站_Click()
MsgBox "网站:finallybad@163.com欢迎访问"
End Sub
Private Sub double_Click()
MediaPlayer1.displaysize = mpdoublesize
Form2.Width = MediaPlayer1.Width + 120
Form2.Height = MediaPlayer1.Height + 800
End Sub
Private Sub fileexit_Click()
End
End Sub
Private Sub normal_Click()
MediaPlayer1.displaysize = mpdefaultsize
Form2.Width = MediaPlayer1.Width + 120
Form2.Height = MediaPlayer1.Height + 800
End Sub
透明窗口
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hWnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
Private Const WS_EX_LAYERED = &H80000
Private Const GWL_EXSTYLE = (-20)
Private Const LWA_ALPHA = &H2
Private Const LWA_COLORKEY = &H1
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 SWP_NOMOVE = &H2
Private Const SWP_NosIZE = &H1
Private Sub Form_Load()
Me.BackColor = RGB(88, 88, 88)
SetWindowPos Me.hWnd, HWND_TOPMosT, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NosIZE
Dim rtn As Long
BorderStyler = 0
rtn = GetWindowLong(hWnd, GWL_EXSTYLE)
rtn = rtn Or WS_EX_LAYERED
SetWindowLong hWnd, GWL_EXSTYLE, rtn
SetLayeredWindowAttributes hWnd, RGB(88, 88, 88), 0, LWA_COLORKEY
End Sub
2009年11月07日
浏览器
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
Label2.ForeColor = vbBlack
End Sub
Private Sub Label2_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
Label2.ForeColor = vbRed
End Sub
Private Sub Label2_Click()
Shell "explorer http://www.finallylly.ys168.com"
End Sub
Private Sub Timer1_Timer()
If Label2.ForeColor = vbRed Then
Label2.ForeColor = vbBlack
End If
End Sub
Private Sub Form_Load()
Combo1.Top = Label1.Height
Combo1.Left = 0
WebBrowser1.Top = Combo1.Top + Combo1.Height
WebBrowser1.Left = 0
Form_Resize
StatusBar1.Style = sbrSimple
ProgressBar1.ZOrder
End Sub
Private Sub Form_Resize()
On Error GoTo a
Combo1.Width = Form1.Width - 100
WebBrowser1.Width = Combo1.Width
WebBrowser1.Height = Form1.Height - Combo1.Height - 1000
ProgressBar1.Top = Me.Height - StatusBar1.Height - 330
ProgressBar1.Left = 0.25 * StatusBar1.Width
ProgressBar1.Width = 0.75 * Me.Width - 250
a:
End Sub
Private Sub Combo1_Click()
WebBrowser1.Navigate Combo1.Text
End Sub
Private Sub Combo1_KeyDown(KeyCode As Integer, Shift As Integer)
Dim I As Long
Dim existed As Boolean
If KeyCode = 13 Then
WebBrowser1.Navigate Combo1.Text
For I = 0 To Combo1.ListCount - 1
If Combo1.List(I) = Combo1.Text Then
existed = True
Exit For
Else
existed = False
End If
Next
If Not existed Then
Combo1.AddItem (Combo1.Text)
End If
End If
End Sub
Private Sub WebBrowser1_TitleChange(ByVal Text As String)
Combo1.Text = WebBrowser1.LocationURL
End Sub
----------------------------------------------------------------------------------------------
播放器
Private Sub Command1_Click()
WindowsMediaPlayer1.URL = ""
End Sub
Private Sub Command2_Click()
WindowsMediaPlayer1.URL = Text1.Text
End Sub
Private Sub Command3_Click()
Dim Path As String
Path = Environ("SystemRoot") '路径
Call Shell(Path & "\system32\notepad.exe C:\Documents and Settings\Administrator\桌面\1.txt") 'fd
End Sub
Private Sub fileopen_Click()
Dim Mediafile As String
CommonDialog1.ShowOpen
Mediafile = CommonDialog1.FileName
MediaPlayer1.FileName = Mediafile
MediaPlayer1.displaysize = mpdefaultsize
Form2.Height = MediaPlayer1.Height + 800
Form2.Width = MediaPlayer1.Width + 120
End Sub
Private Sub F_Load()
MediaPlayer1.Move 0, 0
MediaPlayer1.Width = Form2.ScaleWidth
MediaPlayer1.Height = Form2.ScaleHeight
CommonDialog1.Filter = "影像资料(*.avl;*.mpg)|*.avi;*mpg"
End Sub
Private Sub WindowsMediaPlayer1_OpenStateChange(ByVal NewState As Long)
End Sub
Private Sub 点击访问作者网站_Click()
MsgBox "网站:finallybad@163.com欢迎访问"
End Sub
Private Sub double_Click()
MediaPlayer1.displaysize = mpdoublesize
Form2.Width = MediaPlayer1.Width + 120
Form2.Height = MediaPlayer1.Height + 800
End Sub
Private Sub fileexit_Click()
End
End Sub
Private Sub normal_Click()
MediaPlayer1.displaysize = mpdefaultsize
Form2.Width = MediaPlayer1.Width + 120
Form2.Height = MediaPlayer1.Height + 800
End Sub
透明窗口
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hWnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
Private Const WS_EX_LAYERED = &H80000
Private Const GWL_EXSTYLE = (-20)
Private Const LWA_ALPHA = &H2
Private Const LWA_COLORKEY = &H1
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 SWP_NOMOVE = &H2
Private Const SWP_NosIZE = &H1
Private Sub Form_Load()
Me.BackColor = RGB(88, 88, 88)
SetWindowPos Me.hWnd, HWND_TOPMosT, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NosIZE
Dim rtn As Long
BorderStyler = 0
rtn = GetWindowLong(hWnd, GWL_EXSTYLE)
rtn = rtn Or WS_EX_LAYERED
SetWindowLong hWnd, GWL_EXSTYLE, rtn
SetLayeredWindowAttributes hWnd, RGB(88, 88, 88), 0, LWA_COLORKEY
End Sub