Thank,s a lot atas infonya. Nanti akan saya coba....Ngomong-ngomong sampeyan ini apanya isaac newton...tetangganya..???
--- In [email protected], "Isaac Mulyono" <[EMAIL PROTECTED]> wrote: > > 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 homes are not online. Make a difference this holiday season! http://us.click.yahoo.com/5UeCyC/BWHMAA/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/
