注册 登录
编程论坛 → VB6论坛

利用API函数LineTo绘图的问题

xiangyue0510 发布于 2017-09-22 17:21， 5829 次点击
上个帖子萌发了对矢量图的兴趣，正好手上另外一个项目需要绘制极化曲线，由于窗口比较小（程序界面就很小），绘制出来的像素图放大之后效果不好，被说好像是网上找的。
目前的解决方法是后台弄一个大的窗口，在那里面重绘一遍再输出。只能说是应付一下，效果也不是太好。毕竟矢量图才是真正解决之道
言归正传，我在网上找到了一个emf格式的论文，按照上面的示例做了一下，但是出不来结果。
请各位帮助看看
http://www.
窗体：
程序代码：

Private Sub Form_Click()

 DrawCurve
End Sub

Sub DrawCurve()
  Dim T As Double
  Dim Xs As Long, Ys As Long
  Dim P0 As POINTAPI
  Dim Xp As Long, Yp As Long
  
  Dim hwMFC As Long, hwMF As Long, Box As RECT
  
  '设定绘图区域， 大小与窗体一致，尺寸大小以0.01mm为单位
  Box.Left = 0
  Box.Top = 0
  Box.Right = Form1.ScaleX(Form1.ScaleWidth, Form1.ScaleMode, vbMillimeters) * 100
  Box.Bottom = Form1.ScaleX(Form1.ScaleHeight, Form1.ScaleMode, vbMillimeters) * 100
  
  
  '获取窗体的宽度和高度，单位像素
  Xs = Form1.ScaleX(Form1.ScaleWidth, Form1.ScaleMode, vbPixels)
  Ys = Form1.ScaleX(Form1.ScaleHeight, Form1.ScaleMode, vbPixels)
  
  '建立一个元文件
  hwMFC = CreateEnhMetaFile(Form1.hdc, "C:\w3.emf", Box, "MetaFile Creater")
   
  If hwMFC = 0 Then
   MsgBox "元文件建立错误"
   Exit Sub
  End If
  
  
  For T = 0 To 6.283 Step 0.01
   Xp = Xs * (1 + Sin(4 * T)) / 2
   Yp = Xs * (1 + Sin(5 * T)) / 2
   If T = 0 Then
     MoveToEx hwMFC, Xp, Yp, P0
   Else
     LineTo hwMFC, Xp, Yp
   End If
  Next T


  MoveToEx hwMFC, 0, 0, P0
  LineTo hwMFC, 800, 600
  
  hwMF = CloseEnhMetaFile(hwMFC)
  
  Box.Left = 0
  Box.Top = 0
  Box.Right = Xs
  Box.Bottom = Ys
  
  PlayEnhMetaFile Form1.hdc, hwMF, Box
  
  DeleteEnhMetaFile hwMF
  
  Clipboard.Clear
  Clipboard.SetData LoadPicture("C:\w3.emf"), vbCFMetafile
End Sub

模块：
程序代码：

'POINTAPI 结构定义
Type POINTAPI

 X As Long

 Y As Long
End Type

'RECT 结构定义
Type RECT

 Left As Long

 Top As Long

 Right As Long

 Bottom As Long
End Type


'******************************* API 函数 CreateEnhMetaFile
'功能：               创建一个增强型的图元文件设备场景
'hdcRef               一个参考设备场景，即绘图设备句柄如窗口，打印机等。 如为0，则为整个屏幕
'lpFileName           图元文件的磁盘路径和文件名， 可用vbNullString传递一个NULL，从而创建内存图元文件。
'lpRect               绘图的矩形区域
'lpDescription        对图元文件的一段说明。 如果不愿意包含一段说明，也可设为vbNullString。
'返回值               增强型图元文件设备场景的句柄。 零表示函数执行出错

Public Declare Function CreateEnhMetaFile Lib "gdi32" Alias "CreateEnhMetaFileA" (ByVal hdcRef As Long, ByVal lpFileName As String, lpRect As RECT, ByVal lpDescription As String) As Long


