home *** CD-ROM | disk | FTP | other *** search
/ Master 95 #1 / MASTER95_1.iso / microsof / vbasic4 / vb4-6.cab / drag.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1995-07-26  |  5.0 KB  |  157 lines

  1. VERSION 4.00
  2. Begin VB.Form frmDrag 
  3.    Caption         =   "Drag and Drop"
  4.    ClientHeight    =   2670
  5.    ClientLeft      =   2130
  6.    ClientTop       =   3780
  7.    ClientWidth     =   6405
  8.    ClipControls    =   0   'False
  9.    BeginProperty Font 
  10.       name            =   "MS Sans Serif"
  11.       charset         =   1
  12.       weight          =   700
  13.       size            =   8.25
  14.       underline       =   0   'False
  15.       italic          =   0   'False
  16.       strikethrough   =   0   'False
  17.    EndProperty
  18.    Height          =   3075
  19.    Left            =   2070
  20.    LinkTopic       =   "Form2"
  21.    MDIChild        =   -1  'True
  22.    ScaleHeight     =   2670
  23.    ScaleWidth      =   6405
  24.    Top             =   3435
  25.    Width           =   6525
  26.    Begin VB.DriveListBox Drive1 
  27.       DragIcon        =   "DRAG.frx":0000
  28.       BeginProperty Font 
  29.          name            =   "MS Sans Serif"
  30.          charset         =   1
  31.          weight          =   700
  32.          size            =   8.25
  33.          underline       =   0   'False
  34.          italic          =   0   'False
  35.          strikethrough   =   0   'False
  36.       EndProperty
  37.       Height          =   315
  38.       Left            =   120
  39.       TabIndex        =   2
  40.       Top             =   120
  41.       Width           =   1935
  42.    End
  43.    Begin VB.FileListBox File1 
  44.       BeginProperty Font 
  45.          name            =   "System"
  46.          charset         =   1
  47.          weight          =   700
  48.          size            =   9.75
  49.          underline       =   0   'False
  50.          italic          =   0   'False
  51.          strikethrough   =   0   'False
  52.       EndProperty
  53.       Height          =   2184
  54.       Left            =   2280
  55.       Pattern         =   "*.txt;*.bmp;*.exe;*.hlp"
  56.       TabIndex        =   1
  57.       Top             =   120
  58.       Width           =   2052
  59.    End
  60.    Begin VB.DirListBox Dir1 
  61.       DragIcon        =   "DRAG.frx":030A
  62.       BeginProperty Font 
  63.          name            =   "System"
  64.          charset         =   1
  65.          weight          =   700
  66.          size            =   9.75
  67.          underline       =   0   'False
  68.          italic          =   0   'False
  69.          strikethrough   =   0   'False
  70.       EndProperty
  71.       Height          =   1920
  72.       Left            =   120
  73.       TabIndex        =   0
  74.       Top             =   600
  75.       Width           =   1935
  76.    End
  77.    Begin VB.Image Image1 
  78.       BorderStyle     =   1  'Fixed Single
  79.       Height          =   2415
  80.       Left            =   4560
  81.       Stretch         =   -1  'True
  82.       Top             =   120
  83.       Width           =   1725
  84.    End
  85. Attribute VB_Name = "frmDrag"
  86. Attribute VB_Creatable = False
  87. Attribute VB_Exposed = False
  88. Private Sub Dir1_Change()
  89.     file1.Path = Dir1.Path
  90. End Sub
  91. Private Sub Drive1_Change()
  92.     On Error GoTo DriveErrs
  93.     Dir1.Path = Drive1.Drive
  94. Exit Sub
  95. DriveErrs:
  96.     Select Case Err
  97.         Case 68
  98.             MsgBox prompt:="Drive not ready. Please insert disk in drive.", _
  99.             buttons:=vbExclamation
  100.             ' Reset path to previous drive.
  101.             Drive1.Drive = Dir1.Path
  102.             Exit Sub
  103.         Case Else
  104.             MsgBox prompt:="Application error.", buttons:=vbExclamation
  105.     End Select
  106. End Sub
  107. Private Sub File1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  108.     file1.DragIcon = Drive1.DragIcon
  109.     file1.Drag
  110. End Sub
  111. Private Sub Form_Load()
  112.     frmDrag.Width = 6525
  113.     frmDrag.Height = 3075
  114. End Sub
  115. Private Sub Image1_DragDrop(Source As Control, X As Single, Y As Single)
  116.     ' Get the last three letters of the dragged filename.
  117.     temp = Right$(file1.FileName, 3)
  118.     ' If dragged file is in the root, append filename.
  119.     If Mid(file1.Path, Len(file1.Path)) = "\" Then
  120.       dropfile = file1.Path & file1.FileName
  121.     ' If dragged file is not in root, append "\" and filename.
  122.     Else
  123.       dropfile = file1.Path & "\" & file1.FileName
  124.     End If
  125.       
  126.     image1.Picture = LoadPicture("")
  127.     Select Case temp
  128.     Case "txt"
  129.         X = Shell("Notepad " + dropfile, 1)
  130.     Case "bmp"
  131.         image1.Picture = LoadPicture(dropfile)
  132.     Case "exe"
  133.         X = Shell(dropfile, 1)
  134.     Case "hlp"
  135.         X = Shell("WinHelp " + dropfile, 1)
  136.     Case Else
  137.         nl = Chr$(10) + Chr$(13)
  138.         msg = "Try one of these file types:"
  139.         msg = nl + msg + nl + nl + "     .txt, .bmp, .exe, .hlp"
  140.         MsgBox msg
  141.     End Select
  142. End Sub
  143. Private Sub Image1_DragOver(Source As Control, X As Single, Y As Single, State As Integer)
  144.     Select Case State
  145.     Case 0
  146.         ' Display a new icon when the source enters the drop area.
  147.         file1.DragIcon = Dir1.DragIcon
  148.     Case 1
  149.         ' Display the original DragIcon when the source leaves the drop area.
  150.         file1.DragIcon = Drive1.DragIcon
  151.     End Select
  152. ' Note that Dir1.DragIcon and Drive1.DragIcon have been
  153. ' set at design time. This allows you to load the "Enter"
  154. ' and "Leave" icons for File1 at run time without requiring
  155. ' that the user has those icons on disk.
  156. End Sub
  157.