home *** CD-ROM | disk | FTP | other *** search
/ Dan Appleman's Visual Bas…s Guide to the Win32 API / Dan.Applmans.Visual.Basic.5.0.Programmers.Guide.To.The.Win32.API.1997.Ziff-Davis.Press.CD / VB5PG32.mdf / vbpg32 / samples4 / ch08 / analyze.frm (.txt) next >
Encoding:
Visual Basic Form  |  1997-02-16  |  9.1 KB  |  233 lines
  1. VERSION 4.00
  2. Begin VB.Form frmAnalyze 
  3.    Caption         =   "Analyze Metafile"
  4.    ClientHeight    =   3180
  5.    ClientLeft      =   1095
  6.    ClientTop       =   1515
  7.    ClientWidth     =   5160
  8.    Height          =   3585
  9.    Left            =   1035
  10.    LinkTopic       =   "Form1"
  11.    ScaleHeight     =   3180
  12.    ScaleWidth      =   5160
  13.    Top             =   1170
  14.    Width           =   5280
  15.    Begin VB.CheckBox chkSingle 
  16.       Caption         =   "Single Step"
  17.       Height          =   255
  18.       Left            =   3660
  19.       TabIndex        =   3
  20.       Top             =   2220
  21.       Width           =   1395
  22.    End
  23.    Begin VB.PictureBox Picture1 
  24.       Height          =   1275
  25.       Left            =   3660
  26.       ScaleHeight     =   83
  27.       ScaleMode       =   3  'Pixel
  28.       ScaleWidth      =   91
  29.       TabIndex        =   2
  30.       Top             =   840
  31.       Width           =   1395
  32.    End
  33.    Begin VB.CommandButton cmdAnalyze 
  34.       Caption         =   "Analyze"
  35.       Height          =   495
  36.       Left            =   3660
  37.       TabIndex        =   1
  38.       Top             =   180
  39.       Width           =   1395
  40.    End
  41.    Begin VB.ListBox List1 
  42.       Height          =   2955
  43.       Left            =   120
  44.       TabIndex        =   0
  45.       Top             =   120
  46.       Width           =   3375
  47.    End
  48.    Begin Cbkd.Callback Callback1 
  49.       Left            =   4440
  50.       Top             =   2580
  51.       _Version        =   262144
  52.       _ExtentX        =   847
  53.       _ExtentY        =   847
  54.       _StockProps     =   0
  55.       Type            =   3
  56.    End
  57.    Begin MSComDlg.CommonDialog CMDialogMF 
  58.       Left            =   3660
  59.       Top             =   2580
  60.       _ExtentX        =   847
  61.       _ExtentY        =   847
  62.       _Version        =   327680
  63.       Filter          =   """Metafiles (*.wmf)|*.wmf"""
  64.       Flags           =   4100
  65.    End
  66. Attribute VB_Name = "frmAnalyze"
  67. Attribute VB_Creatable = False
  68. Attribute VB_Exposed = False
  69. Option Explicit
  70. ' Copyright 
  71.  1997 by Desaware Inc. All Rights Reserved
  72. ' Set by frmPrompt to include or discard a record
  73. Public IncludeRecord%
  74. Dim Objlist() As Long
  75. Private Sub Callback1_EnumMetaFile(hDC As Long, lpHTable As Long, lpMFR As Long, nObj As Long, lpClientData As Long, retval As Long)
  76.     Dim di&
  77.     Dim f$, od$
  78.     Dim x%
  79.     Dim foundone%
  80.     ReDim Objlist(nObj)
  81.     Dim mr As METARECORD
  82.     agCopyData ByVal lpMFR, mr, Len(mr)
  83.     f$ = GetFunctionName(mr.rdFunction)
  84.     If chkSingle.value Then
  85.         frmPrompt.lblFunc.Caption = f$
  86.         frmPrompt.Show 1
  87.     End If
  88.     If IncludeRecord Then
  89.         di& = PlayMetaFileRecord(hDC, ByVal lpHTable, ByVal lpMFR, ByVal nObj)
  90.         List1.AddItem f$
  91.         If nObj > 0 Then
  92.             agCopyData ByVal lpHTable, Objlist(0), nObj * 4
  93.             For x% = 0 To nObj
  94.                 od$ = GetObjDescription(GetObjectType(Objlist(x)))
  95.                 If od$ <> "" Then
  96.                     If Not foundone% Then List1.AddItem "-- Objects in table"
  97.                     foundone% = True
  98.                     List1.AddItem "   " & od$
  99.                 End If
  100.             Next x%
  101.         End If
  102.     End If
  103.     retval = True
  104. End Sub
  105. Private Sub cmdAnalyze_Click()
  106.     Dim usefile$
  107.     #If Win32 Then
  108.         Dim saved&
  109.         Dim dc&
  110.         Dim usemf&
  111.         Dim di&, dl&
  112.     #Else
  113.         Dim saved%
  114.         Dim dc%
  115.         Dim usemf%
  116.         Dim di%, dl&
  117.     #End If
  118.     Dim oldsize As SIZE
  119.     IncludeRecord = True    ' Initialize value
  120.     List1.Clear             ' Clear list box
  121.     CMDialogMF.DialogTitle = "Load a metafile"
  122.     CMDialogMF.Action = 1
  123.     usefile$ = CMDialogMF.FileName
  124.     If usefile$ <> "" Then
  125.         usemf = LoadTheMetafile(usefile$)
  126.         If usemf <> 0 Then
  127.                 ' Now draw the metafile
  128.             picture1.Cls
  129.             dc = picture1.hDC
  130.             saved = SaveDC(dc)
  131.             ' Now set the new coordinate system. See the CmdExecute()_Click
  132.             ' command for further explanation
  133.             ' Most metafiles will set their own extents, but we need
  134.             ' to set the viewport to match the scalemode of the
  135.             ' entire screen to fill the window
  136.             di = SetMapMode(dc, MM_ANISOTROPIC)
  137.             dl = SetViewportExtEx(dc, picture1.ScaleWidth, picture1.ScaleHeight, oldsize)
  138.             ' All of the drawing objects that were used on the original
  139.             ' objects were saved with the metafile, thus the metafile
  140.             ' will automatically draw each object in the correct color
  141.             ' and style.
  142.             di = EnumMetaFile(dc, usemf, Callback1.ProcAddress, 0)
  143.             ' di = PlayMetaFile(dc, usemf)
  144.             ' And restore the original DC state
  145.             di = RestoreDC(dc, saved)
  146.             di = DeleteMetaFile(usemf)
  147.         End If
  148.     End If
  149. End Sub
  150. Public Function GetFunctionName$(fnum As Integer)
  151.     Select Case fnum
  152.         Case &H817: GetFunctionName = "Arc"
  153.         Case &H830: GetFunctionName = "Chord"
  154.         Case &H418: GetFunctionName = "Ellipse"
  155.         Case &H415: GetFunctionName = "ExcludeClipRect"
  156.         Case &H419: GetFunctionName = "FloodFill"
  157.         Case &H416: GetFunctionName = "IntersectClipRect"
  158.         Case &H213: GetFunctionName = "LineTo"
  159.         Case &H214: GetFunctionName = "MoveTo"
  160.         Case &H220: GetFunctionName = "OffsetClipRgn"
  161.         Case &H211: GetFunctionName = "OffsetViewportOrg"
  162.         Case &H20F: GetFunctionName = "OffsetWindowOrg"
  163.         Case &H211: GetFunctionName = "OffsetViewportOrg"
  164.         Case &H61D: GetFunctionName = "PatBlt"
  165.         Case &H81A: GetFunctionName = "Pie"
  166.         Case &H35: GetFunctionName = "RealizePalette"
  167.         Case &H41B: GetFunctionName = "Rectangle"
  168.         Case &H139: GetFunctionName = "ResizePalette"
  169.         Case &H127: GetFunctionName = "RestoreDC"
  170.         Case &H61C: GetFunctionName = "RoundRect"
  171.         Case &H1E: GetFunctionName = "SaveDC"
  172.         Case &H412: GetFunctionName = "ScaleViewportExt"
  173.         Case &H400: GetFunctionName = "ScaleWindowExt"
  174.         Case &H61C: GetFunctionName = "RoundRect"
  175.         Case &H201: GetFunctionName = "SetBkColor"
  176.         Case &H102: GetFunctionName = "SetBkMode"
  177.         Case &H103: GetFunctionName = "SetMapMode"
  178.         Case &H231: GetFunctionName = "SetMapperFlags"
  179.         Case &H41F: GetFunctionName = "SetPixel"
  180.         Case &H106: GetFunctionName = "SetPolyFillMode"
  181.         Case &H104: GetFunctionName = "SetROP2"
  182.         Case &H107: GetFunctionName = "SetStretchBltMode"
  183.         Case &H12E: GetFunctionName = "SetTextAlign"
  184.         Case &H108: GetFunctionName = "SetTextCharExtra"
  185.         Case &H209: GetFunctionName = "SetTextColor"
  186.         Case &H20A: GetFunctionName = "SetTextJustification"
  187.         Case &H20E: GetFunctionName = "SetViewportExt"
  188.         Case &H20D: GetFunctionName = "SetViewportOrg"
  189.         Case &H20C: GetFunctionName = "SetWindowExt"
  190.         Case &H20B: GetFunctionName = "SetWindowOrg"
  191.         Case &H2FC: GetFunctionName = "CreateBrushIndirect"
  192.         Case &H2FB: GetFunctionName = "CreateFontIndirect"
  193.         Case &HF7: GetFunctionName = "CreatePalette"
  194.         Case &H922: GetFunctionName = "BitBlt (DDB)"
  195.         Case &H940: GetFunctionName = "BitBlt (DIB)"
  196.         Case &H1F9: GetFunctionName = "CreateBrushIndirect (DDB)"
  197.         Case &H142: GetFunctionName = "CreateBrushIndirect (DIB)"
  198.         Case &H2FA: GetFunctionName = "CreatePenIndirect"
  199.         Case &H6FF: GetFunctionName = "CreateRegion"
  200.         Case &H1F0: GetFunctionName = "DeleteObject"
  201.         Case &H626: GetFunctionName = "Escape"
  202.         Case &HA32: GetFunctionName = "ExtTextOut"
  203.         Case &H324: GetFunctionName = "Polygon"
  204.         Case &H538: GetFunctionName = "PolyPolygon"
  205.         Case &H325: GetFunctionName = "Polyline"
  206.         Case &H12C: GetFunctionName = "SelectClipRgn"
  207.         Case &H12D: GetFunctionName = "SelectObject"
  208.         Case &H234: GetFunctionName = "SelectPalette"
  209.         Case &HD33: GetFunctionName = "SetDIBitsToDevice"
  210.         Case &H37: GetFunctionName = "SetPaletteEntries"
  211.         Case &HB23: GetFunctionName = "StretchBlt (DDB)"
  212.         Case &HB41: GetFunctionName = "StretchBlt (DIB)"
  213.         Case &HF43: GetFunctionName = "StretchDIBits"
  214.         Case &H521: GetFunctionName = "TextOut"
  215.     End Select
  216. End Function
  217. Public Function GetObjDescription$(objnum)
  218.     Select Case objnum
  219.         Case OBJ_PEN:   GetObjDescription$ = "Pen"
  220.         Case OBJ_BRUSH:   GetObjDescription$ = "Brush"
  221.         Case OBJ_DC:   GetObjDescription$ = "Device Context"
  222.         Case OBJ_METADC:   GetObjDescription$ = "Metafile Device Context"
  223.         Case OBJ_PAL:   GetObjDescription$ = "Palette"
  224.         Case OBJ_FONT:   GetObjDescription$ = "Font"
  225.         Case OBJ_BITMAP:   GetObjDescription$ = "Bitmap"
  226.         Case OBJ_REGION:   GetObjDescription$ = "Region"
  227.         Case OBJ_METAFILE:   GetObjDescription$ = "Metafile"
  228.         Case OBJ_MEMDC:   GetObjDescription$ = "Memory device context"
  229.         Case OBJ_EXTPEN:   GetObjDescription$ = "Extended Pen"
  230.         Case OBJ_ENHMETAFILE:   GetObjDescription$ = "Enhanced metafile"
  231.     End Select
  232. End Function
  233.