test.frm

电脑编程技巧和源码。很不错的。

VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Object = "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCT2.OCX"
Begin VB.Form MainForm 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Test Picture Transition By DragonJiang"
   ClientHeight    =   3285
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   5865
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   3285
   ScaleWidth      =   5865
   StartUpPosition =   3  '窗口缺省
   Begin VB.ComboBox Picturelist 
      Height          =   300
      Left            =   1320
      Style           =   2  'Dropdown List
      TabIndex        =   9
      Top             =   2880
      Width           =   3615
   End
   Begin VB.ComboBox ShowStyle 
      Height          =   300
      Left            =   4200
      Style           =   2  'Dropdown List
      TabIndex        =   8
      Top             =   1920
      Width           =   1575
   End
   Begin VB.TextBox TextSpeed 
      Height          =   270
      Left            =   5040
      TabIndex        =   6
      Top             =   2400
      Width           =   495
   End
   Begin MSComCtl2.UpDown UpDown 
      Height          =   255
      Left            =   5520
      TabIndex        =   5
      Top             =   2400
      Width           =   270
      _ExtentX        =   476
      _ExtentY        =   450
      _Version        =   393216
      Value           =   2
      Max             =   100
      Min             =   2
      Enabled         =   -1  'True
   End
   Begin VB.CommandButton BrowButton 
      Caption         =   "Add"
      Height          =   255
      Left            =   5160
      TabIndex        =   4
      Top             =   2880
      Width           =   615
   End
   Begin VB.CommandButton AboutButton 
      Caption         =   "About"
      Height          =   375
      Left            =   4200
      TabIndex        =   2
      Top             =   600
      Width           =   1575
   End
   Begin VB.CommandButton RunAndStopButton 
      Caption         =   "Start"
      Enabled         =   0   'False
      Height          =   375
      Left            =   4200
      TabIndex        =   1
      Top             =   120
      Width           =   1575
   End
   Begin VB.PictureBox Pic 
      Height          =   2535
      Left            =   120
      ScaleHeight     =   165
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   261
      TabIndex        =   0
      Top             =   120
      Width           =   3975
      Begin MSComDlg.CommonDialog Dlg 
         Left            =   480
         Top             =   480
         _ExtentX        =   847
         _ExtentY        =   847
         _Version        =   393216
         CancelError     =   -1  'True
      End
   End
   Begin VB.Label Label3 
      Caption         =   "Length:"
      Height          =   255
      Left            =   4200
      TabIndex        =   7
      Top             =   2400
      Width           =   735
   End
   Begin VB.Label Label1 
      Caption         =   "PictureList:"
      Height          =   255
      Left            =   120
      TabIndex        =   3
      Top             =   2880
      Width           =   1215
   End
End
Attribute VB_Name = "MainForm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim IsExit As Boolean
Private Sub AboutButton_Click()
    MsgBox MainForm.Caption & Chr(13) & "date: 2000.2.2.", vbInformation, "About TransPicture"
    
    
End Sub

 
Private Sub Form_Unload(Cancel As Integer)
  IsExit = True

End Sub

Private Sub RunAndStopButton_Click()
    Dim n, i As Integer
    i = Picturelist.ListIndex
    If RunAndStopButton.Caption = "Start" Then
        Randomize
        TextSpeed.Enabled = False
        UpDown.Enabled = False
        ShowStyle.Enabled = False
        RunAndStopButton.Caption = "Stop"
        Picturelist.Enabled = False
        BrowButton.Enabled = False
        n = ShowStyle.ListIndex
        
        While 1
          
          If n = 0 Then n = Int(Rnd * 5) + 1
          
          ShowStyle.ListIndex = n
    
          
          Picturelist.ListIndex = i
          If P1ToP2(Picturelist.List(i), Picturelist.List((i + 1) Mod Picturelist.ListCount), Pic.hdc, Pic.ScaleWidth, Pic.ScaleHeight, UpDown.Value, ShowStyle.ListIndex - 1, IsExit) = TransUserBreak Then
              GoTo exitwhile
          End If
          
          i = i + 1
          If i = Picturelist.ListCount Then i = 0
          
        Wend
               
    Else
      IsExit = True
    End If

exitwhile:
      Picturelist.ListIndex = i
      RunAndStopButton.Caption = "Start"
       
     Picturelist.Enabled = True
      TextSpeed.Enabled = True
      UpDown.Enabled = True
      ShowStyle.Enabled = True
      BrowButton.Enabled = True
End Sub

Private Sub picturelist_Click()
 On Error Resume Next
   Set Pic.Picture = LoadPicture(Picturelist.List(Picturelist.ListIndex))
End Sub
Private Sub BrowButton_Click()
  On Error Resume Next
  Dim s, InitDir As String
  Dlg.Flags = cdlOFNExplorer '允许多选文件
  Dlg.Filter = "所有的图形文件|(*.bmp;*.jpg;*.wfm;*.emf;*.ico;*.rle;*.gif;*.cur)|JPEG文件|*.jpg|BMP文件|(*.bmp)|GIF文件|*.gif|光标(*.Ico)和图标(*.Cur)文件|(*.cur,*.ico)|WMF元文件(*.wmf,*.emf)|(*.wmf,*.emf)|RLE行程文件(*.rle)|*.rle"
  Dlg.ShowOpen
  If Err Then Exit Sub
  Set Pic.Picture = LoadPicture(Dlg.FileName)
  If Err Then
      MsgBox "装入图片[" & Dlg.FileName & "]出错.", vbOKOnly, "错误"
  Else
      Picturelist.AddItem Dlg.FileName
      Picturelist.ListIndex = Picturelist.ListCount - 1
      
  End If
   
   If ShowStyle.ListIndex >= 0 And Picturelist.ListCount >= 2 Then
       RunAndStopButton.Enabled = True
   End If
  
End Sub


 Private Sub Form_Load()
   ShowStyle.AddItem "随机"
   ShowStyle.AddItem "整个图片淡入淡出"
   ShowStyle.AddItem "从左到右淡入"
   ShowStyle.AddItem "从右到左淡入"
   ShowStyle.AddItem "从上到下淡入"
   ShowStyle.AddItem "从下到上淡入"
   ShowStyle.ListIndex = 0
 
   UpDown.Value = 50
   

End Sub

Private Sub ShowStyle_click()
 
 If ShowStyle.ListIndex >= 0 And Picturelist.ListCount >= 2 Then
        RunAndStopButton.Enabled = True
   End If
End Sub

Private Sub TextSpeed_Change()
   n = Int(Val(TextSpeed.Text))
   If n < UpDown.Min Or n > UpDown.Max Then
       n = 50
   End If
   UpDown.Value = n
    
   TextSpeed.Text = n
   
End Sub

Private Sub UpDown_Change()
  TextSpeed.Text = UpDown.Value
End Sub