home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / dragdr_1 / frmdragd.frm (.txt) next >
Encoding:
Visual Basic Form  |  1998-09-14  |  5.2 KB  |  128 lines
  1. VERSION 5.00
  2. Begin VB.Form frmDragDropFiles 
  3.    AutoRedraw      =   -1  'True
  4.    Caption         =   "DragDrop Files Demo"
  5.    ClientHeight    =   3480
  6.    ClientLeft      =   1575
  7.    ClientTop       =   1530
  8.    ClientWidth     =   3120
  9.    LinkTopic       =   "Form1"
  10.    ScaleHeight     =   232
  11.    ScaleMode       =   3  'Pixel
  12.    ScaleWidth      =   208
  13.    Begin VB.CheckBox Check1 
  14.       Caption         =   "Use OLE DragDrop"
  15.       Height          =   195
  16.       Left            =   210
  17.       TabIndex        =   2
  18.       Top             =   3090
  19.       Width           =   2175
  20.    End
  21.    Begin VB.PictureBox Picture1 
  22.       AutoRedraw      =   -1  'True
  23.       Height          =   2130
  24.       Left            =   180
  25.       ScaleHeight     =   2070
  26.       ScaleWidth      =   2715
  27.       TabIndex        =   0
  28.       Top             =   750
  29.       Width           =   2775
  30.    End
  31.    Begin VB.Label Label1 
  32.       Caption         =   "Open Windows Explorer and drag any valid picture file onto the picturebox."
  33.       Height          =   495
  34.       Left            =   240
  35.       TabIndex        =   1
  36.       Top             =   135
  37.       Width           =   2715
  38.    End
  39. Attribute VB_Name = "frmDragDropFiles"
  40. Attribute VB_GlobalNameSpace = False
  41. Attribute VB_Creatable = False
  42. Attribute VB_PredeclaredId = True
  43. Attribute VB_Exposed = False
  44.  Option Explicit
  45.   ' A demo project of DragDrop file routines.  This demo shows the difference
  46.   ' between using a subclassed dragdrop routine and an OLE dragdrop routine.
  47.   ' written by Bryan Stafford of New Vision Software
  48.   ' this demo is released into the public domain "as is" without
  49.   ' warranty or guaranty of any kind.  In other words, use at
  50.   ' your own risk.
  51.   Private Const GWL_WNDPROC As Long = (-4&)
  52.   ' API call to alter the class data for this window
  53.   Private Declare Function SetWindowLong& Lib "user32" Alias "SetWindowLongA" (ByVal hWnd&, _
  54.                                                               ByVal nIndex&, ByVal dwNewLong&)
  55. Private Sub Form_Load()
  56.   ' register picture1 as a window that accepts dragdrop files
  57.   DragAcceptFiles Picture1.hWnd, 1&
  58.   ' take control of message processing by installing our message handling
  59.   ' routine into the chain of message routines for picture1
  60.   procOld = SetWindowLong(Picture1.hWnd, GWL_WNDPROC, AddressOf WindowProc)
  61.                             
  62. End Sub
  63. Private Sub Form_Unload(Cancel As Integer)
  64.   ' give message processing control back to VB
  65.   ' if you don't do this you WILL crash!!!
  66.   Call SetWindowLong(Picture1.hWnd, GWL_WNDPROC, procOld)
  67. End Sub
  68. Public Sub DropFiles(ByVal hDrop&)
  69.   Dim sFileName$, nCharsCopied&
  70.   ' make some space for the file name
  71.   sFileName = String$(MAX_PATH, vbNullChar)
  72.   ' pass the file handle (hDrop), the index of the file if more than 1 was passed (we
  73.   ' still use index zero since we only care about the first file in the list), the variable
  74.   ' that will accept the file name and the amount of space that that variable is dimentioned for.
  75.   nCharsCopied = DragQueryFile(hDrop, 0&, sFileName, MAX_PATH)
  76.   ' clean up after ourselves bu closing the file handle
  77.   DragFinish hDrop
  78.   ' if there were chars copied, get the file name and try to load it into the picturbox
  79.   If nCharsCopied Then
  80.     sFileName = Left$(sFileName, nCharsCopied)
  81.     ' incase it's not a valid picture display the error message
  82.     On Error GoTo invalidPicture
  83.     Picture1.Picture = LoadPicture(sFileName)
  84.   End If
  85.   Exit Sub
  86. invalidPicture:
  87.   ' display the invalid file format message
  88.   DisplayPicture1Message
  89. End Sub
  90. Private Sub Picture1_OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)
  91.   ' check the format of the data that is being dropped
  92.   If Data.GetFormat(vbCFFiles) = True Then
  93.     Dim sFileName$
  94.     ' grab the first file name in the collection of file names
  95.     sFileName = Data.Files(1)
  96.     ' incase it's not a valid picture display the error message
  97.     On Error GoTo invalidPicture
  98.     ' try to load a picture
  99.     Picture1.Picture = LoadPicture(sFileName)
  100.   End If
  101.   Exit Sub
  102. invalidPicture:
  103.   ' display the invalid file format message
  104.   DisplayPicture1Message
  105. End Sub
  106.                                                               
  107. Private Sub Check1_Click()
  108.   ' toggle between OLE dragdrop or Subclassed dragdrop mode.
  109.   Picture1.OLEDropMode = Check1
  110. End Sub
  111. Private Sub DisplayPicture1Message()
  112.   ' clear any picture out of the control
  113.   Picture1.Picture = LoadPicture()
  114.   Const Msg As String = "Invalid Picture Format!"
  115.   ' print the error message on the picturebox
  116.   Picture1.CurrentX = (Picture1.ScaleWidth \ 2) - (Picture1.TextWidth(Msg) \ 2)
  117.   Picture1.CurrentY = (Picture1.ScaleHeight \ 2) - (Picture1.TextHeight(Msg) \ 2)
  118.   Picture1.Print Msg
  119. End Sub
  120. Private Sub Picture1_OLEDragOver(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single, State As Integer)
  121.   ' check the data to see if it is what we will allow.  if not so "no drop"
  122.   If Data.GetFormat(vbCFFiles) Then
  123.     Effect = vbDropEffectCopy And Effect
  124.   Else
  125.     Effect = vbDropEffectNone
  126.   End If
  127. End Sub
  128.