'******************************* API 函数 CloseEnhMetaFile
'功能：               关闭指定的增强型图元文件设备场景，并将新建的图元文件返回一个句柄
'hdc                  增强型图元文件设备场景的句柄，对应CreateEnhMetaFile的返回值
'返回值               增强型图元文件的一个句柄。 零表示函数执行出错

Public Declare Function CloseEnhMetaFile Lib "gdi32" (ByVal hdc As Long) As Long



'******************************* API 函数 PlayEnhMetaFile
'功能：               指定的设备中绘制（显示）一个增强型图元文件
'hdc                  用于显示的设备句柄，如窗口、控件等
'hemf                 增强型图元文件的句柄
'lpRect               绘图的矩形区域
'返回值               非零表示成功，零表示失败

Public Declare Function PlayEnhMetaFile Lib "gdi32" (ByVal hdc As Long, ByVal hemf As Long, lpRect As RECT) As Long


'******************************* API 函数 DeleteEnhMetaFile
'功能：               使用完图元文件之后，释放其所使用的系统资源（清除内存，不删除文件）
'hwMF                 增强型图元文件的句柄
'返回值               非零表示成功，零表示失败

Public Declare Function DeleteEnhMetaFile Lib "gdi32" (ByVal hwMF As Long) As Long


'******************************* API 函数 MoveToEx
'功能：               将当前绘图位置移动到设备的指定位置——设置画笔位置
'hdc                  绘图的目标设备
'X、Y                 位置坐标（相对于目标设备）
'lpPoint              指向POINT结构的指针，用来存放上一个点的位置，若此参数为NULL，则不保存上一个点的位置
'返回值               返回TRUE代表移动成功，FALSE代表失败

Public Declare Function MoveToEx Lib "gdi32" (ByVal hdc As Long, X As Long, Y As Long, lpPoint As POINTAPI) As Long


'******************************* API 函数 LineTo
'功能：               以指定设备的当前位置为起点，向终点位置划一条直线
'hdc                  绘图的目标设备
'X、Y                 终点位置坐标（相对于目标设备）
'返回值               返回TRUE代表移动成功，FALSE代表失败

Public Declare Function LineTo Lib "gdi32" (ByVal hdc As Long, X As Long, Y As Long) As Long

'******************************* API 函数 CreatePen
'功能：               设置画笔格式
'nPenStyle            线条样式
'nWidth               线条宽度
'crColor              线条颜色
'返回值               返回新画笔的句柄，零表示失败

Public Declare Function CreatePen Lib "gdi32" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long


Public Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long

'其他函数 Arc  Rectangle   TextOut


17 回复
#2
xzlxzlxzl2017-09-22 22:45
用下述代码似乎打开了你画的那个图元文件，是不是就是一条斜线？窗口在屏幕不同位置，斜线斜率不同。
程序代码：
Private Type RECT

 Left As Long

 Top As Long

 Right As Long

 Bottom As Long
End Type

Private Type RECTL
        Left As Long
        Top As Long
        Right As Long
        Bottom As Long
End Type
Private Type SIZEL
    cx As Long
    cy As Long
End Type

Private Type ENHMETAHEADER
        iType As Long
        nSize As Long
        rclBounds As RECTL
        rclFrame As RECTL
        dSignature As Long
        nVersion As Long
        nBytes As Long
        nRecords As Long
        nHandles As Integer
        sReserved As Integer
        nDescription As Long
        offDescription As Long
        nPalEntries As Long
        szlDevice As SIZEL
        szlMillimeters As SIZEL
End Type

Private Declare Function GetEnhMetaFile Lib "gdi32" Alias "GetEnhMetaFileA" (ByVal lpszMetaFile As String) As Long
Private Declare Function GetEnhMetaFileHeader Lib "gdi32" (ByVal hemf As Long, ByVal cbBuffer As Long, lpemh As ENHMETAHEADER) As Long
Private Declare Function PlayEnhMetaFile Lib "gdi32" (ByVal hdc As Long, ByVal hemf As Long, lpRect As RECT) As Long

