VB语言

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 "网站：[e-mail]欢迎访问"
　　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