用vb6设计缩略图功能的图片浏览器

用用 vb6 设计缩略图功能的图片浏览器设计缩略图功能的图片浏览器 一 编程思路 性能良好的图片浏览器首先要能够支持广泛的图片文件格式 这一点 VB6 基本控件 picture 已经为我们做好了 我们所要考虑的是如何将一幅图片极其清晰的按照设定大小显 示到 容器 中 容器 可以是多种多样的 而且要充分利用动态创建和卸载控件技 术 以便适应不同目录所含有的不同个数的图片 当然正确 有序排列缩略图片也是非常 关键的 我在这里向大家展示利用动态创建 COMMAND 按钮 控件作为载体的实现方法 它不仅可以以缩略图方式进行图片预览和全屏图片浏览 而且可以自动随窗体的变化进行 相应的伸展 注意本文关于界面容器 缩略图载体容器和缩略图载体的概念 二 界面设计 1 添加四个 command 控件 command 1 8 Style 1 Graphical caption 属性分 别是 选择 浏览 预览 缩略图察看 上一张 下一张 向下 向上 退出 这些按钮用来进行系统相关操作 它们是可以添加图片的 2 添加一个 filelist 控件 filhidden 设置其 Pattern bmp dib rle gif jpg wmf emf ico cur visible fales 该文件列表控件用来 读取选中目录下的所有图片文件名称 程序运行时是不可见的 3 添加 picture 控件 picFrame 作为界面容器 在其上面添加四个 picture 控件 picSlide 作为缩略图载体容器 picload 设置 autosize true 作为缓冲图片要以原格式装载图 片 picThumb 用来装载缩略后的图片 一个 VScrollBarL 控件 vsbSlide 用来进行图片 调整 以便在缩略图较多时能够进行相应的调整 picture1 用来全屏显示图片 设置上述所 有图片控件 ScaleMode 3 Pixel 它们用来进行界面调整和缩略图片的生成 4 在缩略图载体容器 picslide 上面添加命令按钮 command 控件数组原型 com 0 设置其 Style 1 Graphical Visible 0 用来作为缩略图片的载体 5 添加一个 StatusBar 控件 St 用来显示有关的信息 6 单击 工程 菜单项目 选择 部件 在部件对话框的 控件 栏目中选择 MICROSOFT WINDOWS COMMON CONTROLS 6 0 确认在它前面的复选框中有一个 黑色的对号 单击 确认 添加对该控件的引用 添加一个 progressbar 控件 pb 用来显示 缩略图的集成进度 7 添加定时器 timer1 用来实行图片的幻灯浏览 按层次调整上述控件到适当位 置 如图片 1 所示 三 程序源代码 Option Explicit Dim Apath As String Pi As Integer bZ As Integer Private Declare Function StretchBlt Lib GDI32 ByVal hdc As Long ByVal X As Long ByVal Y As Long ByVal nWidth As Long ByVal nHeight As Long ByVal hSrcDC As Long ByVal XSrc As Long ByVal YSrc As Long ByVal nSrcWidth As Long ByVal nSrcHeight As Long ByVal dwRop As Long As Long 本函数用来对图片进行缩放处理 生成缩略图片 Private Sub CreateThumbs 本函数用来创造缩略图片 并且将它们放到足够的 file 缩略图载体 com i 中 Dim lIdx As Long Dim lFilCnt As Long Dim sText As String i As Integer Screen MousePointer vbHourglass 设置鼠标指针为漏斗类型 picSlide Move 0 0 Com 0 Width Com 0 Height picSlide Visible True 初始化缩略图容器载体 Pr Visible True Pr Value 0 Pr Max filHidden ListCount Pr Min 0 启动进度条 Com 0 Picture LoadPicture Com 0 Visible False If Com Count 1 Then For i 1 To Com Count 1 Unload Com i Next End If AGESEP 初始化缩略图载体 com On Error Resume Next file 忽略错误 file lFilCnt filHidden ListCount For lIdx 0 To filHidden ListCount 1 Load Com lIdx Com lIdx Caption filHidden List lIdx Com lIdx Visible True Pr Value 1 Next lIdx 创建所需要的所有缩略图载体 file 载体的个数等于选定目录下图片文件个数 Call Form Resize 对载体进行排序 DoEvents For lIdx 0 To filHidden ListCount 1 picLoad Picture LoadPicture picThumb Cls picLoad Picture LoadPicture Apath filHidden List lIdx StretchBlt picThumb hdc 0 0 picThumb Width picThumb Height picLoad hdc 0 0 picLoad ScaleWidth picLoad ScaleHeight vbSrcCopy Set Com lIdx Picture picThumb Image 按顺序为载体添加缩略图片 DoEvents Pr Value lIdx 1 Next lIdx Set picLoad Picture LoadPicture Set picThumb Picture LoadPicture Pr Visible False Screen MousePointer 0 释放占用的资源 隐藏进度条 恢复鼠标指针 End Sub Private Sub filHidden PathChange AGESEP 当文件目录改变时计算出标准的目录变量 file 显示有关的目录和图片文件个数信息 file 调用缩略图创建过程函数 CreateThumbs End Sub Private Sub Form Resize file 本函数用来对程序界面控件位置进行相应的调整 file 并且调整缩略图的位置 Dim X As Long Dim Y As Long Dim lIdx As Long Dim lCols As Long If Me WindowState vbMinimized Then If Me Width 600 Screen TwipsPerPixelX Then Me Width 600 Screen TwipsPerPixelX ElseIf Me Height 378 Screen TwipsPerPixelY Then Me Height 378 Screen TwipsPerPixelY end if 限定软件界面的最小宽度和高度 Else picFrame Move 2 Command1 Height Me ScaleWidth 11 Me ScaleHeight Command1 Height St Height vsbSlide Move picFrame ScaleWidth vsbSlide Width 0 vsbSlide Width picFrame ScaleHeight lCols Int picFrame ScaleWidth vsbSlide Width Com 0 Width For lIdx 0 To Com Count 1 X lIdx Mod lCols Com 0 Width Y Int lIdx lCols Com 0 Height Com lIdx Move X Y Next lIdx picSlide Width lCols Com 0 Width picSlide Height Int Com Count lCols Com 0 Height If Int Com Count lCols Com Count lCols Then picSlide Height picSlide Height Com 0 Height End If vsbSlide Value 0 vsbSlide Max picSlide Height picFrame ScaleHeight If vsbSlide Max 0 Then vsbSlide Max 0 vsbSlide Enabled False Else vsbSlide Enabled True vsbSlide SmallChange Com 0 Height vsbSlide LargeChange picFrame ScaleHeight End If End If Pr Top St Top 8 Pr Left St Panels 4 Left 6 Picture1 Move picFrame Width Picture1 Width 2 picFrame Height Picture1 Height 2 End Sub Private Sub Picture1 MouseDown Button As Integer Shift As Integer X As Single