Private Sub aaa()
    Picture1.Cls '清除图形
    Dim ret, lp As ENHMETAHEADER, lpRect As RECT
    If Dir("c:\w3.emf") <> "" Then '判断文件是否存在
        hwd = GetEnhMetaFile("c:\w3.emf") '获取图元文件句柄
        GetEnhMetaFileHeader hwd, Len(lp), lp '获取图元文件头，主要目的是获取结构中有关图元文件坐标的信息

        With lpRect '设置RECT结构成员主要用于定义了在哪里描绘图元文件

            .Left = 0
            .Top = 0
            .Right = lp.rclBounds.Right
            .Bottom = lp.rclBounds.Bottom
        End With
        ret = PlayEnhMetaFile(Picture1.hdc, hwd, lpRect) '绘制绘图元文件
        P = 1
    Else
        MsgBox "缺失地图文件"
        End
    End If

End Sub

Private Sub Form_Click()
   aaa
End Sub
#3
xiangyue05102017-09-23 14:44
回复 2楼 xzlxzlxzl
两个东西，一个是bowditch曲线  
For T = 0 To 6.283 Step 0.01
   Xp = Xs * (1 + Sin(4 * T)) / 2
   Yp = Xs * (1 + Sin(5 * T)) / 2
   If T = 0 Then
     MoveToEx hwMFC, Xp, Yp, P0
   Else
     LineTo hwMFC, Xp, Yp
   End If
  Next T
只有本站会员才能查看附件，请 登录

另外一个是随便画的斜线
  MoveToEx hwMFC, 0, 0, P0
  LineTo hwMFC, 800, 600
你得意思是在你的电脑上可以看到绘制的emf文件？ 那就奇怪了因为在我的电脑上无论是form1上，还是这个文件都看不到任何效果。
#4
xiangyue05102017-09-25 10:05
回复 2楼 xzlxzlxzl
奇怪了，你的代码确实可以查看绘图的效果。我的窗口，直接打开文件，emf插入word，画板都不能正常查看
而且结果不对，我删除了画斜线的代码，但是结果还是一条斜线，没有出现曲线。 脑子中出现无数巨大的问号和惊叹号。

程序代码：

  For T = 0 To 6.283 Step 0.01
   Xp = Xs * (1 + Sin(4 * T)) / 2
   Yp = Ys * (1 + Sin(5 * T)) / 2     'Xs 改成 Ys
   If T = 0 Then
     MoveToEx hwMFC, Xp, Yp, P0
   Else
     LineTo hwMFC, Xp, Yp
   End If
  Next T


  'MoveToEx hwMFC, 0, 0, P0          斜线已经标注了
  'LineTo hwMFC, 800, 600
#5
风吹过b2017-09-25 10:35
我测试过了第一段代码，也是用 WORD 和 画板 看到一片空白。

xzlxzlxzl 的代码也是网上的，我百度时，最少看到了三个网站都是这个代码。因为不是绘制的，所以就没去看了。

实在不行，还是回到自己解析 EMF 的路子上来吧。

只找到一个 C++  的例子
http://www.
#6
xiangyue05102017-09-25 10:57
以下是引用风吹过b在2017-9-25 10:35:56的发言：

我测试过了第一段代码，也是用 WORD 和 画板 看到一片空白。

xzlxzlxzl 的代码也是网上的，我百度时，最少看到了三个网站都是这个代码。因为不是绘制的，所以就没去看了。

实在不行，还是回到自己解析 EMF 的路子上来吧。

只找到一个 C++  的例子
http://www.

