vb制作的屏保系統(tǒng)，由多張圖片循環(huán)播放，如何在圖片播放時加上一定的特效，比如百葉窗等等，就像PPT制作的

'這個拿去試一試,兩個時鐘,兩個圖片框,自己設(shè)定圖片框2的大小,比如讓它和窗體一樣大

專注于為中小企業(yè)提供成都網(wǎng)站制作、網(wǎng)站建設(shè)服務(wù),電腦端+手機(jī)端+微信端的三站合一,更高效的管理,為中小企業(yè)寧明免費做網(wǎng)站提供優(yōu)質(zhì)的服務(wù)。我們立足成都，凝聚了一批互聯(lián)網(wǎng)行業(yè)人才，有力地推動了上千家企業(yè)的穩(wěn)健成長，幫助中小企業(yè)通過網(wǎng)站建設(shè)實現(xiàn)規(guī)模擴(kuò)充和轉(zhuǎn)變。

'查一查PaintPicture的用法,就明白了

'去掉Picture2

Dim Pic_num As Long

Dim Pic_name() As String

Dim pic_star As Long

Dim p_width As Single

Dim p_height As Single

Dim bili_w As Single

Dim bili_h As Single

Dim v_mod As Long

Private Sub Form_Load()

Dim L_name As String

Pic_num = 0

ReDim Pic_name(Pic_num)

L_name = Dir(App.Path "\pic\*.JPG")

Do While L_name ""

ReDim Preserve Pic_name(Pic_num)

Pic_name(Pic_num) = L_name

Pic_num = Pic_num + 1

L_name = Dir

Loop

L_name = Dir(App.Path "\pic\*.BMP")

Do While L_name ""

ReDim Preserve Pic_name(Pic_num)

Pic_name(Pic_num) = L_name

Pic_num = Pic_num + 1

L_name = Dir

Loop

Picture1.AutoSize = True

Picture1.AutoRedraw = True

Picture1.Visible = False

' Me.AutoSize = False

Me.AutoRedraw = True

Me.Visible = True

Timer1.Interval = 10

Timer1.Enabled = False

Timer2.Interval = 50

Timer2.Enabled = False

If Pic_num 0 Then

