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 / samples5 / ch08 / quikdraw.bas < prev    next >
Encoding:
BASIC Source File  |  1997-02-16  |  18.5 KB  |  477 lines
  1. Attribute VB_Name = "QUIKDRAW1"
  2. Option Explicit
  3. ' Copyright ⌐ 1997 by Desaware Inc. All Rights Reserved
  4.  
  5. ' QuikDraw program example
  6.  
  7. ' Porting notes:
  8. '  Win16 API's defined as Sub are changed to functions returning
  9. '   integers. This is safe (we ignore the values) as sub vs return
  10. '   integer or long has same stack frames.
  11.  
  12.  
  13. #If Win32 Then
  14.  
  15. Type RECT
  16.         Left As Long
  17.         Top As Long
  18.         Right As Long
  19.         Bottom As Long
  20. End Type
  21.  
  22. Type POINTAPI
  23.         x As Long
  24.         y As Long
  25. End Type
  26.  
  27. Type SIZE
  28.         cx As Long
  29.         cy As Long
  30. End Type
  31.  
  32. Type METAFILEPICT
  33.         mm As Long
  34.         xExt As Long
  35.         yExt As Long
  36.         hMF As Long
  37. End Type
  38.  
  39. Type METARECORD
  40.         rdSize As Long
  41.         rdFunction As Integer
  42.         rdParm(1) As Integer
  43. End Type
  44.  
  45. Declare Function Arc& Lib "gdi32" (ByVal hDC As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal X3 As Long, ByVal Y3 As Long, ByVal X4 As Long, ByVal Y4 As Long)
  46. Declare Function Chord& Lib "gdi32" (ByVal hDC As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal X3 As Long, ByVal Y3 As Long, ByVal X4 As Long, ByVal Y4 As Long)
  47. Declare Function CloseClipboard& Lib "user32" ()
  48. Declare Function CloseMetaFile& Lib "gdi32" (ByVal hMF As Long)
  49. Declare Function CreateHatchBrush& Lib "gdi32" (ByVal nIndex As Long, ByVal crColor As Long)
  50. Declare Function CreateMetaFile& Lib "gdi32" Alias "CreateMetaFileA" (ByVal lpstring As String)
  51. Declare Function CreatePen& Lib "gdi32" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long)
  52. Declare Function CreateSolidBrush& Lib "gdi32" (ByVal crColor As Long)
  53. Declare Function DeleteMetaFile& Lib "gdi32" (ByVal hMF As Long)
  54. Declare Function DeleteObject& Lib "gdi32" (ByVal hObject As Long)
  55. Declare Function DrawFocusRect& Lib "user32" (ByVal hDC As Long, lpRect As RECT)
  56. Declare Function Ellipse& Lib "gdi32" (ByVal hDC As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long)
  57. Declare Function EmptyClipboard& Lib "user32" ()
  58. Declare Function EnumMetaFile Lib "gdi32" (ByVal hDC As Long, ByVal hMF As Long, ByVal lpCallbackFunc As Long, ByVal lpClientData As Long) As Long
  59. Declare Function GetClientRect& Lib "user32" (ByVal hwnd As Long, lpRect As RECT)
  60. Declare Function GetMetaFileBitsEx& Lib "gdi32" (ByVal hMF As Long, ByVal nSize As Long, lpvData As Any)
  61. Declare Function GlobalAlloc& Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long)
  62. Declare Function GlobalFree& Lib "kernel32" (ByVal hMem As Long)
  63. Declare Function GlobalLock& Lib "kernel32" (ByVal hMem As Long)
  64. Declare Function GetObjectType& Lib "gdi32" (ByVal hgdiobj As Long)
  65. Declare Function GlobalSize Lib "kernel32" (ByVal hMem As Long) As Long
  66. Declare Function GlobalUnlock& Lib "kernel32" (ByVal hMem As Long)
  67. Declare Function InflateRect& Lib "user32" (lpRect As RECT, ByVal x As Long, ByVal y As Long)
  68. Declare Function LineTo& Lib "gdi32" (ByVal hDC As Long, ByVal x As Long, ByVal y As Long)
  69. Declare Function MoveToEx Lib "gdi32" (ByVal hDC As Long, ByVal x As Long, ByVal y As Long, lpPoint As POINTAPI) As Long
  70. Declare Function OpenClipboard& Lib "user32" (ByVal hwnd As Long)
  71. Declare Function Pie& Lib "gdi32" (ByVal hDC As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal X3 As Long, ByVal Y3 As Long, ByVal X4 As Long, ByVal Y4 As Long)
  72. Declare Function PlayMetaFile& Lib "gdi32" (ByVal hDC As Long, ByVal hMF As Long)
  73. Declare Function PlayMetaFileRecord& Lib "gdi32" (ByVal hDC As Long, ByVal lpHandletable As Long, lpMetaRecord As Any, ByVal nHandles As Long)
  74. Declare Function Polyline& Lib "gdi32" (ByVal hDC As Long, lpPoint As POINTAPI, ByVal nCount As Long)
  75. Declare Function Polygon& Lib "gdi32" (ByVal hDC As Long, lpPoint As POINTAPI, ByVal nCount As Long)
  76. Declare Function Rectangle& Lib "gdi32" (ByVal hDC As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long)
  77. Declare Function RestoreDC& Lib "gdi32" (ByVal hDC As Long, ByVal nSavedDC As Long)
  78. Declare Function SaveDC& Lib "gdi32" (ByVal hDC As Long)
  79. Declare Function SelectObject& Lib "gdi32" (ByVal hDC As Long, ByVal hObject As Long)
  80. Declare Function SetClipboardData& Lib "user32" (ByVal wFormat As Long, ByVal hMem As Long)
  81. Declare Function SetMapMode& Lib "gdi32" (ByVal hDC As Long, ByVal nMapMode As Long)
  82. Declare Function SetMetaFileBitsEx& Lib "gdi32" (ByVal nSize As Long, lpData As Byte)
  83. Declare Function SetMetaFileBitsBuffer& Lib "gdi32" Alias "SetMetaFileBitsEx" (ByVal nSize As Long, ByVal lpData As Long)
  84.  
  85. Declare Function SetPolyFillMode& Lib "gdi32" (ByVal hDC As Long, ByVal nPolyFillMode As Long)
  86. Declare Function SetRect& Lib "user32" (lpRect As RECT, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long)
  87. Declare Function SetViewportExtEx& Lib "gdi32" (ByVal hDC As Long, ByVal nX As Long, ByVal nY As Long, lpSize As SIZE)
  88. Declare Function SetViewportOrgEx& Lib "gdi32" (ByVal hDC As Long, ByVal nX As Long, ByVal nY As Long, lpPoint As POINTAPI)
  89. Declare Function SetWindowOrgEx& Lib "gdi32" (ByVal hDC As Long, ByVal nX As Long, ByVal nY As Long, lpPoint As POINTAPI)
  90. Declare Function SetWindowExtEx& Lib "gdi32" (ByVal hDC As Long, ByVal nX As Long, ByVal nY As Long, lpSize As SIZE)
  91.  
  92. Declare Function lopen Lib "kernel32" Alias "_lopen" (ByVal lpPathName As String, ByVal iReadWrite As Long) As Long
  93. Declare Function lclose Lib "kernel32" Alias "_lclose" (ByVal hFile As Long) As Long
  94. Declare Function lcreat Lib "kernel32" Alias "_lcreat" (ByVal lpPathName As String, ByVal iAttribute As Long) As Long
  95. Declare Function llseek Lib "kernel32" Alias "_llseek" (ByVal hFile As Long, ByVal lOffset As Long, ByVal iOrigin As Long) As Long
  96. Declare Function lread Lib "kernel32" Alias "_lread" (ByVal hFile As Long, lpBuffer As Any, ByVal wBytes As Long) As Long
  97. Declare Function lwrite Lib "kernel32" Alias "_lwrite" (ByVal hFile As Long, lpBuffer As Any, ByVal wBytes As Long) As Long
  98.  
  99. Declare Function hread Lib "kernel32" Alias "_hread" (ByVal hFile As Long, lpBuffer As Any, ByVal lBytes As Long) As Long
  100. Declare Function hwrite Lib "kernel32" Alias "_hwrite" (ByVal hFile As Long, lpBuffer As Any, ByVal lBytes As Long) As Long
  101.  
  102. #Else
  103.  
  104. Type RECT
  105.         Left As Integer
  106.         Top As Integer
  107.         Right As Integer
  108.         Bottom As Integer
  109. End Type
  110.  
  111. Type POINTAPI
  112.         x As Integer
  113.         y As Integer
  114. End Type
  115.  
  116. Type SIZE
  117.         cx As Integer
  118.         cy As Integer
  119. End Type
  120.  
  121. Type METAFILEPICT    '8 Bytes
  122.     mm As Integer
  123.     xExt As Integer
  124.     yExt As Integer
  125.     hMF As Integer
  126. End Type
  127.  
  128. Declare Function Arc% Lib "GDI" (ByVal hDC%, ByVal X1%, ByVal Y1%, ByVal X2%, ByVal Y2%, ByVal X3%, ByVal Y3%, ByVal X4%, ByVal Y4%)
  129. Declare Function Chord% Lib "GDI" (ByVal hDC%, ByVal X1%, ByVal Y1%, ByVal X2%, ByVal Y2%, ByVal X3%, ByVal Y3%, ByVal X4%, ByVal Y4%)
  130. Declare Function CloseClipboard% Lib "User" ()
  131. Declare Function CloseMetaFile% Lib "GDI" (ByVal hMF%)
  132. Declare Function CreateHatchBrush% Lib "GDI" (ByVal nIndex%, ByVal crColor&)
  133. Declare Function CreateMetaFile% Lib "GDI" (ByVal lpstring$)
  134. Declare Function CreatePen% Lib "GDI" (ByVal nPenStyle%, ByVal nWidth%, ByVal crColor&)
  135. Declare Function CreateSolidBrush% Lib "GDI" (ByVal crColor&)
  136. Declare Function DeleteMetaFile% Lib "GDI" (ByVal hMF%)
  137. Declare Function DeleteObject% Lib "GDI" (ByVal hObject%)
  138. Declare Function DrawFocusRect% Lib "User" (ByVal hDC%, lpRect As RECT)
  139. Declare Function Ellipse% Lib "GDI" (ByVal hDC%, ByVal X1%, ByVal Y1%, ByVal X2%, ByVal Y2%)
  140. Declare Function EmptyClipboard% Lib "User" ()
  141. Declare Function GetClientRect% Lib "User" (ByVal hwnd%, lpRect As RECT)
  142. Declare Function GetMetaFileBits% Lib "GDI" (ByVal hMF%)
  143. Declare Function GlobalAlloc% Lib "Kernel" (ByVal wFlags%, ByVal dwBytes&)
  144. Declare Function GlobalFree% Lib "Kernel" (ByVal hMem%)
  145. Declare Function GlobalLock& Lib "Kernel" (ByVal hMem%)
  146. Declare Function GlobalSize& Lib "Kernel" (ByVal hMem%)
  147. Declare Function GlobalUnlock% Lib "Kernel" (ByVal hMem%)
  148. Declare Function InflateRect% Lib "User" (lpRect As RECT, ByVal x%, ByVal y%)
  149. Declare Function LineTo% Lib "GDI" (ByVal hDC%, ByVal x%, ByVal y%)
  150. Declare Function MoveToEx& Lib "GDI" (ByVal hDC%, ByVal x%, ByVal y%, lpPoint As POINTAPI)
  151. Declare Function OpenClipboard% Lib "User" (ByVal hwnd%)
  152. Declare Function Pie% Lib "GDI" (ByVal hDC%, ByVal X1%, ByVal Y1%, ByVal X2%, ByVal Y2%, ByVal X3%, ByVal Y3%, ByVal X4%, ByVal Y4%)
  153. Declare Function PlayMetaFile% Lib "GDI" (ByVal hDC%, ByVal hMF%)
  154. Declare Function Polygon% Lib "GDI" (ByVal hDC%, lpPoints As POINTAPI, ByVal nCount%)
  155. Declare Function Polyline% Lib "GDI" (ByVal hDC%, lpPoints As POINTAPI, ByVal nCount%)
  156. Declare Function Rectangle% Lib "GDI" (ByVal hDC%, ByVal X1%, ByVal Y1%, ByVal X2%, ByVal Y2%)
  157. Declare Function RestoreDC% Lib "GDI" (ByVal hDC%, ByVal nSavedDC%)
  158. Declare Function SaveDC% Lib "GDI" (ByVal hDC%)
  159. Declare Function SelectObject% Lib "GDI" (ByVal hDC%, ByVal hObject%)
  160. Declare Function SetClipboardData% Lib "User" (ByVal wFormat%, ByVal hMem%)
  161. Declare Function SetMapMode% Lib "GDI" (ByVal hDC%, ByVal nMapMode%)
  162. Declare Function SetMetaFileBitsBetter% Lib "GDI" (ByVal hMF%)
  163. Declare Function SetPolyFillMode% Lib "GDI" (ByVal hDC%, ByVal nPolyFillMode%)
  164. Declare Function SetViewportExtEx% Lib "GDI" (ByVal hDC%, ByVal nX%, ByVal nY%, lpSize As SIZE)
  165. Declare Function SetViewportOrgEx% Lib "GDI" (ByVal hDC%, ByVal x%, ByVal y%, lpSize As SIZE)
  166. Declare Function SetWindowExtEx% Lib "GDI" (ByVal hDC%, ByVal x%, ByVal y%, lpSize As SIZE)
  167. Declare Function SetWindowOrgEx% Lib "GDI" (ByVal hDC%, ByVal x%, ByVal y%, lpSize As SIZE)
  168. Declare Function SetRect% Lib "User" (lpRect As RECT, ByVal X1%, ByVal Y1%, ByVal X2%, ByVal Y2%)
  169.  
  170. Declare Function lopen% Lib "Kernel" Alias "_lopen" (ByVal lpPathName$, ByVal iReadWrite%)
  171. Declare Function lclose% Lib "Kernel" Alias "_lclose" (ByVal hFile%)
  172. Declare Function lcreat% Lib "Kernel" Alias "_lcreat" (ByVal lpPathName$, ByVal iAttribute%)
  173. Declare Function llseek& Lib "Kernel" Alias "_llseek" (ByVal hFile%, ByVal lOffset&, ByVal iOrigin%)
  174. Declare Function lread% Lib "Kernel" Alias "_lread" (ByVal hFile%, lpBuffer As Any, ByVal wBytes%)
  175. Declare Function lwrite% Lib "Kernel" Alias "_lwrite" (ByVal hFile%, lpBuffer As Any, ByVal wBytes%)
  176. Declare Function hread& Lib "Kernel" Alias "_hread" (ByVal hf%, hpvBuffer As Any, ByVal cbBuffer&)
  177. Declare Function hwrite& Lib "Kernel" Alias "_hwrite" (ByVal hf%, hpvBuffer As Any, ByVal cbBuffer&)
  178.  
  179. #End If
  180.  
  181. Type RECTS
  182.         Left As Integer
  183.         Top As Integer
  184.         Right As Integer
  185.         Bottom As Integer
  186. End Type
  187.  
  188. ' Not how RECT does not change within a structure
  189. ' that is saved on disk and is Win16 compatible!
  190. Type METAFILEHEADER     ' 22 bytes
  191.     key As Long
  192.     hMF As Integer
  193.     bbox As RECTS
  194.     inch As Integer
  195.     reserved As Long
  196.     checksum As Integer
  197. End Type
  198.  
  199. Public Const OBJ_PEN = 1
  200. Public Const OBJ_BRUSH = 2
  201. Public Const OBJ_DC = 3
  202. Public Const OBJ_METADC = 4
  203. Public Const OBJ_PAL = 5
  204. Public Const OBJ_FONT = 6
  205. Public Const OBJ_BITMAP = 7
  206. Public Const OBJ_REGION = 8
  207. Public Const OBJ_METAFILE = 9
  208. Public Const OBJ_MEMDC = 10
  209. Public Const OBJ_EXTPEN = 11
  210. Public Const OBJ_ENHMETADC = 12
  211. Public Const OBJ_ENHMETAFILE = 13
  212.  
  213. ' Application global variables
  214.  
  215. #If Win32 Then
  216.     ' Metafile to hold objects
  217.     Public hndMetaFile&
  218.     
  219.     ' Private Pen and Brush to use
  220.     Public hndPen&
  221.     Public hndBrush&
  222. #Else
  223.     ' Metafile to hold objects
  224.     Public hndMetaFile%
  225.     
  226.     ' Private Pen and Brush to use
  227.     Public hndPen%
  228.     Public hndBrush%
  229.     
  230. #End If
  231.  
  232. ' Application global variables
  233. Public MaxPoints%   ' Maximum points to use this drawing mode
  234. Public PointsUsed%  ' Number of points used.
  235. ' Array of points
  236. Public PointArray(32) As POINTAPI
  237.  
  238. ' Current drawing mode - most recent Draw menu index
  239. Public LastDrawIndex%
  240.  
  241. ' This flag is set to -1 after the Execute button is pressed.
  242. ' This is an indication that the next click in Picture1 should
  243. ' start a new object.
  244. Public LastWasExecute%
  245.  
  246.  
  247. ' Public constants imported from APICONST.TXT
  248. Public Const R2_BLACK = 1
  249. Public Const R2_NOTMERGEPEN = 2
  250. Public Const R2_MASKNOTPEN = 3
  251. Public Const R2_NOTCOPYPEN = 4
  252. Public Const R2_MASKPENNOT = 5
  253. Public Const R2_NOT = 6
  254. Public Const R2_XORPEN = 7
  255. Public Const R2_NOTMASKPEN = 8
  256. Public Const R2_MASKPEN = 9
  257. Public Const R2_NOTXORPEN = 10
  258. Public Const R2_NOP = 11
  259. Public Const R2_MERGENOTPEN = 12
  260. Public Const R2_COPYPEN = 13
  261. Public Const R2_MERGEPENNOT = 14
  262. Public Const R2_MERGEPEN = 15
  263. Public Const R2_WHITE = 16
  264. Public Const ALTERNATE = 1
  265. Public Const WINDING = 2
  266. Public Const TRANSPARENT = 1
  267. Public Const OPAQUE = 2
  268. Public Const MM_TEXT = 1
  269. Public Const MM_LOMETRIC = 2
  270. Public Const MM_HIMETRIC = 3
  271. Public Const MM_LOENGLISH = 4
  272. Public Const MM_HIENGLISH = 5
  273. Public Const MM_TWIPS = 6
  274. Public Const MM_ISOTROPIC = 7
  275. Public Const MM_ANISOTROPIC = 8
  276. Public Const ABSOLUTE = 1
  277. Public Const RELATIVE = 2
  278. Public Const WHITE_BRUSH = 0
  279. Public Const LTGRAY_BRUSH = 1
  280. Public Const GRAY_BRUSH = 2
  281. Public Const DKGRAY_BRUSH = 3
  282. Public Const BLACK_BRUSH = 4
  283. Public Const NULL_BRUSH = 5
  284. Public Const HOLLOW_BRUSH = NULL_BRUSH
  285. Public Const WHITE_PEN = 6
  286. Public Const BLACK_PEN = 7
  287. Public Const NULL_PEN = 8
  288. Public Const OEM_FIXED_FONT = 10
  289. Public Const ANSI_FIXED_FONT = 11
  290. Public Const ANSI_VAR_FONT = 12
  291. Public Const SYSTEM_FONT = 13
  292. Public Const DEVICE_DEFAULT_FONT = 14
  293. Public Const DEFAULT_PALETTE = 15
  294. Public Const SYSTEM_FIXED_FONT = 16
  295. Public Const PS_SOLID = 0
  296. Public Const PS_DASH = 1
  297. Public Const PS_DOT = 2
  298. Public Const PS_DASHDOT = 3
  299. Public Const PS_DASHDOTDOT = 4
  300. Public Const PS_NULL = 5
  301. Public Const PS_INSIDEFRAME = 6
  302. Public Const HS_HORIZONTAL = 0
  303. Public Const HS_VERTICAL = 1
  304. Public Const HS_FDIAGONAL = 2
  305. Public Const HS_BDIAGONAL = 3
  306. Public Const HS_CROSS = 4
  307. Public Const HS_DIAGCROSS = 5
  308.  
  309. Public Const GMEM_MOVEABLE = &H2
  310. Public Const CF_METAFILEPICT = 3
  311. Public Const GMEM_ZEROINIT = &H40
  312.  
  313. '
  314. ' Yes, it is possible for function declarations to change as well
  315. '
  316. #If Win32 Then
  317. Function LoadTheMetafile(FileName$) As Long
  318. #Else
  319. Function LoadTheMetafile(FileName$) As Integer
  320. #End If
  321.     #If Win32 Then
  322.         Dim fhnd&
  323.         Dim di&, dl&
  324.         Dim mfglbhnd&
  325.         Dim mfhnd&
  326.     #Else
  327.         Dim fhnd%
  328.         Dim di%, dl&
  329.         Dim mfglbhnd%
  330.         Dim mfhnd%
  331.     #End If
  332.     Dim mfile As METAFILEHEADER
  333.  
  334.     Dim mfinfosize&
  335.     Dim currentfileloc&
  336.     Dim gptr&
  337.  
  338.     ' Open the file to read
  339.     fhnd = lopen(FileName$, 0)
  340.     If fhnd < 0 Then Exit Function
  341.  
  342.  
  343.     ' First read the placeable header file header
  344.     di = lread(fhnd, mfile, Len(mfile))
  345.     If mfile.key <> &H9AC6CDD7 Then
  346.         ' It's not a placeable metafile - so just seek to the start
  347.         di = llseek(fhnd, 0, 0)
  348.     End If
  349.     
  350.     ' Now we need a buffer that will contain the metafile data
  351.     currentfileloc& = llseek(fhnd, 0, 1)
  352.     mfinfosize& = llseek(fhnd, 0, 2) - currentfileloc&
  353.  
  354.     
  355.     ' Now allocate a buffer to hold the data
  356.     ' We use the Global memory pool because this buffer
  357.     ' could easily be above 64k bytes.
  358.     mfglbhnd = GlobalAlloc(GMEM_MOVEABLE, mfinfosize)
  359.     gptr& = GlobalLock&(mfglbhnd)
  360.     dl = llseek(fhnd, currentfileloc, 0)
  361.  
  362.     dl = hread(fhnd, ByVal gptr, mfinfosize)
  363.  
  364.     ' Win32 does not support the SetMetaFileBitsBetter function
  365.     #If Win32 Then
  366.         ' If we were using a byte array, we could use
  367.         ' the original definition of SetMetaFileBitsEx, but
  368.         ' we want to preserve 16 bit compatibility
  369.         mfhnd = SetMetaFileBitsBuffer(mfinfosize, gptr)
  370.         di = GlobalUnlock(mfglbhnd)
  371.     #Else
  372.         di = GlobalUnlock(mfglbhnd)
  373.         mfhnd = SetMetaFileBitsBetter(mfglbhnd)
  374.     #End If
  375.     
  376.     di = lclose(fhnd)
  377.     
  378.     ' Don't delete the global handle - it holds the metafile data
  379.     LoadTheMetafile = mfhnd
  380. End Function
  381.  
  382. '
  383. '
  384. ' Even though xExt and yExt are longs, they are limited to integer
  385. ' values to stay compatible with the METAFILEHEADER structure
  386. '
  387. #If Win32 Then
  388. Function SaveTheMetafile(FileName$, mfhnd&, xExt&, yExt&)
  389. #Else
  390. Function SaveTheMetafile(FileName$, mfhnd%, xExt%, yExt%)
  391. #End If
  392.     
  393.     #If Win32 Then
  394.         Dim fhnd&
  395.         Dim di&, dl&
  396.         Dim mfglbhnd&
  397.         Dim newmf&
  398.         Dim dc&
  399.     #Else
  400.         Dim fhnd%
  401.         Dim di%, dl&
  402.         Dim mfglbhnd%
  403.         Dim newmf%
  404.         Dim dc%
  405.     #End If
  406.     Dim mfile As METAFILEHEADER
  407.  
  408.     Dim mfinfosize&
  409.     Dim currentfileloc&
  410.     Dim gptr&
  411.  
  412.     Dim oldsize As SIZE
  413.  
  414.     ' Open the file to write
  415.     fhnd = lcreat(FileName$, 0)
  416.     If fhnd >= 0 Then Call lclose(fhnd) ' Close the open handle
  417.     fhnd = lopen(FileName$, 2)
  418.     If fhnd < 0 Then Exit Function
  419.     If mfhnd = 0 Then Exit Function
  420.  
  421.  
  422.     ' First write a placeable header file header
  423.     mfile.key = &H9AC6CDD7  ' The key - required
  424.     mfile.hMF = 0           ' Must be 0
  425.     mfile.bbox.Left = 0
  426.     mfile.bbox.Top = 0
  427.     ' These should be calculated using GetDeviceCaps
  428.     mfile.bbox.Right = xExt + 1 ' Size in metafile units of bounding area
  429.     mfile.bbox.Bottom = yExt + 1
  430.     mfile.inch = 1000 ' Number of metafile units per inch
  431.     
  432.     mfile.reserved = 0
  433.     ' Build the checksum
  434.     mfile.checksum = &H9AC6 Xor &HCDD7 ' 9ac6 xor cdd7
  435.     mfile.checksum = mfile.checksum Xor mfile.bbox.Right
  436.     mfile.checksum = mfile.checksum Xor mfile.bbox.Bottom
  437.     mfile.checksum = mfile.checksum Xor mfile.inch
  438.     
  439.     
  440.     ' Write the buffer
  441.     di = lwrite(fhnd, mfile, Len(mfile))
  442.     
  443.     ' Now we retrieve a handle that will contain the
  444.     ' metafile  - We make a copy, but first we set the
  445.     ' extents so that it can be properly displayed
  446.     dc = CreateMetaFile(vbNullString)
  447.     dl = SetWindowExtEx(dc, xExt, yExt, oldsize)
  448.     di = SetMapMode(dc, MM_ANISOTROPIC)
  449.     di = PlayMetaFile(dc, mfhnd)
  450.     newmf = CloseMetaFile(dc)
  451.     
  452.     #If Win32 Then
  453.         ' Find out how bit the buffer needs to be
  454.         mfinfosize = GetMetaFileBitsEx(newmf, 0, ByVal 0)
  455.         If mfinfosize = 0 Then
  456.             di = lclose(fhnd)
  457.             Exit Function
  458.         End If
  459.         mfglbhnd = GlobalAlloc(GMEM_MOVEABLE Or GMEM_ZEROINIT, mfinfosize)
  460.         gptr = GlobalLock(mfglbhnd)
  461.         dl = GetMetaFileBitsEx(newmf, mfinfosize, ByVal gptr)
  462.     #Else
  463.         mfglbhnd = GetMetaFileBits(newmf)
  464.         gptr = GlobalLock(mfglbhnd)
  465.         mfinfosize = GlobalSize(mfglbhnd)
  466.     #End If
  467.  
  468.     
  469.     dl = hwrite(fhnd, ByVal gptr, mfinfosize)
  470.  
  471.     di = GlobalUnlock(mfglbhnd)
  472.     di = GlobalFree(mfglbhnd)
  473.     di = lclose(fhnd)
  474.  
  475. End Function
  476.  
  477.