解析EMF，风版不如你杀了我吧。
C学过个把月，说实话门缝都没有摸清楚。
说实话还有点奇怪的是，为何显示的和画出来的不是同一个东西。 绘图代码lineto这一段是很清晰的，不应该有这样的问题。 我把画斜线的语句标注了，还把原来生成的文件删除了，还是一条斜线……
#7
风吹过b2017-09-25 11:04
C ，我只看了 几天的书，没学过，绝大部分看不懂。还是在 没出WIN95时看的 TC2 。

估计要请 xzlxzlxzl  版主出手了。
#8
xzlxzlxzl2017-09-25 21:32
被风版点名了，好有压力啊！
我也没有好的办法。初看香版主的代码，感觉是没有定义画笔的原因，但我就是定义了画笔，仍然没有得到正确结果。
windows画图是通过设备句柄完成的，要作图，首先要有一个画布dc，其次要有一个画笔pen，第三还要通过SelectObject将dc和pen联系起来，这样才能开始作图；因此一个完整的画图代码如下：
  Dim hpen As Long, ret As Long, lp As RECT
  hpen = CreatePen(0, 1, vbRed)                 '创建红色画笔
  ret = SelectObject(Picture1.hdc, hpen)        '将画笔和画布联系起来，这里的画布就是picturebox控件，如果没有则需要通过creatdc创建画布
  ret = MoveToEx(Picture1.hdc, 10, 10, 0&)      
  ret = LineTo(Picture1.hdc, 50, 10)
  ret = LineTo(Picture1.hdc, 50, 60)            '画第一个折线段
  ret = MoveToEx(Picture1.hdc, 100, 100, 0&)
  ret = LineTo(Picture1.hdc, 150, 110)
  ret = LineTo(Picture1.hdc, 150, 160)          '画第二个线段
  ret = DeleteObject(hpen)                      '取消画笔和画布的联系
下面是我试验的工程文件，里面包含一个coreldraw做的emf文件，用于测试显示的，希望对香版主有用。
只有本站会员才能查看附件，请 登录

只有本站会员才能查看附件，请 登录
#9
xiangyue05102017-09-26 08:55
回复 8楼 xzlxzlxzl
这个叫做能者多劳，
谢谢了。我先研究一下你的代码。
#10
xiangyue05102017-09-26 10:34
@xzlxzlxzl
我看了一下你的代码，收获不少，但是保存文件还是空白一片，
但是我如果换成Polyline，就可以在保存的文件中看到内容。
不知道是为何？
#11
xzlxzlxzl2017-09-26 15:58
已找到原因！
是因为坐标系的缘故，在这之前一直被那个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

效果图：
只有本站会员才能查看附件，请 登录
#12
风吹过b2017-09-26 16:26
xzlxzlxzl 就是厉害。
#13
Artless2017-09-27 00:32
都是高手
#14
九转星河2017-09-27 00:39
哈哈,我看到了不是初中就是高中的信息技术教材有Form1的东东~不过久久都忘记很多了/wn~
#15
xiangyue05102017-09-27 11:55
回复 11楼 xzlxzlxzl

以前还真没有注意过单位制的问题，不过精度上似乎还有一些问题。附件上可以看出有一部分区域丢失
只有本站会员才能查看附件，请 登录

请帮看一下我的理解是否正确？
Pic1 （单位：Twip，缇）：
                         ↓
Rect （单位：0.01 mm） =Twip *2
我查到的是 1cm= 567 Twips。 xzlxzlxzl你这个是粗略的换算,准确的应该是1/567*1000=1.763688，对吧？ 这样应该“画布”更大才对
                         ↓
图片、设备场景hdc、LineTo函数（单位：pixel 像素）
   = Twip /15

