home *** CD-ROM | disk | FTP | other *** search
/ Personal Computer World 2002 March / PCWMAR02.iso / software / turbocad / v8trial / TurboCADv8ProfessionalNoReg.exe / Data.Cab / F40750_frmBitmapTest.frm < prev    next >
Encoding:
Text File  |  2001-10-16  |  2.3 KB  |  68 lines
  1. VERSION 5.00
  2. Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} frmBitmapTest 
  3.    Caption         =   "SDK Bitmap Test"
  4.    ClientHeight    =   5664
  5.    ClientLeft      =   48
  6.    ClientTop       =   336
  7.    ClientWidth     =   6120
  8.    OleObjectBlob   =   "frmBitmapTest.frx":0000
  9.    StartUpPosition =   1  'CenterOwner
  10. End
  11. Attribute VB_Name = "frmBitmapTest"
  12. Attribute VB_GlobalNameSpace = False
  13. Attribute VB_Creatable = False
  14. Attribute VB_PredeclaredId = True
  15. Attribute VB_Exposed = False
  16.  
  17. '******************************************************************'
  18. '*                                                                *'
  19. '*                      TurboCAD for Windows                      *'
  20. '*                   Copyright (c) 1993 - 2001                    *'
  21. '*             International Microcomputer Software, Inc.         *'
  22. '*                            (IMSI)                              *'
  23. '*                      All rights reserved.                      *'
  24. '*                                                                *'
  25. '******************************************************************'
  26.  
  27. Private Declare Function BitmapToPicture Lib "ViewPict" _
  28.    (ByVal hDIB As Long) As Object
  29.  
  30. Private Declare Function MetafileToPicture Lib "ViewPict" _
  31.    (ByVal hMeta As Long, ByVal width As Long, ByVal height As Long) As Object
  32.  
  33. Private Sub btnBitmap_Click()
  34.     Dim obPic As StdPicture
  35.     Dim vwActive As View
  36.     Dim hDC As Long
  37.     Dim hDIB As Long
  38.     Set vwActive = ActiveDrawing.ActiveView
  39.     hDC = vwActive.OpenBitmapDC
  40.     vwActive.Refresh
  41.     hDIB = vwActive.CloseBitmapDC
  42.     Set obPic = BitmapToPicture(hDIB)
  43.     If Not obPic Is Nothing Then
  44.         Image1.Picture = obPic
  45.     End If
  46. End Sub
  47.  
  48. Private Sub btnMetafile_Click()
  49.     Dim obPic As StdPicture
  50.     Dim vwActive As View
  51.     Dim hDC As Long
  52.     Dim hMeta As Long
  53.     Dim width, height As Long
  54.     Set vwActive = ActiveDrawing.ActiveView
  55.     hDC = vwActive.OpenMetafileDC
  56.     vwActive.Refresh
  57.     hMeta = vwActive.CloseMetafileDC
  58.     width = Image1.width * 1.3333
  59.     height = Image1.height * 1.3333
  60.     Set obPic = MetafileToPicture(hMeta, width, height)
  61.     If Not obPic Is Nothing Then
  62.         'For some reason, the metafile picture is there,
  63.         'But nothing is drawn
  64.         Image1.Picture = obPic
  65.     End If
  66. End Sub
  67.  
  68.