home *** CD-ROM | disk | FTP | other *** search
/ Mastering Visual Basic 6 / mastvb6.iso / ch_code / ch14 / oledd / oleddman.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1998-07-07  |  8.7 KB  |  252 lines
  1. VERSION 5.00
  2. Object = "{3B7C8863-D78F-101B-B9B5-04021C009402}#1.2#0"; "RICHTX32.OCX"
  3. Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
  4. Begin VB.Form OLEDDManForm 
  5.    Caption         =   "Manual OLE Drag & Drop"
  6.    ClientHeight    =   6660
  7.    ClientLeft      =   60
  8.    ClientTop       =   345
  9.    ClientWidth     =   10530
  10.    LinkTopic       =   "Form1"
  11.    ScaleHeight     =   6660
  12.    ScaleWidth      =   10530
  13.    StartUpPosition =   3  'Windows Default
  14.    Begin VB.CheckBox Check1 
  15.       Caption         =   "AutoVerbMenu"
  16.       BeginProperty Font 
  17.          Name            =   "Verdana"
  18.          Size            =   9.75
  19.          Charset         =   0
  20.          Weight          =   400
  21.          Underline       =   0   'False
  22.          Italic          =   0   'False
  23.          Strikethrough   =   0   'False
  24.       EndProperty
  25.       Height          =   255
  26.       Left            =   2880
  27.       TabIndex        =   6
  28.       Top             =   6240
  29.       Width           =   2295
  30.    End
  31.    Begin VB.CommandButton OLEObjects 
  32.       Caption         =   "List All Objects"
  33.       BeginProperty Font 
  34.          Name            =   "Verdana"
  35.          Size            =   9.75
  36.          Charset         =   0
  37.          Weight          =   400
  38.          Underline       =   0   'False
  39.          Italic          =   0   'False
  40.          Strikethrough   =   0   'False
  41.       EndProperty
  42.       Height          =   465
  43.       Left            =   150
  44.       TabIndex        =   5
  45.       Top             =   6090
  46.       Width           =   2370
  47.    End
  48.    Begin VB.CommandButton Command2 
  49.       Caption         =   "Load Text File"
  50.       BeginProperty Font 
  51.          Name            =   "Verdana"
  52.          Size            =   9.75
  53.          Charset         =   0
  54.          Weight          =   400
  55.          Underline       =   0   'False
  56.          Italic          =   0   'False
  57.          Strikethrough   =   0   'False
  58.       EndProperty
  59.       Height          =   465
  60.       Left            =   5535
  61.       TabIndex        =   4
  62.       Top             =   6090
  63.       Width           =   2370
  64.    End
  65.    Begin VB.TextBox Text1 
  66.       BeginProperty Font 
  67.          Name            =   "Verdana"
  68.          Size            =   9
  69.          Charset         =   0
  70.          Weight          =   400
  71.          Underline       =   0   'False
  72.          Italic          =   0   'False
  73.          Strikethrough   =   0   'False
  74.       EndProperty
  75.       Height          =   2115
  76.       Left            =   5535
  77.       MultiLine       =   -1  'True
  78.       OLEDragMode     =   1  'Automatic
  79.       OLEDropMode     =   1  'Manual
  80.       ScrollBars      =   2  'Vertical
  81.       TabIndex        =   3
  82.       Text            =   "OLEDDMAN.frx":0000
  83.       Top             =   3855
  84.       Width           =   4815
  85.    End
  86.    Begin MSComDlg.CommonDialog CommonDialog1 
  87.       Left            =   8025
  88.       Top             =   3195
  89.       _ExtentX        =   847
  90.       _ExtentY        =   847
  91.       _Version        =   393216
  92.    End
  93.    Begin VB.CommandButton Command1 
  94.       Caption         =   "Load Image"
  95.       BeginProperty Font 
  96.          Name            =   "Verdana"
  97.          Size            =   9.75
  98.          Charset         =   0
  99.          Weight          =   400
  100.          Underline       =   0   'False
  101.          Italic          =   0   'False
  102.          Strikethrough   =   0   'False
  103.       EndProperty
  104.       Height          =   465
  105.       Left            =   5535
  106.       TabIndex        =   2
  107.       Top             =   3240
  108.       Width           =   2370
  109.    End
  110.    Begin VB.PictureBox Picture1 
  111.       Height          =   2940
  112.       Left            =   5535
  113.       OLEDragMode     =   1  'Automatic
  114.       ScaleHeight     =   2880
  115.       ScaleWidth      =   4800
  116.       TabIndex        =   1
  117.       Top             =   165
  118.       Width           =   4860
  119.    End
  120.    Begin RichTextLib.RichTextBox RichTextBox1 
  121.       Height          =   5820
  122.       Left            =   120
  123.       TabIndex        =   0
  124.       Top             =   150
  125.       Width           =   5235
  126.       _ExtentX        =   9234
  127.       _ExtentY        =   10266
  128.       _Version        =   393217
  129.       ScrollBars      =   2
  130.       OLEDropMode     =   1
  131.       TextRTF         =   $"OLEDDMAN.frx":0006
  132.       BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
  133.          Name            =   "Verdana"
  134.          Size            =   9
  135.          Charset         =   0
  136.          Weight          =   400
  137.          Underline       =   0   'False
  138.          Italic          =   0   'False
  139.          Strikethrough   =   0   'False
  140.       EndProperty
  141.    End
  142. Attribute VB_Name = "OLEDDManForm"
  143. Attribute VB_GlobalNameSpace = False
  144. Attribute VB_Creatable = False
  145. Attribute VB_PredeclaredId = True
  146. Attribute VB_Exposed = False
  147. Dim PWidth As Long, PHeight As Long
  148. Private Sub Check1_Click()
  149.     If Check1.Value = 1 Then
  150.         RichTextBox1.AutoVerbMenu = True
  151.     Else
  152.         RichTextBox1.AutoVerbMenu = False
  153.     End If
  154. End Sub
  155. Private Sub Command1_Click()
  156.     CommonDialog1.Filter = "Images|*.bmp;*.gif;*.tif"
  157.     CommonDialog1.InitDir = App.Path
  158.     CommonDialog1.FileName = ""
  159.     CommonDialog1.ShowOpen
  160.     If CommonDialog1.FileName = "" Then Exit Sub
  161.     Picture1.Picture = LoadPicture(CommonDialog1.FileName)
  162.     OLEDDManForm.Palette = LoadPicture(CommonDialog1.FileName)
  163.     ResizePBox
  164. End Sub
  165. Private Sub Command2_Click()
  166.     CommonDialog1.Filter = "Text Files|*.txt|All Files|*.*"
  167.     CommonDialog1.InitDir = App.Path
  168.     CommonDialog1.FileName = ""
  169.     CommonDialog1.ShowOpen
  170.     If CommonDialog1.FileName = "" Then Exit Sub
  171.     FNum = FreeFile
  172.     Open CommonDialog1.FileName For Input As #FNum
  173.     allTxt = Input(LOF(FNum), #FNum)
  174.     Close FNum
  175.     Text1.Text = allTxt
  176. End Sub
  177. Private Sub Command3_Click()
  178.     For i = 0 To RichTextBox1.OLEObjects.Count
  179.         Debug.Print RichTextBox1.OLEObjects.Item(i).Class
  180.     Next
  181. End Sub
  182. Private Sub Form_Load()
  183.     PWidth = Picture1.Width
  184.     PHeight = Picture1.Height
  185. End Sub
  186. Sub ResizePBox()
  187. Dim imgWidth As Long, imgHeight As Long
  188.     Picture1.Enabled = False
  189.     imgWidth = Round(ScaleX(Picture1.Picture.Width, vbHimetric, vbTwips))
  190.     imgHeight = Round(ScaleY(Picture1.Picture.Height, vbHimetric, vbTwips))
  191.     If imgWidth < PWidth Then Picture1.Width = imgWidth
  192.     If imgHeight < PHeight Then Picture1.Height = imgHeight
  193.     Picture1.Enabled = True
  194. End Sub
  195. Private Sub OLEObjects_Click()
  196.     For i = 0 To RichTextBox1.OLEObjects.Count - 1
  197.         Debug.Print RichTextBox1.OLEObjects.Item(i).Class
  198.     Next
  199. End Sub
  200. Private Sub Picture1_OLECompleteDrag(Effect As Long)
  201.     RichTextBox1.OLEDropMode = rtfOLEDropManual
  202. End Sub
  203. Private Sub Picture1_OLEStartDrag(Data As DataObject, AllowedEffects As Long)
  204.     RichTextBox1.OLEDropMode = rtfOLEDropAutomatic
  205. End Sub
  206. Private Sub RichTextBox1_OLEDragDrop(Data As RichTextLib.DataObject, Effect As Long, Button As Integer, Shift As Integer, x As Single, y As Single)
  207. Dim FNum As Integer
  208. If Data.GetFormat(vbCFText) Then
  209.         RichTextBox1.SelText = Data.GetData(vbCFText)
  210.     End If
  211.     If Data.GetFormat(vbCFRTF) Then
  212.         RichTextBox1.SelRTF = Data.GetData(vbCFRTF)
  213.         GoTo PasteDone
  214.     End If
  215.     If Data.GetFormat(vbCFBitmap) Or Data.GetFormat(vbCFDIB) Then
  216.         RichTextBox1.OLEObjects.Add , , Data.GetData(vbCFDIB)
  217.         GoTo PasteDone
  218.     End If
  219.     If Data.GetFormat(vbCFFiles) Then
  220.         For i = 1 To Data.Files.Count
  221.             If UCase(Right(Data.Files(i), 4)) = ".RTF" Then
  222.                 FNum = FreeFile
  223.                 Open Data.Files(i) For Binary As FNum
  224.                 RichTextBox1.SelRTF = Input$(LOF(FNum), FNum)
  225.                 Close FNum
  226.             Else
  227.                 RichTextBox1.OLEObjects.Add , , Data.Files(i)
  228.             End If
  229.         Next
  230.     End If
  231. PasteDone:
  232. End Sub
  233. Private Sub Text1_OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, x As Single, y As Single)
  234. Dim pic As Picture
  235.     If Data.GetFormat(vbCFFiles) Then
  236.         Text1.Text = "You dropped the following files     :" & vbCrLf
  237.         For i = 1 To Data.Files.Count
  238.             Text1.Text = Text1.Text & Data.Files(i) & vbCrLf
  239.         Next
  240.     End If
  241.     If Data.GetFormat(vbCFRTF) Then
  242.         Text1.Text = Data.GetData(vbCFText)
  243.     End If
  244.     If Data.GetFormat(vbCFBitmap) Then
  245.         imgWidth = Round(ScaleX(Data.GetData(vbCFBitmap).Width, vbHimetric, vbPixels))
  246.         imgHeight = Round(ScaleY(Data.GetData(vbCFBitmap).Height, vbHimetric, vbPixels))
  247.         Text1.Text = "You dropped an image with the following specifications:" & vbCrLf
  248.         Text1.Text = Text1.Text & "WIDTH  " & imgWidth & vbCrLf
  249.         Text1.Text = Text1.Text & "HEIGHT " & imgHeight
  250.     End If
  251. End Sub
  252.