中国IT动力,最新最全的IT技术教程
最新100篇 | 推荐100篇 | 专题100篇 | 排行榜 | 搜索 | 在线API文档
首 页 | 程序开发 | 操作系统 | 软件应用 | 图形图象 | 网络应用 | 精文荟萃 | 教育认证 | 硬件维护 | 未整理篇 | 站长教程
ASP JS PHP工程 ASP.NET 网站建设 UML J2EESUN .NET VC VB VFP 网络维护 数据库 DB2 SQL2000 Oracle Mysql
服务器 Win2000 Office C DreamWeaver FireWorks Flash PhotoShop 上网宝典 CorelDraw 协议大全 网络安全 微软认证
硬件维护  CPU  主板  硬盘  内存  显卡  显示器  键盘鼠标  声卡音箱  打印机  机箱电源  BIOS  网卡  C#  Java  Delphi  vs.net2005
  当前位置:> 程序开发 > 编程语言 > Visual Basic > 综合文章
浏览文件夹中的图片(用VB实现)
作者:未知 时间:2002-12-16 12:12 出处:Blog 责编:chinaitpower
              摘要:浏览文件夹中的图片(用VB实现)

                                            浏览文件夹中的图片(用VB实现)
     首先要新建一个工程,在Form1中添加dirlistbox控件,drivelistbox控件,filelistbox控件,combobox控件,textbox控件,vscrollbar控件和一个command1控件
然后在代码框中输入以下代码:

Option Explicit

private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
private Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
private Const MAX_PATH = 260
private Type FILETIME
        dwLowDateTime As Long
        dwHighDateTime As Long
End Type
private Type WIN32_FIND_DATA
        dwFileAttributes As Long
        ftCreationTime As FILETIME
        ftLastAccessTime As FILETIME
        ftLastWriteTime As FILETIME
        nFileSizeHigh As Long
        nFileSizeLow As Long
        dwReserved0 As Long
        dwReserved1 As Long
        cFileName As String * MAX_PATH
        cAlternate As String * 14
End Type

Dim Pic As Object
Private Sub Command1_Click()
Dim obj As Object
Dim pcname As String
Dim i As Long, j As Long, counter As Long
Dim wfd As WIN32_FIND_DATA
Dim source As String, piname As String
Dim hfile As Long
Dim nfile As Long
Dim filename() As String
Dim x As Long, length1 As Long, width1 As Long
counter = 0
Set Pic = Form1.Controls.Add("VB.PictureBox", "test")
Pic.Visible = True
If Right(Dir1.Path, 1) <> "\" Then
  source = Dir1.Path & "\" & Text1.Text
Else
  source = Dir1.Path & Text1.Text
End If
hfile = FindFirstFile(source, wfd)
If hfile = -1 Then
 MsgBox "没有找到文件"
End If
counter = counter + 1
Do
nfile = FindNextFile(hfile, wfd)
If nfile <> 0 Then
counter = counter + 1
End If
Loop Until nfile = 0
ReDim filename(counter) As String
hfile = FindFirstFile(source, wfd)
filename(0) = wfd.cFileName
For i = 1 To counter
 nfile = FindNextFile(hfile, wfd)
 filename(i) = wfd.cFileName
Next i
If Right(Dir1.Path, 1) <> "\" Then
source = Dir1.Path & "\"
Else
source = Dir1.Path
End If
Call FindClose(hfile)

For i = 0 To (counter / 4)
For j = 0 To 3
piname = "picture" & j + 1 + i * 4
Set obj = Form1.Controls.Add("VB.Image", piname)
obj.Width = 1500
obj.Height = 1500
obj.Stretch = True
Set obj.Container = Pic
obj.Left = j * obj.Width
obj.Top = i * obj.Height
If (j + 1 + i * 4) > counter Then
GoTo line
End If
obj.Picture = LoadPicture(source & (filename(j + 1 + i * 4)))
obj.Visible = True
Next j
Next i
line:
width1 = j * obj.Width
length1 = i * obj.Height
Pic.Width = 4 * obj.Width
Pic.Height = length1
Pic.Left = Dir1.Left + Dir1.Width
Pic.Top = 0
width1 = 4 * obj.Width
length1 = i * obj.Height
VScroll1.Min = 0
VScroll1.Max = 32767
End Sub
Private Sub Dir1_Change()
File1.filename = Dir1.Path
End Sub
Private Sub Drive1_Change()
Dir1.Path = Drive1.Drive
End Sub
Private Sub Form_Load()
Combo1.Text = "*.jpg"
Combo1.AddItem "*.bmp"
Combo1.AddItem "*.gif"
VScroll1.LargeChange = 200
VScroll1.SmallChange = 50
Text1.Text = Combo1.Text
End Sub
Private Sub VScroll1_Change()
Pic.Top = 0 - VScroll1.Value
End Sub
该程序在VB6.0+WINME环境下调试通过。

欢迎广大读者和本人讨论。我的电子邮件是:ywchen2000@etang.com

关闭本页
 
首页 | 投资与合作 | 服务条款 | 隐私政策 | 收藏本站 | 设为首页 | 新用户注册 | 免责声明 | 使用帮助
Copyright ©2005-2008 chinaitpower.com All rights reserved. www.chinaitpower.com 版权所有