home *** CD-ROM | disk | FTP | other *** search
/ PC Pro 1998 February / DPPCPRO0298.ISO / code / winint.txt < prev    next >
Encoding:
Text File  |  1997-11-27  |  2.4 KB  |  115 lines
  1. Listing  1
  2.  
  3. Private Sub Command1_Click()
  4. On Error Resume Next
  5.  
  6. 'Create the raw metafile
  7. fl$ = "c:\temp\test.tmr"
  8. Meta = CreateMetafile(ByVal fl$)
  9.  
  10. 'Set metafile co-ordinates
  11. e = SetMapMode(Meta, 8)
  12. e = SetWindowOrg(Meta, 0, 800)
  13. e = SetWindowExt(Meta, 800, -800)
  14. 'Definitive Office 97 cure: place the origin top left
  15. 'e = SetWindowOrg(Meta, 0, 0)
  16. 'e = SetWindowExt(Meta, 800, 800)
  17.  
  18. 'Select null brush and black pen
  19. Brush = GetStockObject(5)
  20. Pen = GetStockObject(7)
  21. e = SelectObject(Meta, Pen)
  22. e = SelectObject(Meta, Brush)
  23.  
  24. 'Box Method 1: Draw box using lines
  25. 'Causes box to disappear when converted to drawing objects in Office 97
  26. 'unless co-ordinates reset as above
  27. e = MoveTo(Meta, 200, 200)
  28. e = LineTo(Meta, 600, 200)
  29. e = LineTo(Meta, 600, 600)
  30. e = LineTo(Meta, 200, 600)
  31. e = LineTo(Meta, 200, 200)
  32. 'Box Method 1b: cross the box
  33. 'OK in Office 97
  34. 'e = LineTo(Meta, 600, 600)
  35.  
  36. 'Box Method 2: Draw box using rectangle API call
  37. 'Sometimes OK in Office 97 - does NOT always work in more complex drawings!
  38. 'e = Rectangle(Meta, 200, 200, 600, 600)
  39.  
  40. 'Box Method 3: Draw box using polygon API call
  41. 'OK in Office 97
  42. 'ReDim pt(4) As POINTAPI
  43. 'pt(0).x = 200
  44. 'pt(0).y = 200
  45. 'pt(1).x = 200
  46. 'pt(1).y = 600
  47. 'pt(2).x = 600
  48. 'pt(2).y = 600
  49. 'pt(3).x = 600
  50. 'pt(3).y = 200
  51. 'pt(4).x = 200
  52. 'pt(4).y = 200
  53. 'e = Polygon(Meta, pt(0), 5)
  54.  
  55. 'Draw right hand tail and whiskers
  56. e = MoveTo(Meta, 600, 400)
  57. e = LineTo(Meta, 700, 400)
  58. e = MoveTo(Meta, 700, 600)
  59. e = LineTo(Meta, 700, 200)
  60.  
  61. 'Draw left hand tail and whiskers
  62. e = MoveTo(Meta, 200, 400)
  63. e = LineTo(Meta, 100, 400)
  64. e = MoveTo(Meta, 100, 600)
  65. e = LineTo(Meta, 100, 200)
  66.  
  67. 'Clean up resources and close metafile
  68. e = DeleteObject(Pen)
  69. e = DeleteObject(Brush)
  70. e = DeleteMetaFile(CloseMetafile(Meta))
  71.  
  72. 'Make placeable header
  73. With MFHDR
  74.   .Key = &H9AC6CDD7
  75.   .Handle = 0
  76.   .Inch = 210
  77.   .Resvd = 0
  78. End With
  79. With MFHDR.bbox
  80.   .l = 0
  81.   .t = 0
  82.   .r = metaw%
  83.   .b = metah%
  84. End With
  85.  
  86. p$ = "c:\temp\testok.wmf"
  87. Kill p$
  88. Hout = FreeFile
  89. Open p$ For Binary As #Hout
  90. Put #Hout, , MFHDR
  91.  
  92. 'Create and write the checksum
  93. Get #Hout, 1, XO
  94. For c = 0 To 9
  95.   s = s Xor XO.XorInt(c)
  96. Next
  97. MFHDR.XSum = s
  98. Put #Hout, 1, MFHDR
  99.  
  100. 'Allow for WMF > 64K
  101. Hin = FreeFile
  102. Open fl$ For Binary As #Hin
  103. d$ = Space$(16384)
  104. For Chunk = 1 To LOF(Hin) \ 16384
  105.  Get #Hin, , d$
  106.  Put #Hout, , d$
  107. Next
  108. d$ = Space$(LOF(Hin) Mod 16384)
  109. Get #Hin, , d$
  110. Put #Hout, , d$
  111. Close #Hin
  112. Close #Hout
  113.  
  114. End Sub
  115.