Picture1.Picture = LoadPicture(App.Path "\pic\" Pic_name(0))

Me.PaintPicture Picture1.Picture, 0, 0, Me.ScaleWidth, Me.ScaleHeight, 0, 0, Picture1.ScaleWidth, Picture1.ScaleHeight

Timer1.Enabled = True

Timer1.Interval = 2000

Else

MsgBox ("沒有圖片顯示！")

End If

End Sub

Private Sub Form_Resize()

Me.Width = Me.Width

Me.Height = Me.Width

Me.Top = 0

Me.Left = 0

End Sub

Private Sub Timer1_Timer()

Dim L_id As Long

Randomize

L_id = Int((Pic_num) * Rnd)

Picture1.Picture = LoadPicture(App.Path "\pic\" Pic_name(L_id))

bili_w = Picture1.ScaleWidth / Me.ScaleWidth

bili_h = Picture1.ScaleHeight / Me.ScaleHeight

p_width = Me.Width / 100

p_height = Me.Height / 100

pic_star = 0

Randomize

v_mod = Int(10 * Rnd)

'v_mod = 9'取消單引號并修改常數(shù)數(shù)可看單一效果

Timer1.Enabled = False

Timer2.Enabled = True

End Sub

Private Sub Timer2_Timer()

If pic_star 101 Then

pic_star = pic_star + 1

Select Case v_mod

Case 0

Me.PaintPicture Picture1.Picture, 0, 0, Me.Width, pic_star * p_height, 0, 0, Picture1.Width, bili_h * pic_star * p_height '從上向下

Case 1

Me.PaintPicture Picture1.Picture, 0, 0, pic_star * p_width, Me.Height, 0, 0, bili_w * pic_star * p_width, Picture1.Height '從左向右

Case 2

Me.PaintPicture Picture1.Picture, 0, 0, Me.Width, pic_star * p_height, 0, 0, Picture1.Width, Picture1.Height '壓縮的從上向下

Case 3

Me.PaintPicture Picture1.Picture, 0, 0, pic_star * p_width, Me.Height, 0, 0, Picture1.Width, Picture1.Height '壓縮的從左向右

Case 4

Me.PaintPicture Picture1.Picture, 0, 0, pic_star * p_width, pic_star * p_height, 0, 0, Picture1.Width, Picture1.Height '壓縮的從左上向右下

Case 5

Me.PaintPicture Picture1.Picture, Me.Width - pic_star * p_width, Me.Height - pic_star * p_height, pic_star * p_width, pic_star * p_height, 0, 0, Picture1.Width, Picture1.Height '壓縮的從右下向左上

Case 6

Me.PaintPicture Picture1.Picture, Me.Width / 2 - pic_star * p_width / 2, 0, pic_star * p_width / 2, Me.Height, 0, 0, Picture1.Width / 2, Picture1.Height '壓縮的從中向左

Me.PaintPicture Picture1.Picture, Me.Width / 2, 0, pic_star * p_width, Me.Height, Picture1.Width / 2, 0, Picture1.Width, Picture1.Height '壓縮的從中向右

Case 7

Me.PaintPicture Picture1.Picture, 0, Me.Height / 2 - pic_star * p_height / 2, Me.Width, pic_star * p_height / 2, 0, 0, Picture1.Width, Picture1.Height / 2 '壓縮的從中向上

Me.PaintPicture Picture1.Picture, 0, Me.Height / 2, Me.Width, pic_star * p_height, 0, Picture1.Height / 2, Picture1.Width, Picture1.Height '壓縮的從中向下

Case 8

Me.PaintPicture Picture1.Picture, Me.Width / 2 - pic_star * p_width / 2, Me.Height / 2 - pic_star * p_height / 2, pic_star * p_width / 2, pic_star * p_height / 2, 0, 0, Picture1.Width / 2, Picture1.Height / 2 '壓縮的從中向左上

Me.PaintPicture Picture1.Picture, Me.Width / 2, Me.Height / 2, pic_star * p_width, pic_star * p_height, Picture1.Width / 2, Picture1.Height / 2, Picture1.Width, Picture1.Height '壓縮的從中向右下

Me.PaintPicture Picture1.Picture, Me.Width / 2, Me.Height / 2 - pic_star * p_height / 2, pic_star * p_width / 2, pic_star * p_height / 2, Picture1.Width / 2, 0, Picture1.Width / 2, Picture1.Height / 2 '壓縮的從中向右上

Me.PaintPicture Picture1.Picture, Me.Width / 2 - pic_star * p_width / 2, Me.Height / 2, pic_star * p_width / 2, pic_star * p_height / 2, 0, Picture1.Height / 2, Picture1.Width / 2, Picture1.Height / 2 '壓縮的從中向左下

Case 9

For k = 0 To 9

Me.PaintPicture Picture1.Picture, 0, k * Me.Height / 10, Me.Width, 5 * pic_star * p_height / 10, 0, k * (Picture1.Height / 10), Picture1.Width, (Picture1.Height / 10) '水平百葉窗

Next

If pic_star = 21 Then

pic_star = 101

End If

End Select

Else

pic_star = 0

Timer1.Enabled = True

Me.PaintPicture Picture1.Picture, 0, 0, Me.ScaleWidth, Me.ScaleHeight, 0, 0, Picture1.ScaleWidth, Picture1.ScaleHeight

Timer2.Enabled = False

End If

End Sub

'這回做了9個,應(yīng)該明白了吧,其實你第一回的5分也應(yīng)該給選我,估計是你沒明白用法

用vb.net如何編寫圖片瀏覽器的基本步驟功能是：圖片的打開、顯示、縮放、旋轉(zhuǎn)。

窗體上放一個PictureBox，兩個CommandButton，一個FileListBox

Private Sub Command1_Click()

If File1.ListIndex = 0 Then

ShowPic File1.ListCount - 1

Else

ShowPic File1.ListIndex - 1

End If

End Sub

Private Sub Command2_Click()

If File1.ListIndex = File1.ListCount - 1 Then

ShowPic 0

Else

ShowPic File1.ListIndex + 1

End If

End Sub

Private Sub Form_Load()

File1.Visible = False

File1.Pattern = "*.jpg;*.gif" '可以瀏覽的文件類型，使用分號隔開

File1.Path = App.Path '改成你需要瀏覽的目錄，比如"C:\Pic"

If File1.ListCount 1 Then '目錄中圖片在兩張以上可以瀏覽

ShowPic 0

Exit Sub

ElseIf File1.ListCount = 1 Then '目錄中只有一張圖片時只顯示這一張

ShowPic 0

End If

Command1.Enabled = False

Command2.Enabled = False

End Sub

Private Sub ShowPic(Index As Long)

File1.ListIndex = Index

Picture1.Picture = LoadPicture(File1.Path "\" File1.List(Index))

End Sub

如果對您有幫助，請記得采納為滿意答案，謝謝！祝您生活愉快！

vaela

簡單的播放器用vb.net怎么做啊

右擊工具箱/部件/WindowsMediaPlayer

//類模塊Mmedia

Option Explicit

'-----------------------------------------------------

' Name : MMedia.cls

' Author : Peter Wright, For BG2VB4 BG2VB5

'

' Notes : A multimedia class, which when turned

' : into an object lets you load and play

' : multimedia files, such as sound and

' : video.

'-----------------------------------------------------

' -=-=-=- PROPERTIES -=-=-=-

' Filename Determines the name of the current file

' Length The length of the file (Read Only)

' Position The current position through the file

' Status The current status of the object (Read Only)

' Wait True/False...tells VB to wait until play done

' -=-=-=- METHODS -=-=-=-=-

' mmOpen Filename Opens the requested filename

' mmClose Closes the current file

' mmPause Pauses playback of the current file

' mmStop Stops playback ready for closedown

' mmSeek Position Seeks to a position in the file

' mmPlay Plays the open file

'-------------------------------------------------------------

' NOTES

' -----

'

' Open a file, then play it. Pause it in response to a request

' from the user. Stop if you intend to seek to the start and

' play again. Close when you no longer want to play the file

'--------------------------------------------------------------

Private sAlias As String ' Used internally to give an alias name to

' the multimedia resource

Private sFilename As String ' Holds the filename internally

Private nLength As Single ' Holds the length of the filename

' internally

Private nPosition As Single ' Holds the current position internally

Private sStatus As String ' Holds the current status as a string

Private bWait As Boolean ' Determines if VB should wait until play

' is complete before returning.

'------------ API DECLARATIONS -------------

'note that this is all one code line:

Private Declare Function mciSendString Lib "winmm.dll" _

Alias "mciSendStringA" (ByVal lpstrCommand As String, _

ByVal lpstrReturnString As String, ByVal uReturnLength As Long, _

ByVal hwndCallback As Long) As Long

Public Sub mmOpen(ByVal sTheFile As String)

' Declare a variable to hold the value returned by mciSendString

Dim nReturn As Long

' Declare a string variable to hold the file type

Dim sType As String

' Opens the specified multimedia file, and closes any

' other that may be open

If sAlias "" Then

mmClose

End If

' Determine the type of file from the file extension

Select Case UCase$(Right$(sTheFile, 3))

Case "WAV"

sType = "Waveaudio"

Case "AVI"

sType = "AviVideo"

Case "MID"

sType = "Sequencer"

Case Else

' If the file extension is not known then exit the subroutine

Exit Sub

End Select

sAlias = Right$(sTheFile, 3) Minute(Now)

' At this point there is no file open, and we have determined the

' file type. Now would be a good time to open the new file.

' Note: if the name contains a space we have to enclose it in quotes

If InStr(sTheFile, " ") Then sTheFile = Chr(34) sTheFile Chr(34)

nReturn = mciSendString("Open " sTheFile " ALIAS " sAlias _

" TYPE " sType " wait", "", 0, 0)

End Sub

Public Sub mmClose()

' Closes the currently opened multimedia file

' Declare a variable to hold the return value from the mciSendString

' command

Dim nReturn As Long

' If there is no file currently open then exit the subroutine

If sAlias = "" Then Exit Sub

nReturn = mciSendString("Close " sAlias, "", 0, 0)

sAlias = ""

sFilename = ""

End Sub

Public Sub mmPause()

' Pause playback of the file

' Declare a variable to hold the return value from the mciSendString

' command

Dim nReturn As Long

' If there is no file currently open then exit the subroutine

If sAlias = "" Then Exit Sub

nReturn = mciSendString("Pause " sAlias, "", 0, 0)

End Sub

Public Sub mmPlay()

' Plays the currently open file, from the current position

' Declare a variable to hold the return value from the mciSendString

' command

Dim nReturn As Long

' If there is no file currently open, then exit the routine

If sAlias = "" Then Exit Sub

' Now play the file

If bWait Then

nReturn = mciSendString("Play " sAlias " wait", "", 0, 0)

Else

nReturn = mciSendString("Play " sAlias, "", 0, 0)

End If

End Sub

Public Sub mmStop()

' Stop using a file totally, be it playing or whatever

' Declare a variable to hold the return value from mciSendString

Dim nReturn As Long

' If there is no file currently open then exit the subroutine

If sAlias = "" Then Exit Sub

nReturn = mciSendString("Stop " sAlias, "", 0, 0)

End Sub

Public Sub mmSeek(ByVal nPosition As Single)

' Seeks to a specific position within the file

' Declare a variable to hold the return value from the mciSendString

' function

Dim nReturn As Long

nReturn = mciSendString("Seek " sAlias " to " nPosition, "", 0, 0)

End Sub

Property Get Filename() As String

' Routine to return a value when the programmer asks the

' object for the value of its Filename property

Filename = sFilename

End Property

Property Let Filename(ByVal sTheFile As String)

' Routine to set the value of the filename property, should the programmer

' wish to do so. This implies that the programmer actually wants to open

' a file as well so control is passed to the mmOpen routine

mmOpen sTheFile

End Property

Property Get Wait() As Boolean

' Routine to return the value of the object's wait property.

Wait = bWait

End Property

Property Let Wait(bWaitValue As Boolean)

' Routine to set the value of the object's wait property

bWait = bWaitValue

End Property

Property Get Length() As Single

' Routine to return the length of the currently opened multimedia file

' Declare a variable to hold the return value from the mciSendString

Dim nReturn As Long, nLength As Integer

' Declare a string to hold the returned length from the mci Status call

Dim sLength As String * 255

' If there is no file open then return 0

If sAlias = "" Then

Length = 0

Exit Property

End If

nReturn = mciSendString("Status " sAlias " length", sLength, 255, 0)

nLength = InStr(sLength, Chr$(0))

Length = Val(Left$(sLength, nLength - 1))

End Property

Property Let Position(ByVal nPosition As Single)

' Sets the Position property effectively by seeking

mmSeek nPosition

End Property

Property Get Position() As Single

' Returns the current position in the file

' Declare a variable to hold the return value from mciSendString

Dim nReturn As Integer, nLength As Integer

' Declare a variable to hold the position returned

' by the mci Status position command

Dim sPosition As String * 255

' If there is no file currently opened then exit the subroutine

If sAlias = "" Then Exit Property

' Get the position and return

nReturn = mciSendString("Status " sAlias " position", sPosition, 255, 0)

nLength = InStr(sPosition, Chr$(0))

Position = Val(Left$(sPosition, nLength - 1))

End Property

Property Get Status() As String

' Returns the playback/record status of the current file

' Declare a variable to hold the return value from mciSendString

Dim nReturn As Integer, nLength As Integer

' Declare a variable to hold the return string from mciSendString

Dim sStatus As String * 255

' If there is no file currently opened, then exit the subroutine

If sAlias = "" Then Exit Property

nReturn = mciSendString("Status " sAlias " mode", sStatus, 255, 0)

nLength = InStr(sStatus, Chr$(0))

Status = Left$(sStatus, nLength - 1)

End Property

//窗體fm

Dim m As New Mmedia

Dim fn

Private Sub Command1_Click()

On Error GoTo r

dlg.ShowOpen

fn = dlg.Filename

m.mmOpen fn

r:

If Err Then MsgBox Err.Description

End Sub

Private Sub Command2_Click()

On Error GoTo rp

m.mmPlay

rp:

If Err Then MsgBox Err.Description

End Sub

Private Sub Command3_Click()

On Error GoTo rap

m.mmPause

rap:

If Err Then MsgBox Err.Description

End Sub

Private Sub Command4_Click()

On Error GoTo racp

m.mmStop

racp:

If Err Then MsgBox Err.Description

End Sub

網(wǎng)站欄目：vb.net制作圖文播放 vbnet tooltip
本文鏈接：http://jinyejixie.com/article24/dosjdce.html

成都網(wǎng)站建設(shè)公司_創(chuàng)新互聯(lián)，為您提供靜態(tài)網(wǎng)站、面包屑導(dǎo)航、動態(tài)網(wǎng)站、App開發(fā)、網(wǎng)站改版、品牌網(wǎng)站制作

廣告

聲明：本網(wǎng)站發(fā)布的內(nèi)容（圖片、視頻和文字）以用戶投稿、用戶轉(zhuǎn)載內(nèi)容為主，如果涉及侵權(quán)請盡快告知，我們將會在第一時間刪除。文章觀點不代表本網(wǎng)站立場，如需處理請聯(lián)系客服。電話：028-86922220；郵箱：631063699@qq.com。內(nèi)容未經(jīng)允許不得轉(zhuǎn)載，或轉(zhuǎn)載時需注明來源： 創(chuàng)新互聯(lián)