Oom... coba pake code ini...
File gambarnya akan diload secara acak/RANDOM (diharapkan ada lebih
dari 1 file gambar dalam lokasi folder gambarnya.
Note :
Image1 adalah IMAGE control...
A W A S !!! Akan terjadi error jika folder (PATH) tidak ada file
gambarnya, mohon dimodifikasi sendiri lagi (diberi "error trap" agar
lebih sipppppp :D)
SEMOGA BERHASIL !!!
Rgds,
Moel
------------
Option Explicit
Dim aPicFiles() As String
Dim nIndexPic As Long
Private Sub Form_Load()
RandomPic Image1, App.Path & "\IMAGE"
End Sub
Private Sub RandomPic(ImgControl As Image, ByVal sPath As String)
Randomize (Time)
nIndexPic = 1
ListFiles sPath
ImgControl.Stretch = True
ImgControl.Picture = LoadPicture(aPicFiles(Int(Rnd *
UBound(aPicFiles)) + 1))
End Sub
Private Sub ListFiles(ByVal sPath As String)
Dim sNames() As String, x As Long
Dim y As Integer
If Right(sPath, 1) <> "\" Then sPath = sPath & "\"
For y = 1 To 3
' Pilihan extentionnya... (jpg,gif,bmp dan lain-lain...)
sNames() = ScanFiles(sPath & "*." & Choose(y, "jpg", "gif",
"bmp"))
For x = 1 To UBound(sNames)
ReDim Preserve aPicFiles(nIndexPic) As String
aPicFiles(nIndexPic) = sPath & sNames(x)
nIndexPic = nIndexPic + 1
Next
Next
sNames() = ScanDirs(sPath, vbHidden)
For x = 1 To UBound(sNames)
ListFiles sPath & sNames(x)
Next
End Sub
Private Function ScanDirs(sPath As String, Optional fAttribute As _
VbFileAttribute, Optional
IncludePath As Boolean) As String()
Const ALLOC_CHUNK = 50
Dim sResult() As String
Dim sDirName As String, nCount As Long, sPath2 As String
ReDim sResult(ALLOC_CHUNK) As String
sPath2 = sPath
If Right$(sPath2, 1) <> "\" Then sPath2 = sPath2 & "\"
sDirName = Dir$(sPath2 & "*.*", vbDirectory Or fAttribute)
Do While Len(sDirName)
If sDirName = "." Or sDirName = ".." Then
' Exclude the "." and ".." entries.
ElseIf (GetAttr(sPath2 & sDirName) And vbDirectory) = 0 Then
' This is a regular file.
Else
' This is a directory.
nCount = nCount + 1
If nCount > UBound(sResult) Then
' Resize the result array if necessary.
ReDim Preserve sResult(nCount + ALLOC_CHUNK) As String
End If
' Include the path if requested.
If IncludePath Then sDirName = sPath2 & sDirName
sResult(nCount) = sDirName
End If
sDirName = Dir$
Loop
' Trim the result array.
ReDim Preserve sResult(nCount) As String
ScanDirs = sResult
End Function
Private Function ScanFiles(sFileSpec As String, _
Optional fAttribute As VbFileAttribute) As
String()
Const ALLOC_CHUNK = 50
Dim sResult() As String
Dim sFileName As String, nCount As Long, sPath2 As String
ReDim sResult(0 To ALLOC_CHUNK) As String
sFileName = Dir$(sFileSpec, fAttribute)
Do While Len(sFileName)
nCount = nCount + 1
If nCount > UBound(sResult) Then
ReDim Preserve sResult(0 To nCount + ALLOC_CHUNK) As String
End If
sResult(nCount) = sFileName
sFileName = Dir$
Loop
ReDim Preserve sResult(0 To nCount) As String
ScanFiles = sResult
End Function
--- In [email protected], "henk762000" <[EMAIL PROTECTED]> wrote:
>
> Sebelumnya makasih. Maksudku gini, kita nggak nentukan filenya, cuma
> tau direktorinya aja. Jadi waktu program di run,begitu ada image
> pada directori itu,langsung keluar image pada program kita. Kalo
> gambar2nya diganti, image pada program juga ganti sesuai file2 image
> yang ada didirectori itu (istilahku sih put and play).
>
> --- In [email protected], Hatori tori <[EMAIL PROTECTED]>
> wrote:
> >
> > gini kawan itu pada propities yang emage tolong diklik lalu kamu
> cari file gambar kamu, atau pada form seprti picture atau imagelah
> yang bisa untuk menampilkan gambar pada visual basic
> >
> > henk762000 <[EMAIL PROTECTED]> wrote: Baru daftar, mau
> tanya nih. Gimana caranya ngambil picture dari sebuah folder yang
> tidak kita tentukan nama filenya,tapi nama foldernya sudah
> ditentukan (di load ke picture box/image list secara otomatis)?
> > Matur suwun atas petunjuknya....
> >
> >
> >
> >
> >
> >
> > Untuk berhenti berlangganan kirim email kosong ke : indoprog-
> [EMAIL PROTECTED]
> >
> > Ikuti juga forum diskusi VB.net dengan
> > mengirim email kosong ke [EMAIL PROTECTED]
> >
> >
> >
> >
> > ---------------------------------
> > YAHOO! GROUPS LINKS
> >
> >
> > Visit your group "indoprog-vb" on the web.
> >
> > To unsubscribe from this group, send an email to:
> > [EMAIL PROTECTED]
> >
> > Your use of Yahoo! Groups is subject to the Yahoo! Terms of
> Service.
> >
> >
> > ---------------------------------
> >
> >
> >
> >
> >
> >
> > ---------------------------------
> > Yahoo! Personals
> > Single? There's someone we'd like you to meet.
> > Lots of someones, actually. Yahoo! Personals
> >
> > [Non-text portions of this message have been removed]
> >
>
------------------------ Yahoo! Groups Sponsor --------------------~-->
Most low income households are not online. Help bridge the digital divide today!
http://us.click.yahoo.com/I258zB/QnQLAA/TtwFAA/zCsqlB/TM
--------------------------------------------------------------------~->
Untuk berhenti berlangganan kirim email kosong ke : [EMAIL PROTECTED]
Ikuti juga forum diskusi VB.net dengan
mengirim email kosong ke [EMAIL PROTECTED]
Yahoo! Groups Links
<*> To visit your group on the web, go to:
http://groups.yahoo.com/group/indoprog-vb/
<*> To unsubscribe from this group, send an email to:
[EMAIL PROTECTED]
<*> Your use of Yahoo! Groups is subject to:
http://docs.yahoo.com/info/terms/