ScaleWidth =6315、 Scaleheight=3555 ， 那么计算得到像素应该是421×237，但是得到的图片是359×203。 我也算了一下X、Y方面误差还不太一样，分别是1.1727、1.167488。考虑到前面用的是Twip *2定义的rect，似乎这个误差还要大一些
这么看似乎保存emf的时候，还有一个折减。 xzlxzlxzl这方面你了解是怎么回事么？ 毕竟我的图片是全部代码生成，如果保存的时候丢失部分不好。 就是故意避开这个范围也得清楚比例多大
#16
xzlxzlxzl2017-09-27 19:35
经测试，不同的屏幕分辨率，1 twip对应的0.01毫米比例不确定，按照计算比例是1.763688，在屏幕1440*900的分辨率下比例是1.842，在屏幕分辨率是1680*1050时，比例是1.88。你可以根据你的电脑计算的像素/实际像素来计算比例，比如你计算的应该是421*237，由于我的twip单位都乘以2了，所以实际像素是842*474，产生的图元文件尺寸是359*203，你电脑的横坐标比例实际为842/359=2.3454，纵坐标实际比例为474/203=2.335，所以你应该将下述代码比例进行修改如下：
  lp.Right = Pic1.ScaleWidth * 2
  lp.Bottom = Pic1.ScaleHeight * 2     '创建图元屏幕大小仍然按照0.01毫米的单位转换乘以

修改为
  lp.Right = Pic1.ScaleWidth * 2.3454
  lp.Bottom = Pic1.ScaleHeight * 2.335     '创建图元屏幕大小仍然按照0.01毫米的单位转换乘以

可以使用自动比例测算，方法是先用CreateEnhMetaFile(Pic1.hdc, vbNullString, lp, vbNullString)产生一个内存图元句柄，在使用GetEnhMetaFileHeader获取该句柄对应图元实际尺寸，用理论尺寸/实际尺寸即可自动得到调整比例。
#17
xiangyue05102017-09-28 01:12
回复 16楼 xzlxzlxzl
哦，原来是这样的，我再研究研究。谢了！
#18
xzlxzlxzl2017-09-29 04:43
两天前我还不知道emf文件，通过对题主问题的解答和共同讨论，自觉已经掌握了“vb制作和访问图元文件”方法，现做个总结：
1，我掌握这个的基础知识全部来自百度，而大部分方法是通过由此及彼的领悟和程序调试中获得的。比如2楼代码的确如风版主所说是百度的，可是百度里的代码都没有ENHMETAHEADER结构，没有足够经验的人是找不到这个结构的。我后来提供的代码就完全是自己的了。
2，windows图元文件有普通图元文件和增强图元文件，两种类型的文件需要用两套api访问，不能通用，如创建增强的api函数是CreateEnhMetaFile、显示用PlayEnhMetaFile，创建普通的是CreateMetaFile、显示用PlayMetaFile。目前看来，普通图元的矢量坐标是相对的、16位的，而增强的矢量坐标是绝对的、32位的，增强的图放大缩小和显示位置只需要调整RECT里的值即可达到，而普通的随意显示比较麻烦，我现在的代码只能从坐标0，0开始显示。
3，图元文件的RECT单位是0.01毫米，而api作图的默认单位是像素。
4，由于图元文件的设备无关性，不同显示分辨率下制作图元文件时就涉及到标准的自动转换，反应到图元文件上时就是查看图元文件属性的DPI不同。这也很容易理解，比如我19吋的屏幕，分辨率在1024*768和1440*900时，每个像素实际宽度肯定都不同。这和书上或百度上说的一个像素固定月0.33毫米或一公分567twips不同，那是按分辨率96DPI计算出来的，因为windows显示设备的DPI固定为96。这样以来代码里需要自动计算不同分辨率下图元文件的DPI，以实现图元文件的设备无关性，我现在的代码里已实现自动计算，拿到任何显示分辨率下制作图元文件都会所见即所得，不会再出现题主15楼所说的问题。这是通过ENHMETAHEADER结构里szlDevice、szlMillimeters成员变量计算得到的，如下图：

只有本站会员才能查看附件，请 登录


5，矢量图的优点就是平滑放大缩小，放个比较图片体会下，可感受到矢量图的优点。

只有本站会员才能查看附件，请 登录
1
©2025, BC-CN.NET
电脑版