frmslt.frm

利用ＶＢ和ＡＣＥＳＳ联合制作的一个人事和物品管理系统

VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form frmslt 
   Caption         =   "Form1"
   ClientHeight    =   7545
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   8985
   LinkTopic       =   "Form1"
   ScaleHeight     =   7545
   ScaleWidth      =   8985
   StartUpPosition =   3  'Windows Default
   Visible         =   0   'False
   WindowState     =   2  'Maximized
   Begin VB.CommandButton Command1 
      Caption         =   "Command1"
      Height          =   555
      Left            =   -15
      TabIndex        =   10
      Top             =   -15
      Width           =   1650
   End
   Begin MSComctlLib.ProgressBar pr 
      Height          =   330
      Left            =   6495
      TabIndex        =   9
      Top             =   7170
      Width           =   1665
      _ExtentX        =   2937
      _ExtentY        =   582
      _Version        =   393216
      Appearance      =   1
   End
   Begin MSComctlLib.StatusBar St 
      Align           =   2  'Align Bottom
      Height          =   435
      Left            =   0
      TabIndex        =   8
      Top             =   7110
      Width           =   8985
      _ExtentX        =   15849
      _ExtentY        =   767
      _Version        =   393216
      BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628} 
         NumPanels       =   4
         BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628} 
         EndProperty
         BeginProperty Panel2 {8E3867AB-8586-11D1-B16A-00C0F0283628} 
         EndProperty
         BeginProperty Panel3 {8E3867AB-8586-11D1-B16A-00C0F0283628} 
         EndProperty
         BeginProperty Panel4 {8E3867AB-8586-11D1-B16A-00C0F0283628} 
         EndProperty
      EndProperty
   End
   Begin VB.PictureBox picFrame 
      Height          =   5925
      Left            =   -15
      ScaleHeight     =   5865
      ScaleWidth      =   8820
      TabIndex        =   1
      Top             =   1095
      Width           =   8880
      Begin VB.PictureBox picload 
         AutoSize        =   -1  'True
         Height          =   2505
         Left            =   2445
         ScaleHeight     =   163
         ScaleMode       =   3  'Pixel
         ScaleWidth      =   197
         TabIndex        =   3
         Top             =   1140
         Width           =   3015
      End
      Begin VB.Timer Timer1 
         Left            =   2175
         Top             =   390
      End
      Begin VB.PictureBox Picture1 
         Height          =   2070
         Left            =   6240
         ScaleHeight     =   134
         ScaleMode       =   3  'Pixel
         ScaleWidth      =   126
         TabIndex        =   6
         Top             =   2625
         Width           =   1950
      End
      Begin VB.VScrollBar vsbSlide 
         Height          =   1815
         Left            =   6465
         TabIndex        =   5
         Top             =   345
         Width           =   300
      End
      Begin VB.PictureBox picThumb 
         Height          =   900
         Left            =   795
         ScaleHeight     =   56
         ScaleMode       =   3  'Pixel
         ScaleWidth      =   56
         TabIndex        =   4
         Top             =   2310
         Width           =   900
      End
      Begin VB.PictureBox picSlide 
         Height          =   1920
         Left            =   450
         ScaleHeight     =   124
         ScaleMode       =   3  'Pixel
         ScaleWidth      =   102
         TabIndex        =   2
         Top             =   210
         Width           =   1590
         Begin VB.CommandButton com 
            Caption         =   "Command1"
            Height          =   1635
            Index           =   0
            Left            =   165
            Style           =   1  'Graphical
            TabIndex        =   7
            Top             =   120
            Width           =   1230
         End
      End
   End
   Begin VB.FileListBox filhidden 
      Height          =   285
      Left            =   2190
      Pattern         =   "*.bmp;*.dib;*.rle;*.gif;*.jpg;*.wmf;*.emf;*.ico;*.cur"
      TabIndex        =   0
      Top             =   255
      Width           =   1935
   End
End
Attribute VB_Name = "frmslt"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
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()

Dim Index As Long
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

'On Error Resume Next

lFilCnt = filhidden.ListCount
For lIdx = 0 To filhidden.ListCount - 1
  If lIdx = 0 Then
    com(lIdx).Caption = filhidden.List(lIdx)
    com(lIdx).Visible = True
   pr.Value = 1
  Else
  Load com(lIdx)
  com(lIdx).Caption = filhidden.List(lIdx)
  com(lIdx).Visible = True
  pr.Value = 1
  End If
Next lIdx

Call Form_Resize

DoEvents
For Index = 0 To filhidden.ListCount - 1
  picload.Picture = LoadPicture("")
  picThumb.Cls
  picload.Picture = LoadPicture(filhidden.Path & "\" & filhidden.List(Index))
  Call StretchBlt(picThumb.hdc, 0, 0, picThumb.Width, picThumb.Height, picload.hdc, 0, 0, picload.ScaleWidth, picload.ScaleHeight, vbSrcCopy)


  
Set com(Index).Picture = picThumb.Image
  DoEvents
  pr.Value = lIdx + 1
Next Index
Set picload.Picture = LoadPicture()
Set picThumb.Picture = LoadPicture()
pr.Visible = False
Screen.MousePointer = 0

End Sub
Private Sub filHidden_PathChange()

   CreateThumbs
End Sub

Private Sub Form_Load()
filhidden.Pattern = "*.bmp;*.dib;*.rle;*.gif;*.jpg;*.wmf;*.emf;*.ico;*.cur"

  filhidden.Path = "D:\