home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / ole2bm / ole2bm.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1995-05-02  |  6.0 KB  |  173 lines
  1. VERSION 2.00
  2. Begin Form frmDemo 
  3.    BackColor       =   &H00C0C0C0&
  4.    BorderStyle     =   1  'Fixed Single
  5.    Caption         =   "OLE 2.0 To Bitmap Demo"
  6.    ClientHeight    =   3915
  7.    ClientLeft      =   1095
  8.    ClientTop       =   1470
  9.    ClientWidth     =   6315
  10.    Height          =   4320
  11.    Left            =   1035
  12.    MaxButton       =   0   'False
  13.    ScaleHeight     =   3915
  14.    ScaleWidth      =   6315
  15.    Top             =   1125
  16.    Width           =   6435
  17.    Begin CommandButton cmdEdit 
  18.       Caption         =   "&Edit Picture Box Bitmap"
  19.       Default         =   -1  'True
  20.       FontBold        =   -1  'True
  21.       FontItalic      =   0   'False
  22.       FontName        =   "MS Sans Serif"
  23.       FontSize        =   9.75
  24.       FontStrikethru  =   0   'False
  25.       FontUnderline   =   0   'False
  26.       Height          =   435
  27.       Left            =   0
  28.       TabIndex        =   0
  29.       Top             =   3480
  30.       Width           =   3195
  31.    End
  32.    Begin OLE olePbrush 
  33.       AutoActivate    =   0  'Manual
  34.       Class           =   "PBrush"
  35.       fFFHk           =   -1  'True
  36.       Height          =   2955
  37.       Left            =   3240
  38.       OleObjectBlob   =   OLE2BM.FRX:0000
  39.       OLETypeAllowed  =   1  'Embedded
  40.       TabIndex        =   3
  41.       Top             =   120
  42.       Width           =   2955
  43.    End
  44.    Begin PictureBox picBitmap 
  45.       AutoRedraw      =   -1  'True
  46.       DrawStyle       =   6  'Inside Solid
  47.       DrawWidth       =   12
  48.       FontBold        =   -1  'True
  49.       FontItalic      =   0   'False
  50.       FontName        =   "MS Sans Serif"
  51.       FontSize        =   30
  52.       FontStrikethru  =   0   'False
  53.       FontUnderline   =   0   'False
  54.       Height          =   2955
  55.       Left            =   120
  56.       ScaleHeight     =   195
  57.       ScaleMode       =   3  'Pixel
  58.       ScaleWidth      =   195
  59.       TabIndex        =   2
  60.       Top             =   120
  61.       Width           =   2955
  62.    End
  63.    Begin CommandButton cmdQuit 
  64.       Cancel          =   -1  'True
  65.       Caption         =   "&Quit"
  66.       FontBold        =   -1  'True
  67.       FontItalic      =   0   'False
  68.       FontName        =   "MS Sans Serif"
  69.       FontSize        =   9.75
  70.       FontStrikethru  =   0   'False
  71.       FontUnderline   =   0   'False
  72.       Height          =   435
  73.       Left            =   3180
  74.       TabIndex        =   1
  75.       Top             =   3480
  76.       Width           =   3135
  77.    End
  78.    Begin Label lblImage 
  79.       BackStyle       =   0  'Transparent
  80.       Caption         =   "OLE 2.0 PaintBrush Object"
  81.       Height          =   315
  82.       Index           =   1
  83.       Left            =   3240
  84.       TabIndex        =   5
  85.       Top             =   3120
  86.       Width           =   2955
  87.    End
  88.    Begin Label lblImage 
  89.       BackStyle       =   0  'Transparent
  90.       Caption         =   "VB Picture Box Bitmap"
  91.       Height          =   315
  92.       Index           =   0
  93.       Left            =   120
  94.       TabIndex        =   4
  95.       Top             =   3120
  96.       Width           =   2955
  97.    End
  98. '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  99. ' OLE2BM.FRM
  100. '____________________________________________________________________________
  101. Option Explicit
  102. DefInt A-Z
  103. Dim PictureStale
  104. '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  105. ' Embed bitmap in OLE 2.0 object and open PaintBrush to edit it.
  106. '____________________________________________________________________________
  107. Sub cmdEdit_Click ()
  108.     Pic2Ole picBitmap, olePbrush
  109.     PictureStale = True
  110.     olePbrush.Action = OLE_ACTIVATE
  111. End Sub
  112. '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  113. ' Quit the program.
  114. '____________________________________________________________________________
  115. Sub cmdQuit_Click ()
  116.     End
  117. End Sub
  118. '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  119. ' Make sure the picture box gets painted on loading.
  120. '____________________________________________________________________________
  121. Sub Form_Paint ()
  122.     picBitmap_Paint
  123. End Sub
  124. '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  125. ' Embed bitmap in OLE 2.0 object and open PaintBrush to edit it.
  126. '____________________________________________________________________________
  127. Sub olePbrush_Click ()
  128.     cmdEdit = True
  129. End Sub
  130. '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  131. ' Update picture box if PaintBrush object data has changed.
  132. '____________________________________________________________________________
  133. Sub olePbrush_Updated (Code As Integer)
  134.     If PictureStale And Code = OLE_CHANGED Then
  135.         Ole2Pic picBitmap, olePbrush
  136.         PictureStale = False         ' Prevent cascading Updated event
  137.     End If
  138. End Sub
  139. '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  140. ' Edit the source bitmap.
  141. '____________________________________________________________________________
  142. Sub picBitmap_DblClick ()
  143.     cmdEdit = True
  144. End Sub
  145. '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  146. ' Draw the source bitmap on loading.
  147. '____________________________________________________________________________
  148. Sub picBitmap_Paint ()
  149. Static called
  150. Dim h, w, xc, xl, xr, yb, yc, yt
  151. Dim red As Long
  152. Const msg$ = "KLUDGE"
  153.     If Not called Then    ' Paint just once to preserve edits
  154.         xl = 0
  155.         xr = picBitmap.ScaleWidth
  156.         xc = xr \ 2
  157.         yt = 0
  158.         yb = picBitmap.ScaleHeight
  159.         yc = yb \ 2
  160.         w = picBitmap.TextWidth(msg$)
  161.         h = picBitmap.TextHeight(msg$)
  162.         red = QBColor(4)
  163.         picBitmap.CurrentX = (xr - w) \ 2
  164.         picBitmap.CurrentY = (yb - h) \ 2
  165.         picBitmap.Print msg$
  166.         picBitmap.Circle (xc, yc), xc, red
  167.         picBitmap.Line (xr, yt)-(xl, yb), red
  168.         picBitmap.Refresh
  169.         called = True
  170.     End If
  171.         
  172. End Sub
  173.