已找到原因!
是因为坐标系的缘故,在这之前一直被那个0.01毫米的精度纠结。实际上在没有设定hdc度量单位的话,默认的作图单位是像素,由于我数组里面记录的是按单位缇记录的坐标数据,我按照0.01毫米的精度转换大致是1缇=1.78(0.01毫米),所以我都乘以2了,这样定位的坐标超出屏幕外了,所以看不到。实际上还是要将缇转换为像素,即除以15才可以得到正确结果(注:PlayEnhMetaFile 设定的屏幕大小还是要按照0.01毫米精度转换),修改后的saveemf函数如下:
效果图:
是因为坐标系的缘故,在这之前一直被那个0.01毫米的精度纠结。实际上在没有设定hdc度量单位的话,默认的作图单位是像素,由于我数组里面记录的是按单位缇记录的坐标数据,我按照0.01毫米的精度转换大致是1缇=1.78(0.01毫米),所以我都乘以2了,这样定位的坐标超出屏幕外了,所以看不到。实际上还是要将缇转换为像素,即除以15才可以得到正确结果(注:PlayEnhMetaFile 设定的屏幕大小还是要按照0.01毫米精度转换),修改后的saveemf函数如下:
程序代码:
Private Sub saveemf() '存储图元文件 Dim hemf As Long, hpen As Long, ret As Long, lp As RECT, c As Integer, i As Integer c = 0 For i = 0 To 100 If dxy(i, 0) = 0 And dxy(i, 1) = 0 Then Exit For c = c + 1 Next If c < 2 Or Trim(Text1) = "" Then MsgBox "线段太少或文件名为空,存图失败" Exit Sub '少于一条线段的坐标或文件名为空则不存图 End If lp.Right = Pic1.ScaleWidth * 2 lp.Bottom = Pic1.ScaleHeight * 2 '创建图元屏幕大小仍然按照0.01毫米的单位转换乘以 lp.Top = 0 lp.Left = 0 hemf = CreateEnhMetaFile(Pic1.hdc, Text1 & ".emf", lp, vbNullString) If hemf = 0 Then MsgBox "图元文件创建失败" Exit Sub End If hpen = CreatePen(0, 1, vbRed) ret = SelectObject(hemf, hpen) ret = MoveToEx(hemf, dxy(0, 0) / 15, dxy(0, 1) / 15, 0&) '作图的坐标按像素转换除以15 For i = 1 To 100 If dxy(i, 0) = 0 And dxy(i, 1) = 0 Then Exit For ret = LineTo(hemf, dxy(i, 0) / 15, dxy(i, 1) / 15) Next ret = CloseEnhMetaFile(hemf) ret = DeleteEnhMetaFile(ret) End Sub
效果图: